On ne sait jamais que ça pourrait servir à quelqu'un. Pour le design du bouton, c'est dans la procédure create où on crée le bouton pour le faire en suite tourner.
Code : Tout sélectionner
EnableExplicit
; ToDo - GadgetToolTip() permet d'ajouter une 'mini aide' à ce gadget.
; ToDo - SetText Set/GetTag
DeclareModule KnobGadget
Declare CreateKnob(Gadget, X, Y, Width, Height, Min, Max, Value=0, Options=0)
Declare Repaint(*Knob)
Declare EventKnob(*Knob)
Declare SetSens(*Knob,Sens)
Declare GetGadget(*Knob)
Declare SetValue(*knob,value)
Declare GetValue(*knob)
EndDeclareModule
Module KnobGadget
Structure Knob
Gadget.i
x.a
Y.a
Height.i
Width.i
Min.i
Max.i
Value.i
Image.i
CenterX.i
CenterY.i
MouseDown.b
Sens.b
oldval.i
EndStructure
Procedure CreateKnob(Gadget, X, Y, Width, Height, Min, Max, Value=0,Options=0)
*Knob.Knob= AllocateMemory(SizeOf(Knob))
*Knob\Gadget=CanvasGadget(Gadget, X, Y, Width, Height)
*Knob\Image=CreateImage(#PB_Any,Width, Height,24,$FFFFFF)
Define ix,iy,irad; Création bouton
ix=Int(Width/2)
iy=Int(Height/2)
irad=Int((ix+iy)/2)
If StartDrawing(ImageOutput(*Knob\Image))
Circle(ix,iy, irad, $0)
Circle(ix,iy, irad-2,$FFFFFF)
LineXY(ix,iy,Width,iy,$0)
StopDrawing()
EndIf;----------------------------
*Knob\x=x
*Knob\y=y
*Knob\min=Min
*Knob\Max=Max
*Knob\Width=Width
*Knob\Height=Height
*Knob\CenterX=ix
*Knob\CenterY=iy
*Knob\MouseDown=#False
*Knob\Sens=Height
*Knob\Value=Value
ProcedureReturn *Knob
EndProcedure
Procedure Repaint(*Knob.knob)
Define Radius.i ;orientation du bouton
If (0-*Knob\Min+*Knob\Max)<>0
Radius=Int(280*(0-*Knob\Min+*Knob\Value)/(0-*Knob\Min+*Knob\Max))
Else
Radius=0
EndIf
If StartVectorDrawing(CanvasVectorOutput(*Knob\Gadget)) ;rotation et affichage bouton
RotateCoordinates(*Knob\CenterX, *Knob\CenterY, -235+Radius )
MovePathCursor(0, 0)
DrawVectorImage(ImageID(*Knob\Image), 255)
StopVectorDrawing()
EndIf
EndProcedure
Procedure ChangeValue(*Knob.knob, Val); lorsqu'il y a un mouvement sur le curseur appelé depuis événement
If *Knob\oldval > Val
*Knob\Value=*Knob\Value+1
*Knob\oldval=val+*Knob\Sens
ElseIf *Knob\oldval < Val
*Knob\Value=*Knob\Value-1
*Knob\oldval=val-*Knob\Sens
EndIf
If *Knob\Value>*Knob\Max
*Knob\Value=*Knob\Max
ElseIf *Knob\Value<*Knob\Min
*Knob\Value=*Knob\Min
EndIf
*Knob\oldval=val
Repaint(*Knob)
EndProcedure
Procedure GetGadget(*Knob.knob)
ProcedureReturn *Knob\Gadget
EndProcedure
Procedure SetSens(*Knob.knob,Sens); Définir la sensibilité du curseur
If sens<0
sens=0
EndIf
*Knob\Sens=Sens
EndProcedure
Procedure EventKnob(*Knob.knob) ; gestion des événement sur le bouton
Define lEventType = EventType()
Select lEventType
Case #PB_EventType_MouseMove :
If *Knob\MouseDown=#True : ChangeValue(*Knob,GetGadgetAttribute(*Knob\Gadget,#PB_Canvas_MouseY)):EndIf
Case #PB_EventType_LeftButtonDown
*Knob\MouseDown=#True
*Knob\oldval=GetGadgetAttribute(*Knob\Gadget,#PB_Canvas_MouseY)
Case #PB_EventType_LeftButtonUp
*Knob\MouseDown=#False
EndSelect
ProcedureReturn lEventType;
EndProcedure
Procedure SetValue(*Knob.knob,Value)
*knob\Value=Value
If *Knob\Value>*Knob\Max
*Knob\Value=*Knob\Max
ElseIf *Knob\Value<*Knob\Min
*Knob\Value=*Knob\Min
EndIf
Repaint(*Knob)
EndProcedure
Procedure GetValue(*knob.knob)
ProcedureReturn *knob\Value
EndProcedure
EndModule
;----------------------------------------------------------
;Programme de test
;----------------------------------------------------------
Define Event, EventGadget, i,x,y,Nbr=25
Dim myknob(Nbr)
If OpenWindow(0, 0, 0, 400, 400, "Test Knob", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
For i=0 To Nbr-1
x=Mod(i,5)*64
y=Int(i/5)*64
myknob(i)=KnobGadget::CreateKnob(#PB_Any,10+x,10+y,64,64,0,127)
KnobGadget::SetValue(myknob(i),Random(127))
Next i
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
EventGadget=EventGadget()
For i=0 To Nbr-1
If EventGadget=KnobGadget::GetGadget(myknob(i))
If KnobGadget::EventKnob(myknob(i))=#PB_EventType_LeftButtonUp
SetWindowTitle(0,"Bouton"+Str(i)+"="+Str(KnobGadget::GetValue(myknob(i))))
EndIf
EndIf
Next i
EndIf
Until Event = #PB_Event_CloseWindow
EndIf
End