PureBasic Forums - English

Code: Select all

; ********************************************************
; Blue - septembre 2009
; OS: Windows only
; on PB site: http://www.purebasic.fr/english/viewtopic.php?f=12&t=39347
; 
; TrackBars' sliders moved by the cursor cluster keys
; can follow two different models:
;  (1) standard Windows model: up/down and left/right movements are determined by
;                              Windows' built-in rules for proper text or window scrolling
;  (2) number scale model: up/right and left/down movements follow mathematical conventions
;
; cf. [MSDN]/shellcc/platform/commctls/scrollbars/aboutscrollbars.htm
;
; ********************************************************


EnableExplicit
;-{ macros }

Macro eol
   Chr(13) + Chr(10)
EndMacro

Macro MsgBox(message = "Just waiting...", titre = "information")
    MessageRequester(titre, message, 0)
EndMacro

;}

;-{ définitions } 
#maxVal  = 20
#bigStep = 4      ;; usually 1/5 of the maximum value

#keyReleased    = $80000000 ;; bit 31 of lParam set when key is released

Enumeration 
   #optStandard
   #optCustom
   #hTrack 
   #vTrack 
   #infoTrack
   #cmdCancel
   #cmdReset
   #infoText
EndEnumeration

Define.L pos, hPos, vPos

Global numberScaleMode = -1
Global activeTrack = #htrack
Global hTrack_ID, vTrack_ID

