RotaryButtonGadget ???

[karmacomposer]

Here is a program that lets you create skins and knobs and it's FREE:

http://www.g200kg.com/en/software/skinman.html

Not sure how we could make it work with PureBasic, but I am sure someone smart
around here can figure it out.

Mike

[karmacomposer]

einander,

Could you provide the knob1.bmp file so I know what was used.

Thanks.

Mike

[einander]

@Mike and MachineCode:
Sorry for the delayed response. I was on august holydays far from the computer.
The old Knob image is lost, but here is a new canvas version without external images.
Cheers!

Code: Select all

;Knob 
;by einander
;PB 5.00 beta 2
EnableExplicit
Define Ev
#DEGTORAD=#PI/180.0
;
Structure Pointf
  X.F
  Y.F
EndStructure
;
Structure Knob
  Canv.I
  Size.L
  MinValue.L
  MaxValue.L
  XCenter.L
  YCenter.L
  RGB1.L
  RGB2.L
  LightRGB.l
  BkRGB.L  
  Ang.F  
  Catch.L
  Value.L
EndStructure
;
Global _Knob.Knob
#RADTODEG=180.0/#PI
;
Macro GadgetBottom(Gad)  : GadgetY(Gad)+GadgetHeight(Gad)  : EndMacro
Macro ModF( A, B ):(A-IntQ(A / B) * B):EndMacro
Macro CosAng(Ang,Radius):  Cos(Ang*#DEGTORAD)*RadiuS:EndMacro
Macro SinAng(Ang,Radius):  Sin(Ang*#DEGTORAD)*Radius:EndMacro
Macro MMx  :  WindowMouseX(EventWindow())  : EndMacro
Macro MMy  :  WindowMouseY(EventWindow())  : EndMacro
Macro MMk
  Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro
;
Procedure.F GetAngle(X1.F,Y1.F,X2,Y2)  ; Ret angle (Float)   
  Protected.F A = X2-X1,B = Y2-Y1,C = Sqr(A*A+B*B) 
  Protected.F Ang = ACos(A/C)*#RADTODEG
  If Y1 > Y2  : ProcedureReturn 360-Ang  : EndIf 
  ProcedureReturn Ang 
EndProcedure
;
Procedure Lim(A,B,C)
  If A<B :ProcedureReturn B
  ElseIf A>C :ProcedureReturn C
  EndIf
  ProcedureReturn A
EndProcedure     
;
Procedure AngLine(X.f,Y.f,Ang.f,LineSize.f,RGB=0) ; Draw line With Len LineSize from x y With angle Ang 
  LineXY(X,Y,X+CosAng(Ang,LineSize) ,Y+SinAng(Ang,LineSize),RGB)
EndProcedure  
;
Macro ConicGradient(X,Y,RGB1,RGB2,Ang)
  DrawingMode(#PB_2DDrawing_Gradient)      
  FrontColor(RGB1) 
  BackColor(RGB2)
  ConicalGradient(X, Y,Ang)     
EndMacro
;
Procedure AngleEndPoint(X.f,Y.f,Ang.f,LineSize.f,*P.PointF) ; Ret Circular end pointF for line, angle, Size
  *P\X= X+CosAng(Ang,LineSize)        
  *P\Y= Y+SinAng(Ang,LineSize) 
EndProcedure
;
Procedure SpinKNOB() ;RGB1=$777777,RGB2=$444444,bKRGB=0)
  With _Knob
    Protected RGB,Radius=\Size/2-1
    Protected J,P.Pointf,R=Radius*0.8
    StartDrawing(CanvasOutput(\Canv))
    Box(0,0,\Size,\Size,\BKRGB)
    CONICGradient(\XCENTER,\Ycenter,$333333,$888888,90)
    Circle(\XCENTER,\Ycenter,Radius) 
    DrawingMode(0)
    For J=0 To 7
      Angline(\XCENTER,\Ycenter,J*45,Radius*0.93,0)
    Next
    RGB=Point(P\X,P\Y)
    Angleendpoint(\Xcenter,\Ycenter,\Ang-90,Radius*0.85,P.Pointf)
    Circle(\XCENTER,\Ycenter,Radius*0.85,$121212) 
    LineXY(\Xcenter,\Ycenter,\Xcenter,\Ycenter-Radius,0)
    LineXY(\Xcenter,\Ycenter,P\X,P\Y,0)
    ConicGradient(\XCENTER,\Ycenter,\RGB1,\RGB2,-\Ang+90)
    Circle(\XCENTER,\Ycenter,Radius*0.75)
    ConicGradient(\XCENTER,\Ycenter,\RGB2,\RGB1,-\Ang+90)
    Circle(\XCENTER,\Ycenter,Radius*0.70)
    DrawingMode(#PB_2DDrawing_Outlined)
    Circle(\XCENTER,\Ycenter,Radius*0.75,$676767)
    Circle(\XCENTER,\Ycenter,Radius*0.85,0)
    If \Value>\MinValue And \Value<\MaxValue
      FillArea(\Xcenter+2,\Ycenter-Radius*0.85+2,-1,\lightRGB)
    EndIf
    StopDrawing()
  EndWith  
EndProcedure
;
Procedure.F RotaF(X.F ,Min ,Max ) 
  Protected A.F
  If X>=Min And X<=Max :ProcedureReturn X :EndIf
  If X <-Min  :A=-1 :EndIf 
  If X >=Min 
    ProcedureReturn Modf((X -Min -A), (1+Max -Min )) + A+Min 
  EndIf
  ProcedureReturn Modf((1+X -Min -A), (1+Max -Min )) + A+Max 
EndProcedure  
;
Procedure Proportion(X.F, Min,Max,A.F,Z.F)
  If X = Min : ProcedureReturn A: EndIf   
  If X = Max : ProcedureReturn Z: EndIf
  Protected B.F=(Max-Min) / (X - Min)
  ProcedureReturn Lim(A + (Z-A) / B,A,Z)
EndProcedure
;
Procedure CanvMKDown(Canv)
  If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(Canv, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
    ProcedureReturn #True
  EndIf
  ProcedureReturn 0
EndProcedure
;  
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 0, 0, 400, 400, "Knob", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
With _Knob
  ;----------------  your settings here 
  \Size=220  ; minimum  60
  \MinValue=0       
  \MaxValue=1000
  \RGB1=$Bfbfbf 
  \RGB2=$454545
  \lightRGB=$aaff
  \BkRGB=$12
  ;----------------
  \Ang=0 
  \Canv=CanvasGadget(#PB_Any, (WindowWidth(0)-\Size)/2,(WindowHeight(0)-\Size)/2,\Size,\Size,#PB_Canvas_Keyboard)
  \XCenter=\Size/2.0
  \YCenter=\Size/2.0
  SetWindowColor(0,\BkRGB)
  Define Info=TextGadget(#PB_Any,GadgetX(\canv)+\xcenter,GadgetY(\Canv)-35,100,30,"")
  SetGadgetColor(Info,#PB_Gadget_FrontColor,#White)
  SetGadgetColor(Info,#PB_Gadget_BackColor,\BKRGB)
  Spinknob()
  SetGadgetText(Info,Str(\Value))
  Repeat
    If GetAsyncKeyState_(27)&$8000 :  End : EndIf 
    Ev = WaitWindowEvent()
    If MMx>-1 And MMy>-1 
      If \Catch 
        If EventType() = #PB_EventType_LeftButtonUp
          \Catch=0
        EndIf
      ElseIf CanvMkDown(\Canv)
        \Catch=1 ; catch the knob until mouse is released
      EndIf  
      If \Catch
        \Ang=RotaF(GetAngle(MMx,MMy,GadgetX(\Canv)+\XCenter,GadgetY(\Canv)+\YCenter)-90,0,360)
        Spinknob()
        \Value= Proportion(\Ang,0,360,\MinValue,\MaxValue)
        SetGadgetText(Info,Str(\Value))
      EndIf
    EndIf  
  Until Ev = #PB_Event_CloseWindow
EndWith
End

[ozzie]

Many thanks, einander. Looks good and could be useful.

[VB6_to_PBx]

einander ,

works and looks great !
Thank you !

[doctornash]

ooh now that is a thing of consumate beauty
looking to plonk about 10 of these in a project - so a multi-instance example with (I assume) everything above ;<<< in a .pbi would be just wonderful

[davido]

@doctornash

The link below to an excellent post by RichardL, may be of interest:


http://www.purebasic.fr/english/viewtop ... nob+gadget

[einander]

@doctornash:
May be this helps:
http://www.purebasic.fr/english/viewtop ... 40&t=57117
Cheers!

[doctornash]

@einander, that helps tremendously - thanks muchly