ScrollBar and Tracbar API example

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 1:11 am

Code updated for 5.20+

Restored from previous forum. Originally posted by fred.

Just a little code to show you how use non supported gadget in PureBasic.

Code: Select all

#WindowWidth = 400
#WindowHeight = 345

If OpenWindow(0, 100, 120, 400, 345, "PureBasic - Gadget Demonstration", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
  
  
  *TrackBar = CreateWindowEx_(0, "msctls_trackbar32", "", #WS_CHILD | #WS_VISIBLE | #WS_GROUP | #TBS_AUTOTICKS, 20, 100, 150, 20, WindowID(0), 0, GetModuleHandle_(0), 0)
  SendMessage_(*TrackBar, #TBM_SETRANGEMIN, 0, 0)
  SendMessage_(*TrackBar, #TBM_SETRANGEMAX, 0, 100)
  
  si.SCROLLINFO\cbSize = SizeOf(SCROLLINFO)
  si\fMask = #SIF_ALL
  si\nMin = 0
  si\nMax = 2000
  si\nPage = 500
  si\nPos = 50
  si\nTrackPos = 0
  
  *ScrollBar = CreateWindowEx_(0, "SCROLLBAR", "", #WS_CHILD | #WS_VISIBLE | #SBS_HORZ, 20, 150, 150, 20, WindowID(0), 157, GetModuleHandle_(0), 0)
  SendMessage_(*ScrollBar , #SBM_SETSCROLLINFO, 1, si)
  
  TextGadget  (9, 10, #WindowHeight-50, 250, 24, "PureBasic - Gadget demonstration")
  ButtonGadget(8, #WindowWidth-100, #WindowHeight-56, 80, 24, "Quit")
  
  

  Declare Callback(WindowID, Message, wParam, lParam)
  SetWindowCallback(@Callback())
  
  
  Repeat
    EventID = WaitWindowEvent()
    
    If EventID = #PB_Event_Gadget
      
      Select EventGadget()
        Case 8 ; Quit...
          EventID = #PB_Event_CloseWindow
          
      EndSelect
      
    EndIf
    
  Until EventID = #PB_Event_CloseWindow
  
EndIf

Procedure Callback(WindowID, Message, wParam, lParam)
  Shared *TrackBar, *ScrollBar, si
  
  If Message = #WM_HSCROLL 
    If wParam & $FFFF = #TB_ENDTRACK
      SetGadgetText(9, "Dropped: "+Str(SendMessage_(*TrackBar, #TBM_GETPOS, 0, 0)))
    EndIf
    
    If wParam & $FFFF = #SB_THUMBTRACK
      SetScrollPos_(*ScrollBar, #SB_CTL, wParam >> 16, 1)
      SetGadgetText(9, "Dropped: "+Str(SendMessage_(*TrackBar, #TBM_GETPOS, 0, 0)))
    EndIf
  EndIf
  
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
End

Fred - AlphaSND

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 3:22 am

Restored from previous forum. Originally posted by PB.

Just a little code to show you how use non supported gadget in PureBasic.

Whenever I copy such code to the clipboard and paste it into PureBasic,
it all goes onto one single line with no returns. Anyone else suffer
this problem?

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 4:50 am

Restored from previous forum. Originally posted by wayne1.

Whenever I copy such code to the clipboard and paste it into PureBasic,
it all goes onto one single line with no returns. Anyone else suffer
this problem?

Paste to wordpad first then copy to PB editor

Edited by - wayne1 on 19 December 2001 04:58:05

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 5:56 am

Restored from previous forum. Originally posted by Paul.

Beginners are probably going to complain since
#WindowWidth=400
#WindowHeight=345
seem to be missing

By the way... nice tip Wayne1 !!
(I've been having that same problem lately)

Edited by - paul on 19 December 2001 05:57:08

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 11:00 am

Code updated for 5.20+

Restored from previous forum. Originally posted by Shagwana.

Thanks for the source there fred, I have had a little play around with the snippet and improved it a little bit . This might be of use to other people, so I have pasted my little version up here

Code: Select all

;Slightly adjusted version (better control of the track / scroll gadgets)

#WindowHeight=345
#WindowWidth=400

If OpenWindow(0, 100, 120, 400, 345, "PureBasic - Gadget Demonstration", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
      
  *TrackBar = CreateWindowEx_(0, "msctls_trackbar32", "", #WS_CHILD | #WS_VISIBLE | #WS_GROUP | #TBS_AUTOTICKS, 20, 100, 250, 20, WindowID(0), 0, GetModuleHandle_(0), 0)
  SendMessage_(*TrackBar, #TBM_SETRANGEMIN, 0, 0)
  SendMessage_(*TrackBar, #TBM_SETRANGEMAX, 0, 10)
  
  si.SCROLLINFO\cbSize = SizeOf(SCROLLINFO)
  si\fMask = #SIF_ALL
  si\nMin = 0
  si\nMax = 10
  si\nPage = 1
  si\nPos = 0
  si\nTrackPos = 0
  
  *ScrollBar = CreateWindowEx_(0,"SCROLLBAR", "", #WS_CHILD | #WS_VISIBLE | #SBS_HORZ , 20, 150, 150, 20, WindowID(0), 0, GetModuleHandle_(0), 0)
  SendMessage_(*ScrollBar , #SBM_SETSCROLLINFO, 1, si)
  
  TextGadget  (9, 10, #WindowHeight-50, 250, 24, "PureBasic - Gadget demonstration")
  ButtonGadget(8, #WindowWidth-100, #WindowHeight-56, 80, 24, "Quit")
    
  
  Declare Callback(WindowID, Message, wParam, lParam)
  ;Hook in the realtime code    
  SetWindowCallback(@Callback())
  
  ;Main loop
  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_Gadget
      Select EventGadget()
        Case 8 ; Quit...
          EventID = #PB_Event_CloseWindow
      EndSelect
    EndIf
  Until EventID = #PB_Event_CloseWindow
EndIf


Procedure Callback(WindowID, Message, wParam, lParam)
  Shared *TrackBar, *ScrollBar, si
  
  If WindowID=WindowID(0)
    
    Select lParam
        
      Case *TrackBar:
        Select Message
          Case #WM_HSCROLL:
            N=SendMessage_(*TrackBar, #TBM_GETPOS, 0, 0)
            SetScrollPos_(*ScrollBar, #SB_CTL, N, 1)   ;set it and redraw it!
            SetGadgetText(9, "Track "+Str(N))        
        EndSelect
        
        
      Case *ScrollBar:
        Select Message
          Case #WM_HSCROLL:
            
            Select (wParam & $ffff)
                
              Case #SB_LINELEFT:                                   ;When user clicks one of the arrows
                N=GetScrollPos_(*ScrollBar,#SB_CTL)-1
                themin=0
                themax=0
                GetScrollRange_(*ScrollBar,#SB_CTL,@themin,@themax)
                If Nthemax 
                  N=themax                                            ;Ensure that the value is in range
                EndIf         
                SetScrollPos_(*ScrollBar, #SB_CTL, N, 1)               ;1 on the end is the redraw flag :)
                
                ;Place the value in the track bar as well
                SendMessage_(*TrackBar, #TBM_SETPOS, 1, N)
                
              Case #SB_PAGELEFT:                                   ;Page left / right is user clicking the space to the left or right of scroll box
                N=GetScrollPos_(*ScrollBar,#SB_CTL)-2
                themin=0
                themax=0
                GetScrollRange_(*ScrollBar,#SB_CTL,@themin,@themax)
                If Nthemax 
                  N=themax                                            ;Ensure that the value is in range
                EndIf         
                SetScrollPos_(*ScrollBar, #SB_CTL, N, 1) 
                
                ;Place the value in the track bar as well
                SendMessage_(*TrackBar, #TBM_SETPOS, 1, N)
                
              Case #SB_THUMBPOSITION:           ;When the user has finished dragging the scroll bar bit
                N=wParam >> 16
                SetScrollPos_(*ScrollBar, #SB_CTL, N, 1)
                
                ;Place the value in the track bar as well
                SendMessage_(*TrackBar, #TBM_SETPOS, 1, N) 
                
              Case #SB_THUMBTRACK:             ;When the user is dragging the scroll box bit         
                N=wParam >> 16
                SetScrollPos_(*ScrollBar, #SB_CTL, N, 1)  
                
                ;Place the value in the track bar as well
                SendMessage_(*TrackBar, #TBM_SETPOS, 1, N)
                
              Case #SB_ENDSCROLL:              ;User has finished scrolling the gadget!
                ;Could put the redraw code here i guess
                N=GetScrollPos_(*ScrollBar,#SB_CTL)
                SetScrollPos_(*ScrollBar, #SB_CTL, N, 1)   ;just redraws the gadget
                
                ;Place the value in the track bar as well
                SendMessage_(*TrackBar, #TBM_SETPOS, 1, N)
                
              Case #SB_BOTTOM:                 ;'Home' and 'end' keys (not supported here :wink: 
              Case #SB_TOP:
                
            EndSelect
            
            SetGadgetText(9, "Scroll "+Str(N))  
        EndSelect
        
    EndSelect
  EndIf
  
    
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
End

In this version you will notice that scroll bar and track bar is linked .

http://www.sublimegames.com

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 3:57 pm

Restored from previous forum. Originally posted by Mark1Up.

One thing to watch out for when using WordPad for cut and paste (at least on Windows 2000), it thinks that the @ assignment (@themin & @themax) are email addresses so it changes it to @themax. Kind of a pain

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 5:31 pm

Restored from previous forum. Originally posted by Franco.

Nice work Fred and Shagwana. Thanks.

Well I don't use Wordpad to paste it.
I log in to the forum and press the button 'reply with quote' and than paste it...
After that press 'back' on the Explorer/Navigator toolbar.

Have a nice day...
Franco

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 5:40 pm

Restored from previous forum. Originally posted by Kanati.

That's nice fred and it's going to be rather useful to someone.

But scrollbars are rather integral to app programming and should
be supported directly by the language itself. I got faith in ya
though. You'll add em sooner or later.

Kanati

BackupUser · Post by **BackupUser** » Wed Dec 19, 2001 7:17 pm

Restored from previous forum. Originally posted by fred.

But scrollbars are rather integral to app programming and should
be supported directly by the language itself. I got faith in ya
though. You'll add em sooner or later.

Of course it will. It was more to show how integrate non supported gadgets into your code (PureBasic could never support ALL Win32 API gadgets..).

Fred - AlphaSND