Drawing XP button

[aurelCB]

Hi all...
Here is example how draw XP style button in Creative Basic.
bye...
aurel

[aurelCB]

Oh sorry here is code:

Code Select Expand

'Drawing XP button from code/by aurel
DEF w1:window
def bl,bt,bw,bh :int

WINDOW w1,0,0,550,350,@MINBOX,0,"XP button",main
setwindowcolor w1,rgb(225,225,230)
bl=100
bt=100
bw=90
bh=24
'button frame
RECT w1, bl,bt,bw,bh,rgb(50,50,60)
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)

pset w1,bl,bt,rgb(190,190,190):               'UpperLeft hide pixel
pset w1,bl,bt+(bh-1),rgb(190,190,190):        'DownLeft ...
pset w1,bl+(bw-1),bt,rgb(190,190,190):        'UpperRight ...
pset w1,bl+(bw-1),bt+(bh-1),rgb(190,190,190): 'DownRight ...

Gosub xpface
Gosub buttontext



run = 1
waituntil run = 0
closewindow w1
end
'--------------------------------------------------------------------------------
sub main
Select @CLASS

case @IDCLOSEWINDOW
run=0
case @IDCREATE
CenterWindow w1

case @IDMOUSEMOVE
       ' button mouseover effect
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
              'orange if mouse is over button
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(255,165,0)
            Else
'blue if mouse not over button
              RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)
           Endif
case @IDLBUTTONDN
            ' Event button 1
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
                Messagebox w1,"Button clicked","On Click"       
            Endif
Endselect
Return
'-----------------------------------------------------------------------------------

SUB xpface
For n=102 to 121
line w1,102,n,188,n,rgb(250,250,255)
Next n

line w1,102,111,188,111,rgb(239,239,247)
line w1,102,112,188,112,rgb(239,235,239)
line w1,102,113,188,113,rgb(229,225,235)
line w1,102,114,188,114,rgb(219,215,225)
line w1,102,115,188,115,rgb(209,205,215)
line w1,102,116,188,116,rgb(199,195,205)
line w1,102,117,188,117,rgb(189,185,195)
line w1,102,118,188,118,rgb(179,175,185)
line w1,102,119,188,119,rgb(169,165,175)
line w1,102,120,188,120,rgb(159,155,165)
line w1,102,121,188,121,rgb(156,158,181)

RETURN

SUB buttontext
SETFONT w1,"MS Sans Serif", 9, 400 ,0
DRAWMODE w1, @transparent
move w1,bl+20,bt+5
print w1,"XP Button"




Return

[GWS]

Very neat Aurel .. you're getting pretty good with CBasic ..

It's a really good language for all sorts of applications .. 

best wishes,

Graham

[aurelCB]

Yes Graham CBasic is my favorite language!

[pistol350]

Well thought!
cheers!

[GWS]

I've been playing with 'pressing' your button Aurel .. 

Is this any good? .. my eyesight isn't good enough to see if I've got the lines exactly right .. 

Code Select Expand


'Drawing XP button from code/by aurel
DEF w1:window
def bl,bt,bw,bh :int

WINDOW w1,0,0,550,350,@MINBOX,0,"XP button",main
setwindowcolor w1,rgb(225,225,230)
bl=100
bt=100
bw=90
bh=24
'button frame
RECT w1, bl,bt,bw,bh,rgb(50,50,60)
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)

pset w1,bl,bt,rgb(190,190,190):               'UpperLeft hide pixel
pset w1,bl,bt+(bh-1),rgb(190,190,190):        'DownLeft ...
pset w1,bl+(bw-1),bt,rgb(190,190,190):        'UpperRight ...
pset w1,bl+(bw-1),bt+(bh-1),rgb(190,190,190): 'DownRight ...

Gosub xpface
Gosub buttontext

run = 1
waituntil run = 0
closewindow w1
end
'--------------------------------------------------------------------------------
sub main
Select @CLASS

case @IDCLOSEWINDOW
run=0
case @IDCREATE
CenterWindow w1

case @IDMOUSEMOVE
       ' button mouseover effect
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
              'orange if mouse is over button
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(255,165,0)
            Else
'blue if mouse not over button
              RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)
            Endif
case @IDLBUTTONDN
            ' Event button 1
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
RECT w1, bl+2,bt+2,bw-5,bh-4,0x888888
RECT w1, bl+3,bt+3,bw-5,bh-5,0x888888     
            Endif
