PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

A spingadget-like gadget but with buttons

https://www.purebasic.fr/english/viewtopic.php?t=61960

Page 1 of 1

A spingadget-like gadget but with buttons

Posted: Tue Mar 24, 2015 12:05 pm
by Tess
I'd like to simulate a spingadget but without the edit gadget and with 2 buttons or 2 imagebuttons.

Do you have a better solution and simplier solution than mine ?

Code: Select all

Enumeration FormWindow
  #Window_1
EndEnumeration

Enumeration FormGadget
  #Button_0
  #Button_1
EndEnumeration

;  Structures
Structure GadgetSubClass
  hWnd.l
  id.l
  oldWndProc.l
EndStructure


Global NewList gadgets.GadgetSubClass()
Global TheStep = 1 ; +/- 1
Global DelayBeforescrolling = 500 ;ms
Global SpeedScrolling = 100       ;ms
Global Count


Procedure DelayScroll(delayy, PStep)
  ; Delay before scrolling
  count=count+PStep
  Debug Count
  Delay(delayy)
EndProcedure

Procedure GadgetCallback(hWnd,Msg,wParam,lParam)
  
  
  Select Msg
    Case #WM_SETCURSOR    
      SetWindowTitle(#Window_1,"Handle= "+Str(wParam)+"   , "+"ID= "+Str(GetDlgCtrlID_(wParam)))
      If GetDlgCtrlID_(wParam)=0
        TheStep=-1*TheStep
      Else
        TheStep=1*TheStep
      EndIf
      
    Case #WM_LBUTTONDOWN                
      DelayScroll(DelayBeforeScrolling,TheStep)
      While WindowEvent() <> #WM_LBUTTONUP
        count=count+1
        Debug Count
        Delay(SpeedScrolling)
      Wend
      ProcedureReturn 0
             
    Case #WM_LBUTTONUP
      SetCapture_(0)
      ProcedureReturn 0

  EndSelect
  
  ForEach gadgets()
    If gadgets()\hWnd = hWnd
      ProcedureReturn CallWindowProc_(gadgets()\oldWndProc,hWnd,Msg,wParam,lParam)
    EndIf
  Next
EndProcedure

Procedure AddGadget(hGadget)
  Protected id
  If IsGadget(hGadget)
    hWnd = GadgetID(hGadget) 
  Else
    hWnd = hGadget
  EndIf
  If hWnd
    LastElement(gadgets())
    AddElement(gadgets())
    gadgets()\hWnd = hWnd
    id=GetDlgCtrlID_(hWnd)
    gadgets()\id = id
    gadgets()\oldWndProc = SetWindowLongPtr_(hWnd,#GWLP_WNDPROC,@GadgetCallback())  
  EndIf
  ProcedureReturn hGadget
EndProcedure 

Procedure OpenWindow_1(x = 0, y = 0, width = 270, height = 100)
  OpenWindow(#Window_1, x, y, width, height, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  AddGadget(ButtonGadget(#Button_0, 10, 30, 30, 30, "<-"))
  AddGadget(ButtonGadget(#Button_1, 50, 30, 30, 30, "->"))
    
EndProcedure

OpenWindow_1()

Repeat
  event = WaitWindowEvent(10) 
Until event = #PB_Event_CloseWindow

End

Re: A spingadget-like gadget but with buttons

Posted: Wed Mar 25, 2015 7:41 pm
by Jagermeister
Your code seems ummm over-coded to me. No offense intended. I may have missed the gist in my laziness :D

Code: Select all

Enumeration FormWindow
  #Window_1
EndEnumeration

Enumeration FormGadget
  #Button_0
  #Button_1
EndEnumeration

Declare speedControl()

Global count.f = 1
Global speed = 100 ; beginning value

Procedure OpenWindow_1(x = 0, y = 0, width = 270, height = 100)
  
  OpenWindow(#Window_1, x, y, width, height, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ButtonGadget(#Button_0, 10, 30, 30, 30, "<-")
  ButtonGadget(#Button_1, 50, 30, 30, 30, "->")
  BindEvent(#PB_Event_Gadget, @speedControl())
  
EndProcedure

Procedure speedControl()

  Select EventGadget()
    Case #Button_0
      count + 0.5
    Case #Button_1
      count - 0.5
  EndSelect
  
  Debug "multiplier: " + StrF(count)
  Debug "speed: " + Str(speed * count) + "%"
  
EndProcedure

OpenWindow_1()

Repeat
  Delay(1)
Until WaitWindowEvent() = #PB_Event_CloseWindow

Re: A spingadget-like gadget but with buttons

Posted: Thu Mar 26, 2015 6:55 am
by netmaestro
What the heck, it's raining outside anyway. Not simpler but maybe more comprehensive and plug & play:

Code: Select all

;=============================================================================================================================
; Includefile:        CUSTOM SPINNER INCLUDE
;
; Author:             Lloyd Gallant (netmaestro)
; Date:               March 25, 2015
; Why:                It's raining outside
; Target OS:          Microsoft Windows
; Target Compiler:    PureBasic 5.31
; License:            Do as you like with it
; Warranty:           5 years give or take, no coverage whatsoever
;
; Usage:              <var>.CSPIN::iCSPIN = CSPIN::CreateInstance(x, y, initialvalue, CSPIN::#Portrait)  // Create vertical spinner
;                     <var>.CSPIN::iCSPIN = CSPIN::CreateInstance(x, y, initialvalue, CSPIN::#Landscape) // Create horizontal spinner
;
;                     <var> is now a custom spinner object and supports these methods:
;
;                     Increment()        // increase gadget's value by 1
;                     Decrement()        // decrease gadget's value by 1
;                     SetValue(newvalue) // set a new value
;                     Value()            // returns gadget's current value
;                     Disable(state)     // Disables/Enables gadget depending on state (mimics PB's DisableGadget() )
;                     Dispose()          // free gadget and its resources
;
;                     Have fun and don't poke your eye out with it
;
;==============================================================================================================================

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Please compile custom spinner include with threadsafe switch"
CompilerEndIf

DeclareModule CSPIN
  
  #Portrait  = 0
  #Landscape = 1
  
  Interface iCSPIN
    Increment()
    Decrement()
    Value()
    SetValue(newvalue)
    Disable(state)
    Dispose()
  EndInterface
  
  Structure sCSPIN
    *vtable
    container.i
    incCanvas.i
    decCanvas.i
    value.i
    display.i
    imgIncNormal.i
    imgIncDisabled.i
    imgIncHot.i
    imgIncPressed.i
    imgDecNormal.i
    imgDecDisabled.i
    imgDecHot.i
    imgDecPressed.i  
    keyboardDelay.i
  EndStructure
  
  Declare CreateInstance(x=0, y=0, initialvalue=0, display=#Landscape)
  
EndDeclareModule

Module CSPIN
  
  Global keyDelayThreadID
  
  Procedure Increment(*this.sCSPIN)
    *this\value + 1
  EndProcedure
  
  Procedure Decrement(*this.sCSPIN)
    *this\value - 1
  EndProcedure
  
  Procedure Value(*this.sCSPIN)
    ProcedureReturn *this\value
  EndProcedure
  
  Procedure SetValue(*this.sCSPIN, newvalue)
    *this\value = newvalue
  EndProcedure
  
  Procedure Disable(*this.sCSPIN, state)
    DisableGadget(*this\incCanvas, state)
    DisableGadget(*this\decCanvas, state)
    If state
      SetGadgetAttribute(*this\incCanvas, #PB_Canvas_Image, ImageID(*this\imgIncDisabled))
      SetGadgetAttribute(*this\decCanvas, #PB_Canvas_Image, ImageID(*this\imgDecDisabled))
    Else
      SetGadgetAttribute(*this\incCanvas, #PB_Canvas_Image, ImageID(*this\imgIncNormal))
      SetGadgetAttribute(*this\decCanvas, #PB_Canvas_Image, ImageID(*this\imgDecNormal))
    EndIf
  EndProcedure
  
  Procedure KeyDelay(gadget)
    Delay(250)
    *this.sCSPIN = GetGadgetData(gadget)
    While GetAsyncKeyState_(#VK_LBUTTON) & 32768
      Delay(*this\keyboardDelay)
      Select gadget
        Case *this\incCanvas
          *this\value + 1
        Case *this\decCanvas
          *this\value - 1
      EndSelect
    Wend
  EndProcedure
  
  Procedure ProcessIncEvents()
    Protected thisgadget = EventGadget()
    *this.sCSPIN = GetGadgetData(thisgadget)
    Select EventType()
      Case #PB_EventType_MouseEnter
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncHot))
      Case #PB_EventType_MouseLeave 
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncNormal))
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
      Case #PB_EventType_LeftButtonDown
        *this\value + 1
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncPressed))
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
        keyDelayThreadID = CreateThread(@KeyDelay(), thisgadget)
      Case #PB_EventType_LeftButtonUp
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgIncHot))
    EndSelect
  EndProcedure
  
  Procedure ProcessDecEvents()
    Protected thisgadget = EventGadget()
    *this.sCSPIN = GetGadgetData(thisgadget)
    Select EventType()
      Case #PB_EventType_MouseEnter
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecHot))
      Case #PB_EventType_MouseLeave 
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecNormal))
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
      Case #PB_EventType_LeftButtonDown
        *this\value - 1
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecPressed))
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
        keyDelayThreadID = CreateThread(@KeyDelay(), thisgadget)
      Case #PB_EventType_LeftButtonUp
        If IsThread(keyDelayThreadID):KillThread(keyDelayThreadID):EndIf
        SetGadgetAttribute(thisgadget, #PB_Canvas_Image, ImageID(*this\imgDecHot))
    EndSelect
  EndProcedure
  
  Procedure Dispose(*this.sCSPIN)
    FreeImage(*this\imgIncNormal)
    FreeImage(*this\imgIncDisabled)
    FreeImage(*this\imgIncHot)
    FreeImage(*this\imgIncPressed)
    FreeImage(*this\imgDecNormal)
    FreeImage(*this\imgDecDisabled)
    FreeImage(*this\imgDecHot)
    FreeImage(*this\imgDecPressed)    
    FreeGadget(*this\container)
    FreeMemory(*this)
  EndProcedure
  
  Procedure DrawButtons(*this.sCSPIN)
    UseLZMAPacker()
    *unpacked = AllocateMemory(3894)
    UncompressMemory(?Vert, 558, *unpacked, 3894)
    Protected img0 = CatchImage(#PB_Any, *unpacked, 3894)
    FreeMemory(*unpacked) : *unpacked = AllocateMemory(3894)
    UncompressMemory(?Horz, 509, *unpacked, 3894)
    Protected img1 = CatchImage(#PB_Any, *unpacked, 3894) : FreeMemory(*unpacked)
    
    With *this
      If \display=#Portrait
        \imgIncNormal   = GrabImage(Img0,#PB_Any,0, 0,16,10)  
        \imgDecNOrmal   = GrabImage(Img0,#PB_Any,0,10,16,10) 
        \imgIncDisabled = GrabImage(Img0,#PB_Any,0,20,16,10) 
        \imgDecDisabled = GrabImage(Img0,#PB_Any,0,30,16,10) 
        \imgIncHot      = GrabImage(Img0,#PB_Any,0,40,16,10) 
        \imgDecHot      = GrabImage(Img0,#PB_Any,0,50,16,10) 
        \imgIncPressed  = GrabImage(Img0,#PB_Any,0,60,16,10) 
        \imgDecPressed  = GrabImage(Img0,#PB_Any,0,70,16,10)  
      Else
        \imgIncNormal   = GrabImage(Img1,#PB_Any,10,0,10,16)
        \imgDecNOrmal   = GrabImage(Img1,#PB_Any, 0,0,10,16)
        \imgIncDisabled = GrabImage(Img1,#PB_Any,30,0,10,16)
        \imgDecDisabled = GrabImage(Img1,#PB_Any,20,0,10,16)
        \imgIncHot      = GrabImage(Img1,#PB_Any,50,0,10,16)
        \imgDecHot      = GrabImage(Img1,#PB_Any,40,0,10,16)
        \imgIncPressed  = GrabImage(Img1,#PB_Any,70,0,10,16)
        \imgDecPressed  = GrabImage(Img1,#PB_Any,60,0,10,16)
      EndIf
    EndWith
    FreeImage(img0):FreeImage(img1)
    
    DataSection
      Vert:
      Data.q $132100010000005D,$D009ACD5CA3FBF42,$EC84F3E986B1DD95,$F7C17AFFD6A078D4,$A19FA75B74B9EFAA,$6DC8C55050004943,
             $474AE9AA6E8CB6A7,$F9321355FC745940,$A185BA0568B577CA,$586530EB61136E69,$04BE6AC1E2676403,$1BF050075C15FFC0,
             $F746FE148B28294B,$362EBC7595480672,$BED1D60E2E8BED55,$426F51668641E463,$3BF9F2D302BD08BD,$FEDD7BB14844BDD4,
             $594E6AEAF6D54F5F,$D8F3110D96BB5CC4,$C6B47C1D723AE0A2,$44A24EE103DDE41E,$92A6270CFD900B16,$DBB3F7E119583652,
             $A27D2A4DE21D612E,$FA0D37C660C4ABFE,$7ABCE2F624D48E0B,$D834B2164A470E99,$F7CFFB6899112697,$4997AA7B4AFCB696,
             $BA6EAD905A0B54AB,$34281C6D24C61685,$56DFFABC6909D0B1,$F643400E0EDD3D1D,$0BD8ADD93ACF43A4,$E7980DF26ADCC463,
             $E44E6C2AC3CA7BEA,$8211D84D3D9F8927,$B9D8DE3C4595A4DB,$AD8EE86A20B17DEE,$D3165330C7E32F28,$933EDDB68874FAE1,
             $CCB722C6A4AD17C0,$75B062C722402287,$1B33AFBC13B036F8,$5B552011537A40C1,$FF816744F513E983,$D40B60F9B41419C9,
             $A0D62D39BFE415EF,$948C6B6659467592,$5F1357AB78F0B4CC,$76E998D9FC1F4697,$D5FE82BD7676E426,$A84DB06C867353F7,
             $5A6FBA0E43C6EEC2,$78CF1FD66B4F189B,$E13EA91223B36B4A,$3E0DC722B238230F,$BFB774BFD523818D,$C3A279E2382EE459,
             $34DD2C4E289C70FB,$61953C529520E87B,$4032EBFA3D2F7856,$C35164665A04457F,$B088684731BB18FC,$40A1274C48310312,
             $39D30E6E128822D0,$6644A53441E21566,$C4A26EAB3FAE7390 : Data.b $F2,$3D,$7A,$CA,$C1,$23
      Horz:
      Data.q $132100010000005D,$D009ACD5CA3FBF42,$16219C0A84B2E295,$3E4D8F210FB8F320,$1BF7073243CD503F,$7DAFEE9B1830B131,
             $31BD1EDA99025CF1,$C22B21605796476F,$C1A79A8A60233BAB,$738DD11F859191D1,$6BA039FDA28BA9D4,$3469D491FE4DAA6D,
             $100558038DF3177C,$80390E907F7B5C2E,$A2EEC48189D2BEEF,$22E11DFFF4DB47CB,$952CE00397F9A438,$5634481819442B54,
             $0E6FA7FD70CC0A02,$2DA99FE8F568FD5C,$F127138882F815AF,$C2F7453CA8A88E64,$3ED512D9F9CE42F7,$AF990A2505464A8E,
             $C057E35ECC1980B2,$AAC7EED330751940,$5BBF7A8F7C1E6176,$E37815CEECB0C80D,$C63A9A26D83D7775,$0857C1D092A43294,
             $AFC9DEE3B45E73DD,$BFC78223A95B32DB,$802CD96AAD20434D,$900C645D19BE3B4B,$B5DE2DCE56267CE0,$127AF86F0BF0F637,
             $673828428614BDBC,$4EB72567301D8A5A,$60ACF28663472FDE,$50B92AE945F175F8,$2191600472F13098,$6488820D031D048A,
             $08E44D188D2D298C,$83A05E45B1A48731,$753D45698884A9C3,$15A2B1B5F02250E0,$59756D422080D8D2,$8FB1EEC30D4A547F,
             $4BAB34FF4C1A0AF4,$2DF848EBBB09F414,$C0BE483B472DB875,$D0D551AE96452BEB,$990DECCC29E00B27,$1B7A224F06EB38E8,
             $7527C0810B3FC359,$C37B195483F24370,$4C56F4727D8E9ABA,$75C612C99E9AC2AA,$8366906CC4D97ACC,$F086A3874553C1B0,
             $349CD00477226D21,$13A3509FF9885491,$84C5D1BDC2DDEE92 : Data.b $6A,$98,$2F,$0A,$00
    EndDataSection
    
  EndProcedure
  
  Procedure CreateInstance(x=0, y=0, initialvalue=0, display=#Landscape)
    Protected.i width, height, ix, iy, dx, dy, cx, cy, thisdelay
    Select display
      Case #Landscape : width=20 : height=16 : ix=10 : iy=0 : dx=0 : dy=0  : cx=10 : cy=16
      Case #portrait  : width=16 : height=20 : ix=0  : iy=0 : dx=0 : dy=10 : cx=16 : cy=10
    EndSelect
    *this.sCSPIN = AllocateMemory(SizeOf(sCSPIN))
    With *this
      \vtable  = ?CSPIN_Methods
      \value   = initialvalue
      \display = display
      SystemParametersInfo_(#SPI_GETKEYBOARDSPEED, 0, @thisdelay, 0)
      \keyboardDelay = 1000/thisdelay
      DrawButtons(*this)
      \container = ContainerGadget(#PB_Any, x, y, width, height)
      \incCanvas = CanvasGadget(#PB_Any, ix, iy, cx, cy)
      \decCanvas = CanvasGadget(#PB_Any, dx, dy, cx, cy)
      CloseGadgetList()
      SetGadgetAttribute(\incCanvas, #PB_Canvas_Image, ImageID(\imgIncNormal))
      SetGadgetAttribute(\decCanvas,  #PB_Canvas_Image, ImageID(\imgDecNormal))
      BindGadgetEvent(\incCanvas, @ProcessIncEvents())
      BindGadgetEvent(\decCanvas, @ProcessDecEvents())
      SetGadgetData(\incCanvas, *this)
      SetGadgetData(\decCanvas, *this)
    EndWith
    ProcedureReturn *this
  EndProcedure
  
  DataSection
    CSPIN_Methods: 
    Data.i @Increment(), @Decrement(), @Value(), @SetValue(), @Disable(), @Dispose()
  EndDataSection
  
EndModule

;=======================================================
;        Demo code: No need to remove for .pbi
;=======================================================

CompilerIf #PB_Compiler_IsMainFile
  
  Global spin1.CSPIN::iCSPIN
  Global spin2.CSPIN::iCSPIN
  
  Procedure Monitor(void)
    Repeat
      Delay(1)
      If oldvalue1 <> spin1\Value()
        SetGadgetText(0, Str(spin1\Value()))
        oldvalue1 = spin1\Value()
      EndIf
      If oldvalue2 <> spin2\Value()
        SetGadgetText(1, Str(spin2\Value()))
        oldvalue2 = spin2\Value()
      EndIf    
    ForEver
  EndProcedure
  
  Procedure buttonproc()
    Static status=1
    status = 1-status
    spin2\Disable(status)
  EndProcedure
  
  OpenWindow(0,0,0,620,70,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  spin1 = CSPIN::CreateInstance(70,10,0,CSPIN::#Portrait)
  spin2 = CSPIN::CreateInstance(66,40,0,CSPIN::#Landscape)
  spin2\Disable(1)
  TextGadget(#PB_Any, 30, 13,40,20, "spin1:")
  TextGadget(#PB_Any, 30,41,40,20, "spin2:")
  TextGadget(0, 92, 13,40,16,"0") : SetGadgetColor(0, #PB_Gadget_FrontColor, #Blue)
  TextGadget(1, 92,41,40,16,"0") : SetGadgetColor(1, #PB_Gadget_FrontColor, #Blue)
  TextGadget(2, 140,12,400,20,"The blue numbers are not part of the gadget, they're only there to show values.")
  ButtonGadget(3, 140,37,380,20, "Enable/disable spin2")
  BindGadgetEvent(3, @buttonproc())
  
  tid = CreateThread(@Monitor(),0)
  
  Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
  
  KillThread(tid)
  WaitThread(tid)
  spin1\Dispose()
  spin2\Dispose()
  
CompilerEndIf

;=========================================================================
;                     END CUSTOM SPINNER INCLUDE
;=========================================================================
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited