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
