PureBasic Forums - English

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