case @IDLBUTTONUP
If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
gosub xpface
gosub buttontext
Endif
Endselect
Return
'-----------------------------------------------------------------------------------

SUB xpface

for n = 1 to 21
if (n < 11)
line w1,102,n+bt+2,188,n+bt+2,rgb(250,250,255)
else
line w1,102,n+bt,188,n+bt,rgb(239-(n-11)*10 ,239-(n-11)*10,247-(n-11)*10)
endif
next n

Return

SUB buttontext
SETFONT w1,"MS Sans Serif", 9, 400 ,0
DRAWMODE w1, @transparent
move w1,bl+20,bt+5
print w1,"XP Button"

Return


best wishes,

Graham

[LarryMc]

works for me Graham.

Larry

[aurelCB]

Oh i see , button pressed effect,good GWS

[pistol350]

I've been playing with 'pressing' your button Aurel .. 
...

I started to play with it as well, but was interrupted.
I then guessed that i had to keep on the job from where you are now Graham 

I only added the text effect required to simulate a bit more the button pressed down action.
and i also added button redraw at button DOWN state which led me to put graham's  effect at xpface()  subroutine.

Cheers to all of you guys!

Code Select Expand


'Drawing XP button from code/by aurel
DEF w1:window
def bl,bt,bw,bh :int
def LMBstate,textsize as int

WINDOW w1,0,0,550,350,@MINBOX,0,"XP button",main
setwindowcolor w1,rgb(225,225,230)
bl=100
bt=100
bw=90
bh=24
LMBstate=0
textsize=5
'button frame
RECT w1, bl,bt,bw,bh,rgb(50,50,60)
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)

pset w1,bl,bt,rgb(190,190,190):               'UpperLeft hide pixel
pset w1,bl,bt+(bh-1),rgb(190,190,190):        'DownLeft ...
pset w1,bl+(bw-1),bt,rgb(190,190,190):        'UpperRight ...
pset w1,bl+(bw-1),bt+(bh-1),rgb(190,190,190): 'DownRight ...

Gosub xpface
Gosub buttontext

run = 1
waituntil run = 0
closewindow w1
end
'--------------------------------------------------------------------------------
sub main
Select @CLASS

case @IDCLOSEWINDOW
run=0
case @IDCREATE
CenterWindow w1

case @IDMOUSEMOVE
       ' button mouseover effect
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
              'orange if mouse is over button
RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(255,165,0)
            Else
'blue if mouse not over button
            RECT w1, bl+1,bt+1,bw-2,bh-2,rgb(0,110,250)
            Endif
case @IDLBUTTONDN
            ' Event button 1
LMBstate=1
            If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
RECT w1, bl+2,bt+2,bw-5,bh-4,0x888888
RECT w1, bl+3,bt+3,bw-5,bh-5,0x888888
'move w1,bl+20,bt+5
'print w1,"         "
textsize=0:gosub xpface
gosub buttontext     
            Endif
case @IDLBUTTONUP
LMBstate=0
If ((@mousex>bl) & (@mousex<(bl+bw)) & (@mousey>bt) & (@mousey<(bt+bh)))
textsize=5
gosub xpface
gosub buttontext
Endif
Endselect
Return
'-----------------------------------------------------------------------------------

SUB xpface
for n = 1 to 21
if (n < 11)
line w1,102,n+bt+2,188,n+bt+2,rgb(250,250,255)
else
line w1,102,n+bt,188,n+bt,rgb(239-(n-11)*10 ,239-(n-11)*10,247-(n-11)*10)
endif
next n
IF LMBstate=1
RECT w1, bl+2,bt+2,bw-5,bh-4,0x888888
RECT w1, bl+3,bt+3,bw-5,bh-5,0x888888
textsize=6 :'can also be put here as if xpface() is called, we can assume buttontext() will also be called :)
ENDIF
Return

SUB buttontext
'IF LMBstate=1
' textsize=6
'ENDIF
SETFONT w1,"MS Sans Serif",textsize, 400 ,0
DRAWMODE w1, @transparent
MOVE w1,bl+20+(textsize/2),bt+5+(textsize/2)
PRINT w1,"XP Button"
Return

[pistol350]

This program made me think about a custom button example written by Allden a few years ago.
i've just posted the example. please, follow this link :
http://www.ionicwind.com/forums/index.php/topic,2548.0.html

[aurelCB]

Excelent Peter i do same thing last night,are you read my mind(Joke)