Global Dim trackName.S(#vTrack)
trackName(#hTrack) = " horizontal track "
trackName(#vTrack) = " vertical track "


CompilerIf #PB_Compiler_Debugger
   Define i, max
   Define.S k
   
   For i = 0 To 9999
      Read.s k
      If k = "" : Break : EndIf 
   Next
   
   max = i - 1
   Global Dim kbd.S(max)
   
   Restore keyNames
   For i = 0 To max
      Read.s kbd(i)
   Next
   
   DataSection
   keyNames:
      Data.s "Page Up","Page Down","End","Home","Left","Up","Right","Down"
      Data.s ""
   EndDataSection
CompilerEndIf  ;; #PB_Compiler_Debugger
;}

Procedure Keep_on_Tracking(track, cursorKey)
 ; (1) keeps track of each slider's position
 ; (2) synchronizes "by hand" the TrackBar's slider with the cursor cluster keys 
 ;     in accordance with the chosen mode:
 ;     number scale mode: up/right and left/down follow mathematical conventions
 ;     standard mode: up/down and left/right are left to Windows' built-in scrolling rules
 
   Shared hPos, vPos
   Define pos

   If cursorKey >= #VK_PRIOR And cursorKey <= #VK_DOWN
      Debug kbd(cursorKey - #VK_PRIOR)

      If numberScaleMode
         If track = #htrack
            pos = hPos
         Else
            pos = vPos
         EndIf

         Select cursorKey
            Case #VK_LEFT, #VK_DOWN : pos - 1
            Case #VK_RIGHT, #VK_UP  : pos + 1
            Case #VK_PRIOR          : pos + #bigStep  
            Case #VK_NEXT           : pos - #bigStep 
            Case #VK_HOME           : pos = 1
            Case #VK_END            : pos = #maxVal
         EndSelect

         If pos < 1
           pos = 1
         ElseIf pos > #maxVal
           pos = #maxVal
         EndIf

         SetGadgetState(track, pos)
      EndIf

    Else   ; slider moved with the mouse
       Debug " W: " + Hex(cursorKey)
   EndIf

   pos = GetGadgetState(Track) ; redundant only when Number Scale Mode is active
   If track = #htrack
      hPos = pos       ; keep tracking variable updated
   Else
      vPos = pos       ; tracking variable MUST remain up-to-date
   EndIf
   
   ProcedureReturn pos 
EndProcedure
Procedure Reset()
   SetGadgetState(#htrack,1)
   If numberScaleMode
      SetGadgetState(#vtrack,1)
   Else
      SetGadgetState(#vtrack,#maxVal)
   EndIf
   SetActiveGadget(activeTrack)
   SetGadgetText(#infoTrack, " Reset " + trackName(activeTrack)+" : Home Key behaviour")  
EndProcedure 

Procedure Dialogue(winW, winH)
  If 0 = OpenWindow(0, 0,0, winW, winH, "Tracking trackBars...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ProcedureReturn 0
  EndIf  

  RemoveKeyboardShortcut(0, #PB_Shortcut_All )
  StickyWindow(0, 1) 

  #tailleTexte = 20
  #marge = 10
  
  Define gadget, gX,gY, gW,gH
  
  gadget = #cmdCancel
    gH = 30
    gW = 66
    gY = winH-gH - #marge
    gX = winW-gW - #marge
    ButtonGadget(gadget,gX,gY,gW,gH,"Terminer",#PB_Button_Default)
  
  gadget = #cmdReset
    gH = #tailleTexte
    gY + 3
    gX - gW + 4
    ButtonGadget(gadget,gX,gY+2,gW-12,gH,"Reset")
  
  gadget = #infoTrack
    gH = #tailleTexte
    gW = winW - 2*#marge
    gY = #marge
    gX = (winW-gW) / 2
    TextGadget(gadget,gX,gY,gW,gH,"The vertical TrackBar is the active one", #PB_Text_Center | #PB_Text_Border)
  
  #dY = 6
  gadget = #hTrack
    gY + gH + #dY
    gH = #tailleTexte + 10
    hTrack_ID = TrackBarGadget(gadget,gX,gY,gW,gH,1,#maxVal, #PB_TrackBar_Ticks)
    SetActiveGadget(gadget)
  
  gadget = #vTrack
    gY + gH + #dY
    gW = 30
    gH = winH - gY - #marge
    vTrack_ID = TrackBarGadget(gadget,gX,gY,gW,gH,1,#maxVal, #PB_TrackBar_Vertical|#PB_TrackBar_Ticks)
    SetActiveGadget(gadget)

  gadget = #optCustom
    gX + gW + 40 
    gW = 150 
    gH = #tailleTexte 
    OptionGadget(gadget,gX,gY,gW,gH,"Number Scale behaviour")
    SetGadgetState(gadget,1)
  
  gadget = #optStandard
    gY + gH
    OptionGadget(gadget,gX,gY,gW,gH,"Standard behaviour")


  Define.S msg = "Cursor keys move the sliders differently"
  msg + eol +    "in the standard and the customized mode."
  msg + eol +    " > switch mode: press S or C"
  msg + eol +    " > Exit : press ESC or T "
  msg + eol +    " > Reset: press R "

  gadget = #infoText
    gY + gH + 4
    gX - 32
    gH = GadgetY(#cmdCancel) - gY - 2
    gW = (winW-gX-#marge)
    TextGadget(gadget,gX,gY,gW,gH,msg) ;, #PB_Text_Border)
    SetGadgetColor(gadget, #PB_Gadget_FrontColor, #Red)
    SetGadgetFont(gadget, LoadFont(0, "Arial" , 10))
      
  ProcedureReturn -1

EndProcedure


;- ************  Main attraction  ************

If Not Dialogue(320,240)
  End
EndIf

Define.i gadget, event, evType, evWindow
Define.i wParam, lParam

Repeat 
   event  = WaitWindowEvent()
   wParam = EventwParam()
   lParam = EventlParam() 
   gadget = EventGadget()
   evType = EventType()
  
   Select event

      Case #PB_Event_CloseWindow: Break
 
      Case #PB_Event_Gadget:  ;; 13100

         Select gadget
;-> > trackBar
            Case  #hTrack, #vTrack

               If (lParam & #keyReleased)  ;; bit 31 set when kbd key is released
                  Debug "   Released"
                  Continue                 ;; court-circuite le reste
               EndIf

               HideGadget(#infoText,1)

               activeTrack = gadget
               pos = Keep_on_Tracking(gadget,wParam)

               SetGadgetText(#infoTrack, trackName(gadget)+":  "+Str(pos) )
;<
;- > > autres gadgets
            Case #cmdCancel   : Break

            Case #cmdReset    : Reset()

            Case #optStandard,#optCustom
               numberScaleMode = ~numberScaleMode
               SetActiveGadget(activeTrack)

            Default : MsgBox("Gadget "+Str(gadget) + " oublié ? ")
         EndSelect

      Case #WM_KEYDOWN
         Select wParam

           Case #VK_TAB                           ;-> > tab
             gadget = GetActiveGadget()
             If gadget = #htrack 
                SetActiveGadget(#vTrack)
             ElseIf gadget = #vtrack 
                SetActiveGadget(#hTrack)
             EndIf
             Debug "Tab: " + trackName(gadget)  + "  >>> " +  trackName(GetActiveGadget())

;<

           Case #VK_C, #VK_S                      ;- > > lettres C et S
             numberScaleMode = ~numberScaleMode
             SetGadgetState(-numberScaleMode,1)

           Case #VK_R : Reset()                   ;- > > lettre R
           
           Case #VK_F1 : HideGadget(#infoText,0)  ;- > > touche F1

           Case #VK_ESCAPE, #VK_T : Break        ;- > > Esc, lettre T
             
         EndSelect 
;<
 
      EndSelect
ForEver 

End