PureBasic Forums - English

Code: Select all

Global yNewPos,yCurrentScroll,yDelta,xNewPos,xCurrentScroll,xDelta,Min,Max

Procedure WndProc(hwnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents 

  Select uMsg
     
;     Case #WM_NOTIFY
;          UpdateWindow_(WindowID(0))
          
    Case #WM_HSCROLL          
      Select wParam & $FFFF
          Case #SB_LINELEFT
              If xCurrentScroll >= Min
                xNewPos = xCurrentScroll - 1
                xDelta = 1
              EndIf
              If xNewPos < Min
                 xNewPos = Min
              EndIf
      
          Case #SB_LINERIGHT
              If xCurrentScroll <= Max
                xNewPos = xCurrentScroll + 1
                xDelta = -1
              EndIf
              If xNewPos > Max
                 xNewPos = Max
              EndIf
              
              
;         Case #SB_THUMBPOSITION
;             xNewPos = wParam >> 16 & $FFFF

      
          Case #SB_THUMBTRACK
              xNewPos = wParam >> 16 & $FFFF
              If xNewPos > xCurrentScroll
                xDelta = -(xNewPos - xCurrentScroll)
              Else
                xDelta = xCurrentScroll - xNewPos
              EndIf              

      EndSelect
                    
    If xCurrentScroll <> xNewPos               
        xCurrentScroll = xNewPos 
      If xNewPos <= Max And xNewPos >= Min
          SetScrollPos_(WindowID(0),#SB_HORZ,xNewPos,1)
          ScrollWindowEx_(WindowID(0),xDelta,0,0,0,0,0,#SW_ERASE|#SW_INVALIDATE|#SW_SCROLLCHILDREN)
      EndIf
    EndIf                    
                    
 
    Case #WM_VSCROLL,#WM_MOUSEWHEEL 
      Select wParam & $FFFF
        Case #SB_LINEUP
            If yCurrentScroll >= Min
              If (wParam >> 16 & $FFFF) <> $FF88      ;For #WM_MOUSEWHEEL
                yNewPos = yCurrentScroll - 1
                yDelta = 1
              Else
                yNewPos = yCurrentScroll + 1
                yDelta = -1
              EndIf
            EndIf
            If yNewPos < Min
               yNewPos = Min
            EndIf
            If yNewPos > Max
               yNewPos = Max
            EndIf
    
        Case #SB_LINEDOWN
            If yCurrentScroll <= Max
            yNewPos = yCurrentScroll + 1
            yDelta = -1
            EndIf
            If yNewPos > Max
               yNewPos = Max
            EndIf
            
            
;       Case #SB_THUMBPOSITION
;           yNewPos = wParam >> 16 & $FFFF
        
        Case #SB_THUMBTRACK
            yNewPos = wParam >> 16 & $FFFF
            If yNewPos > yCurrentScroll
              yDelta = -(yNewPos - yCurrentScroll)
            Else
              yDelta = yCurrentScroll - yNewPos
            EndIf
                  
      EndSelect

      If yNewPos <> yCurrentScroll               
            yCurrentScroll = yNewPos
        If yNewPos <= Max And yNewPos >= Min
            SetScrollPos_(WindowID(0),#SB_VERT,yNewPos,1)
            ScrollWindowEx_(WindowID(0),0,yDelta,0,0,0,0,#SW_ERASE|#SW_INVALIDATE|#SW_SCROLLCHILDREN)
        EndIf
      EndIf

  EndSelect   
  ProcedureReturn result 
EndProcedure

Min = 0
Max = 1000

LoadImage(0, "girl2.bmp")
OpenWindow(0,0,0,800,600,"",#PB_Window_SystemMenu|#WS_HSCROLL|#WS_VSCROLL|#PB_Window_ScreenCentered)
SetWindowColor(0,$000000)
SetScrollRange_(WindowID(0),#SB_VERT,Min,Max,1)
SetScrollRange_(WindowID(0),#SB_HORZ,Min,Max,1)
ImageGadget(0,10,10,250,350, ImageID(0))
DisableGadget(0,1)


SetWindowCallback(@WndProc())

Repeat
  EventID = WaitWindowEvent()
Until EventID = #PB_Event_CloseWindow