PureBasic Forums - English

Code: Select all

;CanvasGadget Circular ButtonPad test
; by einander - PureBasic 4.60 Beta 3
EnableExplicit
#DEGTORAD=#PI/180.0  ; degrees to radian
;
Macro CanvasMX(Canvas)
  GetGadgetAttribute(Canvas, #PB_Canvas_MouseX)  
EndMacro
;
Macro CanvasMY(Canvas)
  GetGadgetAttribute(Canvas, #PB_Canvas_MouseY)  
EndMacro
;
Procedure  CenterText(X,Y,X1,Y1,Tx.S,TextRGB=0,BkRGB=#White) 
  Protected TWi=TextWidth(Tx),THe=TextHeight(Tx)
  DrawingMode(#PB_2DDrawing_Transparent)
  If TWi >X1-X
    DrawText(X,(Y1+Y)/2-THe/2 , Tx, TextRGB)
  Else
    DrawText((X1+X)/2-TWi/2, (Y1+Y)/2-THe/2 , Tx, TextRGB)
  EndIf
EndProcedure  
;
Procedure AngleEndPoint(X,Y,Ang.F,Radius.F,*P.POINT) ; Ret circular end pointF for line, angle, size
  *P\X= X+Cos(Ang*#DEGTORAD)*Radius        
  *P\Y= Y+Sin(Ang*#DEGTORAD)*Radius 
EndProcedure
;
Procedure Canvas8Arrows(Canvas,Font,Array Pts.Point(1),Array Indx.I(1),Siz.F,Stp.F,Detach=-1,Hover=-1)
  Protected I,RGB,t$,SPi.F=Siz*#PI
  DrawingFont(Font)
  Restore Arrows
  Box(0,0,GadgetWidth(Canvas),GadgetHeight(Canvas),0)
  For I=0 To 7
    Read.I Indx(I)
    AngleEndPoint(Spi,Spi,I*Stp,Siz*2,@Pts(I))
    T$=Chr(230+Indx(I)) ;here change 230 for your offset (try 65 for text fonts) <<<<<<<
    If Detach>-1 And I=Detach:RGB=#Red
    ElseIf Hover>-1 And I=Hover And Hover<>Detach:RGB=#Green
    Else :RGB=#White
    EndIf
    CenterText(Pts(I)\X-TextWidth(T$)/2,Pts(I)\Y,Pts(I)\X,Pts(I)\Y,T$,RGB,0)
  Next
EndProcedure
;
Macro GetDistance(A1,A2)
  Sqr(Pow(A1,2) + Pow(A2,2))          
EndMacro
;
Procedure Near(X, Y, Array P.POINT(1)) ; Return elem de Array de Points Nearest to  x,y 
  Protected A,I,J,Min = $FFFFFFF 
  For I = 0 To ArraySize(P()) 
    A = GetDistance(X - P(I)\X, Y - P(I)\Y) 
    If A < Min  : Min = A  : J = I  : EndIf 
  Next I 
  ProcedureReturn J 
EndProcedure 
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,600,500 ,"CanvasGadget Button Pad",#PB_Window_SystemMenu|1)
SetWindowColor(0,$112233)
Define PadSize=120  ; <<<<<< change here to your preferred size
Define Ev,I,Detach=-1,Hover=-1,Draw
Define.F Siz=PadSize/(#PI*2),Stp=360/8
Define Font1=FontID(LoadFont(#PB_Any,"Wingdings",Siz,#PB_Font_HighQuality))
;Define Font1=FontID(LoadFont(#PB_Any,"Arial",Siz,#PB_Font_HighQuality))

Dim PTS.Point(7)
Dim Indx.I(7)

Define Ca1=CanvasGadget(#PB_Any,200,200,PadSize,PadSize, #PB_Canvas_Keyboard) 
StartDrawing(CanvasOutput(Ca1))
Canvas8Arrows(Ca1,Font1,Pts(),Indx(),Siz,Stp)
StopDrawing()
Repeat
  If GetAsyncKeyState_(27)&$8000 :  End : EndIf
  EV=WaitWindowEvent()
  Select Ev
    Case #PB_Event_Gadget
      Select EventGadget()
        Case Ca1
          Select EventType()
            Case  #PB_EventType_LeftButtonDown      
              Detach=Near(CanvasMX(Ca1),CanvasMY(Ca1),Pts())
              Draw=1
            Case  #PB_EventType_MouseMove      
              Hover=Near(CanvasMX(Ca1),CanvasMY(Ca1),Pts())
              Draw=1
            Case  #PB_EventType_MouseLeave 
              Hover=-1
              Draw=1
          EndSelect
      EndSelect
      If Draw
        StartDrawing(CanvasOutput(Ca1))
        Canvas8Arrows(Ca1,Font1,Pts(),Indx(),Siz,Stp,Detach,Hover)
        StopDrawing()
        SetWindowTitle(0,"Hover "+Str(Hover)+"   Detach "+Str(Detach))    
        Draw=0  
      EndIf
  EndSelect
Until EV=#PB_Event_CloseWindow
End 
;
DataSection
  Arrows:
  Data.I 2,8,4,7,1,5,3,6 ; for WingDings
  ;Data.i 0,1,2,3,4,5,6,7 ; for text fonts 
EndDataSection