Wheel gadget like the one found in avidemux

Share your advanced PureBasic knowledge/code with the community.
User avatar
Psychophanta
Addict
Addict
Posts: 4780
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Wheel gadget like the one found in avidemux

Post by Psychophanta »

Inspired on the idea from @Infratec (at https://www.purebasic.fr/english/viewtopic.php?t=79132) , I wrote this one, which may be helpful for some tasks:

Code: Select all

Structure WheelGadgetStructure
  window.i
  gadget.i
  x.i
  y.i
  width.i
  height.i
  min.i
  max.i
  flags.i
  Pos.i
  LeftButtonDown.i
  LastPosMouse.i
EndStructure
Procedure WheelGadgetDraw(*WheelGadget.WheelGadgetStructure)
  Protected.i i,PosStep,Pos
  If StartDrawing(CanvasOutput(*WheelGadget\gadget))
    DrawingMode(#PB_2DDrawing_Gradient):BackColor($808080):FrontColor($FFFFFF)
    LinearGradient(0,0,*WheelGadget\width/2,0):Box(0,0,*WheelGadget\width/2,*WheelGadget\height)
    LinearGradient(*WheelGadget\width,0,*WheelGadget\width/2,0):Box(*WheelGadget\width/2,0,*WheelGadget\width/2,*WheelGadget\height) 
    DrawingMode(#PB_2DDrawing_Default)
    Box(*WheelGadget\Pos-1,0,3,*WheelGadget\height,#Red)
    PosStep=*WheelGadget\width/9
    Pos=*WheelGadget\Pos-PosStep
    While Pos>0
      LineXY(Pos,0,Pos,*WheelGadget\height,#Gray)
      Pos-PosStep
    Wend
    Pos=*WheelGadget\Pos+PosStep
    While Pos<*WheelGadget\width
      LineXY(Pos,0,Pos,*WheelGadget\height,#Gray)
      Pos+PosStep
    Wend
    DrawingMode(#PB_2DDrawing_Outlined)
    If *WheelGadget\Flags!#PB_ScrollArea_BorderLess
      Box(0,0,*WheelGadget\width,*WheelGadget\height,0)
    EndIf
    StopDrawing() 
  EndIf
EndProcedure
Procedure WheelGadgetDrawVertical(*WheelGadget.WheelGadgetStructure)
  Protected.i i,PosStep,Pos
  If StartDrawing(CanvasOutput(*WheelGadget\gadget))
    DrawingMode(#PB_2DDrawing_Gradient):BackColor($808080):FrontColor($FFFFFF)
    LinearGradient(0,0,0,*WheelGadget\height/2):Box(0,0,*WheelGadget\width,*WheelGadget\height/2)
    LinearGradient(0,*WheelGadget\height,0,*WheelGadget\height/2):Box(0,*WheelGadget\height/2,*WheelGadget\width,*WheelGadget\height/2) 
    DrawingMode(#PB_2DDrawing_Default)
    Box(0,*WheelGadget\Pos-1,*WheelGadget\width,3,#Red)
    PosStep=*WheelGadget\height/9
    Pos=*WheelGadget\Pos-PosStep
    While Pos>0
      LineXY(0,Pos,*WheelGadget\width,Pos,#Gray)
      Pos-PosStep
    Wend
    Pos=*WheelGadget\Pos+PosStep
    While Pos<*WheelGadget\height
      LineXY(0,Pos,*WheelGadget\width,Pos,#Gray)
      Pos+PosStep
    Wend
    DrawingMode(#PB_2DDrawing_Outlined)
    If *WheelGadget\Flags!#PB_ScrollArea_BorderLess
      Box(0,0,*WheelGadget\width,*WheelGadget\height,0)
    EndIf
    StopDrawing() 
  EndIf
EndProcedure
Procedure WheelGadgetCB()
  Protected PosMouse.i,*WheelGadget.WheelGadgetStructure
  *WheelGadget=GetGadgetData(EventGadget())
  If *WheelGadget
    Select EventType()
      Case #PB_EventType_LeftButtonDown
        *WheelGadget\LeftButtonDown=1
        *WheelGadget\LastPosMouse=GetGadgetAttribute(*WheelGadget\gadget,#PB_Canvas_MouseX)
      Case #PB_EventType_LeftButtonUp
        *WheelGadget\LastPosMouse=0
        *WheelGadget\LeftButtonDown=0
        PosMouse=0
        *WheelGadget\Pos=*WheelGadget\width/2
        PostEvent(#PB_Event_Gadget, *WheelGadget\window, *WheelGadget\gadget, #PB_EventType_Change,0)
        WheelGadgetDraw(*WheelGadget)
      Case #PB_EventType_MouseMove
        If *WheelGadget\LeftButtonDown And *WheelGadget\LastPosMouse>0 And *WheelGadget\LastPosMouse<*WheelGadget\width
          PosMouse=GetGadgetAttribute(*WheelGadget\gadget,#PB_Canvas_MouseX)
          *WheelGadget\Pos-*WheelGadget\LastPosMouse+PosMouse
          *WheelGadget\LastPosMouse=PosMouse
          If *WheelGadget\Pos<1:*WheelGadget\Pos=1:EndIf
          If *WheelGadget\Pos>*WheelGadget\width:*WheelGadget\Pos=*WheelGadget\width:EndIf
          PostEvent(#PB_Event_Gadget,*WheelGadget\window,*WheelGadget\gadget, #PB_EventType_Change,-100+(*WheelGadget\Pos-1)*(100+100)/(*WheelGadget\width-1))
          WheelGadgetDraw(*WheelGadget)
        EndIf
    EndSelect
  EndIf
EndProcedure
Procedure WheelGadgetCBVertical()
  Protected PosMouse.i,*WheelGadget.WheelGadgetStructure
  *WheelGadget=GetGadgetData(EventGadget())
  If *WheelGadget
    Select EventType()
      Case #PB_EventType_LeftButtonDown
        *WheelGadget\LeftButtonDown=1
        *WheelGadget\LastPosMouse=GetGadgetAttribute(*WheelGadget\gadget,#PB_Canvas_MouseY)
      Case #PB_EventType_LeftButtonUp
        *WheelGadget\LastPosMouse=0
        *WheelGadget\LeftButtonDown=0
        PosMouse=0
        *WheelGadget\Pos=*WheelGadget\height/2
        PostEvent(#PB_Event_Gadget, *WheelGadget\window,*WheelGadget\gadget,#PB_EventType_Change,0)
        WheelGadgetDrawVertical(*WheelGadget)
      Case #PB_EventType_MouseMove
        If *WheelGadget\LeftButtonDown And *WheelGadget\LastPosMouse>0 And *WheelGadget\LastPosMouse<*WheelGadget\height
          PosMouse=GetGadgetAttribute(*WheelGadget\gadget,#PB_Canvas_MouseY)
          *WheelGadget\Pos-*WheelGadget\LastPosMouse+PosMouse
          *WheelGadget\LastPosMouse=PosMouse
          If *WheelGadget\Pos<1:*WheelGadget\Pos=1:EndIf
          If *WheelGadget\Pos>*WheelGadget\height:*WheelGadget\Pos=*WheelGadget\height:EndIf
          PostEvent(#PB_Event_Gadget,*WheelGadget\window,*WheelGadget\gadget, #PB_EventType_Change,-100+(*WheelGadget\Pos-1)*(100+100)/(*WheelGadget\height-1))
          WheelGadgetDrawVertical(*WheelGadget)
        EndIf
    EndSelect
  EndIf
EndProcedure
Procedure.i WheelGadget(gadget.i, x.i, y.i, width.i, height.i, min.i=-1, max.i=-1, Flags.i=0)
  Protected gadgetno.i,result.i,*WheelGadget.WheelGadgetStructure
  If gadget=#PB_Any
    gadgetno=CanvasGadget(gadget,x,y,width,height)
    result=gadgetno
  Else
    gadgetno=gadget
    result=CanvasGadget(gadget,x,y,width,height)
  EndIf
  If result
    *WheelGadget=AllocateStructure(WheelGadgetStructure)
    *WheelGadget\window=GetActiveWindow()
    *WheelGadget\gadget=gadgetno
    *WheelGadget\x=x
    *WheelGadget\y=y
    *WheelGadget\width=width
    *WheelGadget\height=height
    If min<>-1 And max>min
      *WheelGadget\min=min
      *WheelGadget\max=max
    Else
      *WheelGadget\min=0
      *WheelGadget\max=100
    EndIf
    *WheelGadget\flags=flags
    If *WheelGadget\flags&#PB_ScrollBar_Vertical
      *WheelGadget\Pos=height/2
      WheelGadgetDrawVertical(*WheelGadget)
      BindGadgetEvent(gadgetno, @WheelGadgetCBVertical(), #PB_All)
    Else
      *WheelGadget\Pos=width/2
      WheelGadgetDraw(*WheelGadget)
      BindGadgetEvent(gadgetno, @WheelGadgetCB(), #PB_All)
    EndIf
    SetGadgetData(gadgetno,*WheelGadget)
  EndIf
  ProcedureReturn result
EndProcedure

OpenWindow(0,0,0,400,400,"WheelGadget example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
WheelGadget(0,10,10,380,30,-1,-1,#PB_ScrollArea_BorderLess):TextGadget(5,190,40,30,20,"0%")
WheelGadget(1,100,60,20,300,100,900,#PB_ScrollBar_Vertical):TextGadget(6,70,200,30,20,"0%")
Repeat
  Event.i=WaitWindowEvent()
  Select Event
  Case #PB_Event_Gadget
    Select EventGadget()
    Case 0
      If EventType()=#PB_EventType_Change
        SetGadgetText(5,Str(EventData())+"%")
      EndIf
    Case 1
      If EventType()=#PB_EventType_Change

        SetGadgetText(6,Str(EventData())+"%")

      EndIf
    EndSelect
  EndSelect
Until Event=#PB_Event_CloseWindow
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will have in your own home the atomic heat coming from your backyard, but don't worry, you won't even feel it.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8285
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Wheel gadget like the one found in avidemux

Post by netmaestro »

Looks very good! Useful too.
BERESHEIT
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5066
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Wheel gadget like the one found in avidemux

Post by Kwai chang caine »

Really, really nice :shock:
Thanks a lot for sharing this jewel 8)
ImageThe happiness is a road...
Not a destination
User avatar
Psychophanta
Addict
Addict
Posts: 4780
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Wheel gadget like the one found in avidemux

Post by Psychophanta »

I take advantage to write the same in less lines of code.

The tip is useful for example, to do things like fine tunning a value:

Code: Select all

Structure RuletaGadgetStructure
  window.i
  gadget.i
  x.i
  y.i
  width.i
  height.i
  min.i
  max.i
  flags.i
  Pos.i
  LeftButtonDown.i
  LastPosMouse.i
EndStructure
Procedure RuletaGadgetDraw(*RuletaGadget.RuletaGadgetStructure)
  Protected s.b=*RuletaGadget\flags&#PB_ScrollBar_Vertical,c.b=s!1,w.i=*RuletaGadget\width*c+*RuletaGadget\height*s,h.i=*RuletaGadget\width*s+*RuletaGadget\height*c,PosStep.i=(w+h)/9,Pos.i
  If StartDrawing(CanvasOutput(*RuletaGadget\gadget))
    DrawingMode(#PB_2DDrawing_Gradient):BackColor($808080):FrontColor($FFFFFF)
    LinearGradient(0,0,*RuletaGadget\width*c/2,*RuletaGadget\height*s/2):Box(0,0,*RuletaGadget\width>>c,*RuletaGadget\height>>s)
    LinearGradient(*RuletaGadget\width*c,*RuletaGadget\height*s,*RuletaGadget\width*c/2,*RuletaGadget\height*s/2):Box(*RuletaGadget\width*c/2,*RuletaGadget\height*s/2,*RuletaGadget\width>>c,*RuletaGadget\height>>s) 
    DrawingMode(#PB_2DDrawing_Default)
    Box((*RuletaGadget\Pos-1)*c,(*RuletaGadget\Pos-1)*s,3*c+*RuletaGadget\width*s,*RuletaGadget\height*c+3*s,#Red)
    Pos=*RuletaGadget\Pos-PosStep
    While Pos>0
      Line(Pos*c,Pos*s,c+*RuletaGadget\width*s,*RuletaGadget\height*c+s,#Gray):Pos-PosStep
    Wend
    Pos=*RuletaGadget\Pos+PosStep
    While Pos<w
      Line(Pos*c,Pos*s,c+*RuletaGadget\width*s,*RuletaGadget\height*c+s,#Gray):Pos+PosStep
    Wend
    DrawingMode(#PB_2DDrawing_Outlined)
    If *RuletaGadget\Flags!#PB_ScrollArea_BorderLess
      Box(0,0,*RuletaGadget\width,*RuletaGadget\height,0)
    EndIf
    StopDrawing() 
  EndIf
EndProcedure
Procedure RuletaGadgetCB()
  Protected PosMouse.i,*RuletaGadget.RuletaGadgetStructure=GetGadgetData(EventGadget()),s.b=*RuletaGadget\flags&#PB_ScrollBar_Vertical,c.b=s!1:l.i=*RuletaGadget\width*c+*RuletaGadget\height*s
  If *RuletaGadget
    Select EventType()
      Case #PB_EventType_LeftButtonDown
        *RuletaGadget\LeftButtonDown=1
        *RuletaGadget\LastPosMouse=GetGadgetAttribute(*RuletaGadget\gadget,(#PB_Canvas_MouseX*c+#PB_Canvas_MouseY*s))
      Case #PB_EventType_LeftButtonUp
        *RuletaGadget\LastPosMouse=0
        *RuletaGadget\LeftButtonDown=0
        PosMouse=0
        *RuletaGadget\Pos=l/2
        PostEvent(#PB_Event_Gadget,*RuletaGadget\window,*RuletaGadget\gadget,#PB_EventType_Change,0)
        RuletaGadgetDraw(*RuletaGadget)
      Case #PB_EventType_MouseMove
        If *RuletaGadget\LeftButtonDown And *RuletaGadget\LastPosMouse>0 And *RuletaGadget\LastPosMouse<l
          PosMouse=GetGadgetAttribute(*RuletaGadget\gadget,(#PB_Canvas_MouseX*c+#PB_Canvas_MouseY*s))
          *RuletaGadget\Pos-*RuletaGadget\LastPosMouse+PosMouse
          *RuletaGadget\LastPosMouse=PosMouse
          If *RuletaGadget\Pos<1:*RuletaGadget\Pos=1:EndIf
          If *RuletaGadget\Pos>l:*RuletaGadget\Pos=l:EndIf
          PostEvent(#PB_Event_Gadget,*RuletaGadget\window,*RuletaGadget\gadget,#PB_EventType_Change,-100+(*RuletaGadget\Pos-1)*(100+100)/(l-1))
          RuletaGadgetDraw(*RuletaGadget)
        EndIf
    EndSelect
  EndIf
EndProcedure
Procedure.i RuletaGadget(gadget.i,x.i,y.i,width.i,height.i,min.i=-1,max.i=-1,flags.i=0)
  Protected result.i=CanvasGadget(gadget,x,y,width,height),*RuletaGadget.RuletaGadgetStructure,s.b=flags&#PB_ScrollBar_Vertical,c.b=s!1
  If gadget=#PB_Any:gadget=result:EndIf
  If result
    *RuletaGadget=AllocateStructure(RuletaGadgetStructure)
    *RuletaGadget\window=GetActiveWindow()
    *RuletaGadget\gadget=gadget
    *RuletaGadget\x=x
    *RuletaGadget\y=y
    *RuletaGadget\width=width
    *RuletaGadget\height=height
    If min<>-1 And max>min
      *RuletaGadget\min=min
      *RuletaGadget\max=max
    Else
      *RuletaGadget\min=0
      *RuletaGadget\max=100
    EndIf
    *RuletaGadget\flags=flags
    *RuletaGadget\Pos=(*RuletaGadget\width*c+*RuletaGadget\height*s)/2
    RuletaGadgetDraw(*RuletaGadget)
    BindGadgetEvent(*RuletaGadget\gadget,@RuletaGadgetCB(),#PB_All)
    SetGadgetData(*RuletaGadget\gadget,*RuletaGadget)
  EndIf
  ProcedureReturn result
EndProcedure

OpenWindow(0,0,0,400,400,"RuletaGadget example",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
RuletaGadget(0,10,10,30,380,-1,-1,#PB_ScrollBar_Vertical)
SpinGadget(1,120,10, 100, 25,-1000, 1000):SetGadgetText(1,strf(0,5))
Repeat
  Event.i=WaitWindowEvent(100)
  dat1.f-dat.f*1E-5
  SetGadgetText(1,strf(dat1,5))
  Select Event
  Case #PB_Event_Gadget
    Select EventGadget()
    Case 0
      If EventType()=#PB_EventType_Change
        dat.f=EventData()
      endif 
    Case 1
      If EventType()=#PB_EventType_Down:dat1.f-1
      ElseIf EventType()=#PB_EventType_Up:dat1.f+1
      EndIf
      SetGadgetText(1,Strf(dat1,5))
    EndSelect
  EndSelect
Until Event=#PB_Event_CloseWindow
(NOTICE: I don't know why the sentence 'SetGadgetText(1,strf(dat1,5))', at the main loop, makes the mouse key to become sticky sometimes while managing the wheel :? )
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will have in your own home the atomic heat coming from your backyard, but don't worry, you won't even feel it.
Post Reply