Des boutons qui tournent

[Ehma]

Voilà, ce n'est peut-être pas très élégant, mais voici mes boutons.

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   

[kernadec]

bjr
merci pour le partage
bon début et puisque tu est lancé
Petite suggestion pour le fun avec un clic sur le bouton choisi qui
permettrait l'utilisation de la mollette souris ou flèches clavier
et puis aussi l'affichage d'un chiffre au centre du bouton de 0 à 9
avec un pop menu avec choix de le couleur du cercle extérieur et de l’intérieur
on aurait alors une jolie table de mixage
cordialement

[Shadow]

Salut, pas mal merci.

[Micoute]

Merci Ehma pour ce partage très utile. J'adore et j'adopte.

[GallyHC]

Bonjour,

Sympa le partage, merci. J'avais aussi travaillé sur ce style de code, je vous partage mon code en l'état de test (perso je ne l'ai pas utiliser car au final ça n'aurais pas été pour mon logiciel), si cela peux aider ^^.

Code : Tout sélectionner

EnableExplicit

; ****************************************************************************
; ****************************************************************************

Enumeration
  #Window
  #Canvas
EndEnumeration

#DEFINE_SINCOS_MAX  = 359

Define.i i
Global Dim _Sin.f   (#DEFINE_SINCOS_MAX)
Global Dim _Cos.f   (#DEFINE_SINCOS_MAX)
For i=0 To #DEFINE_SINCOS_MAX
  _Sin(i) = Sin(i * (2 * #PI / 360))
  _Cos(i) = Cos(i * (2 * #PI / 360))  
Next i

; ****************************************************************************
; ****************************************************************************

Procedure ACircle(x.i, y.i, radius.d, antilenh.d, color.i)
  ;
  ;
  ;
  Define.l lR, lG, lB
  Define.d dNormal, dValue

  If radius <= 0
    radius = 0.00001
  EndIf
  If antilenh <= 0
    antilenh = 0.00001
  EndIf

  ResetGradientColors()
  DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Gradient)

  lR      = Red  (color)
  lG      = Green(color)
  lB      = Blue (color)
  dNormal = 1 / radius
  dValue  = 1 - antilenh * dNormal

  GradientColor(   0  , RGBA(lR, lG, lB, 255))
  GradientColor(dValue, RGBA(lR, lG, lB, 255))
  GradientColor(   1  , RGBA(lR, lG, lB, 0  ))

  CircularGradient(x, y, radius)
  Circle          (x, y, radius)
  
EndProcedure

Procedure DrawValue(x.l, y.l, rayonx, rayony .l, segment.l, ilen.l, ldensity.l, value)
;
;
;
  Define.i i, j, new_x, new_y
  If segment < 4
    segment = 4
  EndIf
  
  For i = 20 To 340 Step 20
    j = (i + 180) % #DEFINE_SINCOS_MAX
    new_x = x + _Sin(j) * (rayonx - ilen)
    new_y = y - _Cos(j) * (rayony - ilen)
    If i < value
      ACircle(new_x,        new_y,        8, 8, RGB(255,0,0))
      ACircle(new_x,        new_y,        5, 2, RGB(255,0,0))
      ACircle(new_x,        new_y,        2, 2, RGB(255,100,100))
    Else
      ACircle(new_x,        new_y,        5, 2, RGB(100,0,0))
      ACircle(new_x,        new_y,        2, 2, RGB(200,0,0))
    EndIf
  Next i

EndProcedure

Procedure DrawCircular(WindowW, WindowH, x, y)
  ;
  ;
  ;
  Define.i ircircle = WindowW / 7
  Define.i idensity = WindowW / 100
  Define.i dx       = x  -  (WindowW * 0.5)
  Define.i dy       = y  -  (WindowW * 0.5)
  Define.i F        = Degree(ATan2(dx, dy)) - 80
  If F < 0
    F = 360 + F
  EndIf
  Define.i ivalue   = (F + 260) % #DEFINE_SINCOS_MAX
  Define new_x      = (WindowW * 0.5) - _Cos(ivalue) * ((ircircle * 2) - ircircle + 15)
  Define new_y      = (WindowH * 0.5) - _Sin(ivalue) * ((ircircle * 2) - ircircle + 15)

  StartDrawing(CanvasOutput(#Canvas))
    Box(0, 0, WindowW, WindowH, $f0f0f0)
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle + 21, 2, RGB(0,   0,  0))
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle + 20, 2, RGB(60, 60, 60))
    ACircle(WindowW*0.5 + 6,    WindowH*0.5 + 10,   WindowW * 0.5 - ircircle + 0, 2,  RGB(50, 50, 50))
    ACircle(WindowW*0.5 + 4,    WindowH*0.5 + 8,    WindowW * 0.5 - ircircle + 0, 2,  RGB(40, 40, 40))
    ACircle(WindowW*0.5 + 2,    WindowH*0.5 + 6,    WindowW * 0.5 - ircircle + 0, 2,  RGB(30, 30, 30))
    DrawValue(WindowW*0.5,      WindowH*0.5,        WindowW * 0.5 - (ircircle / 2) + 9, WindowW * 0.5 - (ircircle / 2) + 9, 100, ircircle / 2, idensity, F)
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle,     2,  RGB(  0,   0,   0))
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle - 1, 2,  RGB(255, 255, 255)) 
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle - 3, 2,  RGB(200, 200, 200)) 
    ACircle(WindowW*0.5,        WindowH*0.5,        WindowW * 0.5 - ircircle - 5, 2,  RGB(230, 230, 230)) 
    ACircle(new_x,        new_y,        ircircle - 5, 2,  RGB(  0,   0,   0))
    ACircle(new_x,        new_y,        ircircle - 6, 2,  RGB(160, 160, 160))
    ACircle(new_x,        new_y,        ircircle - 7, 2,  RGB(180, 180, 180))
    ACircle(new_x,        new_y,        ircircle - 10, 2, RGB(200, 200, 200))
  StopDrawing()

EndProcedure

; ****************************************************************************
; ****************************************************************************

Define.i event, eveng, evenp, WindowW = 200, WindowH = 200
  
If OpenWindow(#Window, 0, 0, WindowW, WindowH, "potentiomètre circulaire", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, WindowW, WindowH, #PB_Canvas_Keyboard)
  
  DrawCircular(WindowW, WindowH, WindowW * 0.5, WindowH)
  
  Repeat
    
    event = WaitWindowEvent()
    evenp = EventType()
    eveng = EventGadget()
    
    If eveng = #Canvas
      ;Debug "pass"
      If evenp = #PB_EventType_MouseWheel
        ;Debug GetGadgetAttribute(#Canvas, #PB_Canvas_WheelDelta)
      EndIf
      If evenp = #PB_EventType_LeftButtonDown Or (evenp = #PB_EventType_MouseMove And GetGadgetAttribute(#Canvas, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
        DrawCircular(WindowW, WindowH, GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX), GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY))
      EndIf
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf
End

Cordialement,
GallyHC

[Ehma]

MErci à tous pour vos encouragement, oui c'est juste un début. Je mettrai probablement le fichier dès que ça sera plus ettoffé. L'idée est de me préparer une série de routine pour créer une application de commande de synthé par sysex.

Pas facile pure basic quand on vient du monde Delphi et C++ il faut tout repenser différemment.

Merci à GallyHC pour son code, je vais y jeter un oeil. C'est en tout cas la classe Le résultat en jette.

[Shadow]

Oui jme doute que c'est pas simple car c'est bien trop facile pour toi maintenant