Code: Select all
;Canvas Toggle Buttons
;by einander - PureBasic 4.60 Beta 3
EnableExplicit
Enumeration ; 6 CanvasButton states
#Normal=0
#Selected
#Pressed
#HoverSelected
#HoverUnSelected
#Disabled
EndEnumeration
Global Dim _Stat$(6)
_Stat$(2)="Pressed"
_Stat$(3)="HoverSelected"
_Stat$(4)="HoverUnSelected"
_Stat$(5)="Disabled"
Global _Myfont10=FontID(LoadFont(#PB_Any,"arial",10))
Global _Myfont12=FontID(LoadFont(#PB_Any,"times new roman",12))
Global _Myfont14=FontID(LoadFont(#PB_Any,"georgia",14))
Global _Myfont16=FontID(LoadFont(#PB_Any,"impact",16))
;
Structure BtnColors
TextRGB.L
BackRGB.L
EndStructure
;
Structure CanvasButton
Indx.I
gNum.I
FontID.I
Text.S
Selected.I
Stat.I
RGB.BtnColors[6] ; Colors :\L1=TextColor, \L2=BackColor
EndStructure
;
Procedure CenterTxt(X,Y,Wi,He,Text.S)
Protected TextWidth=TextWidth(Text),TextHeight=TextHeight(Text)
Protected X1=X+Wi,Y1=Y+He
If TextWidth>Wi : DrawText(X,(Y+Y1)/2-TextHeight/2 , Text)
Else : DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , Text)
EndIf
EndProcedure
Procedure CBDraw(*CB.CanvasButton)
With *Cb
Protected Wi=GadgetWidth(*Cb\gNum)
Protected He=GadgetHeight(*Cb\gNum)
Protected Img=CreateImage(#PB_Any,Wi,He)
StartDrawing(ImageOutput(Img)) ;background Color, Gradient with #White
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(\RGB[\Stat]\BackRGB)
BackColor(#White)
LinearGradient(Wi/2,0, Wi/2,He) ; try (0,0,Wi,He) to diagonal Gradient
Box(0,0,Wi,He)
DrawingMode(#PB_2DDrawing_Transparent) ; Button Text
DrawingFont(\Fontid)
FrontColor(\RGB[\Stat]\TextRGB)
CenterTxt(0,0,Wi,He,\Text)
StopDrawing()
SetGadgetAttribute(*Cb\gNum,#Pb_Canvas_Image,ImageID(Img))
FreeImage(Img)
EndWith
EndProcedure
;
Procedure CanvasButton(CBNum,X,Y,Wi,He,Text.S,Fontid,Indx,*Cb.CanvasButton,Flags=-1)
Protected I
With *Cb
If Flags=-1:Flags=#Pb_Canvas_Keyboard
Else :Flags|#Pb_Canvas_Keyboard
EndIf
\Text=Text
\gNum =CanvasGadget(CBNum,X,Y,Wi,He,Flags)
If CBNum<>#PB_Any:\gNum=CBNum:EndIf
SetGadgetAttribute(\gNum,#Pb_Canvas_Cursor,#Pb_Cursor_Hand)
\Fontid=Fontid
\Indx=Indx
Restore BtnColors
For I=0 To 5
Read.I \RGB[I]\TextRGB
Read.I \RGB[I]\BackRGB
Next
CBDraw(*Cb)
EndWith
EndProcedure
;
Procedure GetCanvasState(*Cb.CanvasButton)
With *Cb
Select EventType()
Case #PB_EventType_LeftButtonDown
\Selected!1 :\Stat=#Pressed : CBDraw(*Cb)
Case #Pb_EventType_MouseEnter,#Pb_EventType_LeftButtonup
If \Selected :\Stat=#HoverSelected : CBDraw(*Cb)
Else :\Stat=#HoverUnSelected : CBDraw(*Cb)
EndIf
Case #Pb_EventType_Mouseleave
If \Selected :\Stat=#Selected : CBDraw(*Cb)
Else :\Stat=#Normal : CBDraw(*Cb)
EndIf
EndSelect
If \Stat>1: ProcedureReturn \Stat:EndIf
EndWith
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,700,500 ,"Canvas Toggle Buttons",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowColor(0,0)
Define Ev,Flags,State
Define CB1.CanvasButton
Define CB2.CanvasButton
Define CB3.CanvasButton
Define CB4.CanvasButton
Define *Sel.CanvasButton=0
Flags=#Pb_Canvas_Border ; try with and without border; #PB_Canvas_Keyboard is Activated on procedure CanvasButton()
CanvasButton(#PB_Any,100,100,100,25,"Button 1",_Myfont10,1,@Cb1,Flags) ; last parameter optative
CanvasButton(#PB_Any,100,150,130,30,"Button 2",_Myfont12,2,@Cb2,Flags)
CanvasButton(#PB_Any,100,200,160,38,"Button 3",_Myfont14,3,@Cb3,Flags)
CanvasButton(#PB_Any,100,250,200,50,"Button 4",_Myfont16,4,@Cb4,Flags)
Repeat
EV=WaitWindowEvent()
Select Ev
Case #PB_Event_Gadget
Select EventGadget()
Case Cb1\gNum : *Sel=Cb1
Case Cb2\gNum : *Sel=Cb2
Case Cb3\gNum : *Sel=Cb3
Case Cb4\gNum : *Sel=Cb4
EndSelect
State=GetCanvasState(*Sel)
If State
SetWindowTitle(0,"Button "+Str(*Sel\Indx)+" "+_Stat$(State))
Else
SetWindowTitle(0,"")
EndIf
EndSelect
Until EV=#PB_Event_CloseWindow
End
;
DataSection ; try here other color pairs <<<<<<<<<<<<<
BtnColors:
Data.I $464646 , $888888 ;Normal : DarkGray, LightGray
Data.I $0000FF , $6666FF ;Selected : Red, Light Red
Data.I $000000 , $0082FF ;Pressed : Black, Dark Orange
Data.I $FF00FF , $00A5FF ;HoverSelected : Magenta, Orange
Data.I $000000 , $00A5FF ;HoverUnSelected : Black, Orange
Data.I $888888 , $CECECE ;Disabled : Light Gray , Pale Gray
EndDataSection
