Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Scrollable ViewPort

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Scrollable ViewPort

    Some people have asked me for just a stand alone code to demo the Scrollable ViewPort
    that was in the previous post for Borje Hagsten Open Picture Dialog. So here it is...

    Regards, Jules

    Code:
    '-----------------------------------------------------------------------------
    ' Scrollable ViewPort Example
    '
    ' By Jules Marchildon,    [url="mailto:[email protected]"]mailto:[email protected][/url][email protected]</A>  
    ' October 27, 2000
    '
    '-----------------------------------------------------------------------------
     
    $COMPILE EXE
    $INCLUDE "WIN32API.INC"
     
    '---
    GLOBAL ghInst       AS LONG
    GLOBAL ghMain       AS LONG
    GLOBAL ghViewPort   AS LONG 'window we want to scroll
    GLOBAL ghViewScroll AS LONG 'window used to scroll ghViewPort
    GLOBAL gEndptX      AS LONG
    GLOBAL gEndptY      AS LONG
     
    '-----------------------------------------------------------------------------
    '
    '
    '
    '------------------------------------------------------------------------------
    FUNCTION WINMAIN(BYVAL hInstance AS LONG, _
                     BYVAL hPrevInstance AS LONG, _
                     lpszCmdLine AS ASCIIZ PTR, _
                     BYVAL nCmdShow AS LONG) AS LONG
     
     
      LOCAL hwnd AS LONG
      LOCAL Msg AS tagMSG
      LOCAL wcl AS WNDCLASSEX
      LOCAL szWinName    AS ASCIIZ*20
     
    'Register the Main application window
    IF ISFALSE(hPrevInstance) THEN
      szWinName ="MyWin"
      wcl.cbSize = sizeof(wcl)
      wcl.hInstance = hInstance
      wcl.lpszClassName = varptr(szWinName)
      wcl.lpfnWndProc = codeptr(MainWindowProc)
      wcl.style = 0
      wcl.hIcon = LoadIcon(hInstance, BYVAL %IDI_APPLICATION)
      wcl.hIconSm = %NULL
      wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
      wcl.hbrBackground = GetStockObject(%WHITE_BRUSH)
      wcl.cbClsExtra = 0
      wcl.cbWndExtra = 0
      wcl.lpszMenuName = %NULL
    RegisterClassEx wcl
    ELSE
        EXIT FUNCTION
    END IF
    '---
     
     
    ghInst = hInstance
     
    '---
      'Create the Main window
      hwnd = CreateWindowEx(0,szWinName, _
                            "Scrollable ViewPort", _
                            %WS_OVERLAPPEDWINDOW, _
                            %CW_USEDEFAULT, %CW_USEDEFAULT, _
                            %CW_USEDEFAULT, %CW_USEDEFAULT, _
                            %NULL, %NULL, ghInst, BYVAL %NULL)
     
     
      ShowWindow hWnd, %SW_SHOW
      UpdateWindow hWnd
     
      ghMain = hWnd
       
      Call SetFocus(ghViewScroll)
     
        WHILE GetMessage(Msg, %NULL, 0, 0)
            TranslateMessage Msg
            DispatchMessage Msg
        WEND
     
      FUNCTION = Msg.wParam
    END FUNCTION
     
     
    '------------------------------------------------------------------------
    ' Main window callback procedure.
    '
    ' Creates the scrolling veiw port window holder
    '
    '------------------------------------------------------------------------
    FUNCTION MainWindowProc(BYVAL hWnd AS LONG, _
                            BYVAL Msg AS LONG,BYVAL wParam AS LONG, _
                            BYVAL lParam AS LONG) AS LONG
     
     
    '---
    SELECT CASE Msg
     
        CASE %WM_CREATE
     
     
            dim szWinName as asciiz*25
            dim wcl AS WNDCLASSEX
            szWinName ="VIEWSCROLL"
            wcl.cbSize = sizeof(wcl)
            wcl.hInstance = ghInst
            wcl.lpszClassName = varptr(szWinName)
            wcl.lpfnWndProc = codeptr(ViewScrollProc)
            wcl.style = 0
            wcl.hIcon = LoadIcon(ghInst, BYVAL %IDI_APPLICATION)
            wcl.hIconSm = %NULL
            wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
            wcl.hbrBackground = GetStockObject(%WHITE_BRUSH)
            wcl.cbClsExtra = 0
            wcl.cbWndExtra = 0
            wcl.lpszMenuName = %NULL
            RegisterClassEx wcl
     
            ghViewScroll& = CreateWindowEx(0,"VIEWSCROLL", _
                            "", _
                            %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER, _
                            100,100, _
                            600, 200, _
                            hWnd, %NULL, ghInst, BYVAL %NULL)
     
     
            Function = 0
            Exit Function
     
        CASE %WM_SETFOCUS
              Call SetFocus(ghViewScroll)
              Function = 0
              Exit Function
               
        CASE %WM_DESTROY
     
          PostQuitMessage 0
     
        CASE ELSE
             FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam)
             EXIT FUNCTION
     
    END SELECT
        FUNCTION = 0
     
    END FUNCTION
     
    
     
    '------------------------------------------------------------------------
    ' View Port Holder callback procedure:
    '
    ' This is the window holder for our scrolling window. This is also our
    ' scrollbar handler. Note: this window needs the keyboard focus if you
    ' want to use the keyboard to scroll.
    '
    ' The WM_SIZE handler will adjust the scrollbar range if the ViewPort
    ' holder(ViewScroll) has a Sizing Border.
    '------------------------------------------------------------------------
    FUNCTION ViewScrollProc(BYVAL hWnd AS LONG, _
                            BYVAL Msg AS LONG,BYVAL wParam AS LONG, _
                            BYVAL lParam AS LONG) AS LONG
     
      LOCAL  hdc    AS LONG
      LOCAL  ps     AS PAINTSTRUCT
      LOCAL  tm     AS TEXTMETRIC
      LOCAL  str    AS ASCIIZ*255
      LOCAL  str2   AS ASCIIZ*255
      LOCAL  i      AS INTEGER
      LOCAL  inc    AS INTEGER
      LOCAL  X      AS INTEGER      'current output location
      LOCAL  Y      AS INTEGER
      LOCAL  hbrush AS LONG         'handle to virtual window brush
      STATIC maxX   AS INTEGER      'screen dimensions
      STATIC maxY   AS INTEGER
      STATIC orgX   AS INTEGER      'origin for current display
      STATIC orgY   AS INTEGER
      STATIC si     AS SCROLLINFO
      STATIC memdc  AS LONG         'handle to virtual window context
      STATIC hbit   AS LONG         'handle to virtual window bitmap
      STATIC curdim AS RECT         'current size of physical window
     
    '---
    SELECT CASE Msg
     
        CASE %WM_CREATE
     
          'get screen coordinates
          maxX = GetSystemMetrics(%SM_CXSCREEN)
          maxY = GetSystemMetrics(%SM_CYSCREEN)
     
          'create a window that is larger
          'maxX = maxX *2
          'maxY = maxY *2
     
          'save our end points for use later
          gEndptX = maxX
          gEndptY = maxY
           
          'initialize scroll bar ranges
          GetClientRect hwnd, curdim
     
          si.cbSize = sizeof(si)
          si.fMask = %SIF_RANGE
          si.nMin = 0
          si.nMax = maxX -curdim.nRight
          SetScrollInfo hwnd, %SB_HORZ, si, 1
          si.nMax = maxY -curdim.nBottom
          SetScrollInfo hwnd, %SB_VERT, si, 1
     
            dim szWinName as asciiz*25
            dim wcl AS WNDCLASSEX
            szWinName ="VIEWPORT"
            wcl.cbSize = sizeof(wcl)
            wcl.hInstance = ghInst
            wcl.lpszClassName = varptr(szWinName)
            wcl.lpfnWndProc = codeptr(ViewPortProc)
            wcl.style = 0
            wcl.hIcon = LoadIcon(ghInst, BYVAL %IDI_APPLICATION)
            wcl.hIconSm = %NULL
            wcl.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
            wcl.hbrBackground = GetStockObject(%WHITE_BRUSH)
            wcl.cbClsExtra = 0
            wcl.cbWndExtra = 0
            wcl.lpszMenuName = %NULL
            RegisterClassEx wcl
     
            ghViewPort& = CreateWindowEx(0,"VIEWPORT", _
                            "", _
                            %WS_CHILD OR %WS_VISIBLE , _
                            0,0, _
                            maxX, maxY, _
                            hWnd, %NULL, ghInst, BYVAL %NULL)
     
       
    '------------------------IMPORTANT NOTE--------------------------------
    '
    '                     Needs keyboard focus !
    '----------------------------------------------------------------------
    CASE %WM_KEYDOWN
     
        SELECT CASE LOWRD(wParam)
     
            CASE %VK_HOME
                  SendMessage hWnd,%WM_VSCROLL,%SB_TOP,0
                  SendMessage hWnd,%WM_HSCROLL,%SB_TOP,0
            CASE %VK_END
                  SendMessage hWnd,%WM_VSCROLL,%SB_BOTTOM,0
                  SendMessage hWnd,%WM_HSCROLL,%SB_BOTTOM,0
     
            CASE %VK_RIGHT
                IF GetKeyState(%VK_CONTROL) < 0 THEN  'if Ctrl+Right
                    SendMessage hWnd,%WM_HSCROLL,%SB_PAGERIGHT,0
                ELSE
                    SendMessage hWnd,%WM_HSCROLL,%SB_LINERIGHT,0
                END IF
     
            CASE %VK_LEFT
                IF GetKeyState(%VK_CONTROL) < 0 THEN  'if Ctrl+Left
                    SendMessage hWnd,%WM_HSCROLL,%SB_PAGELEFT,0
                ELSE
                   SendMessage hWnd,%WM_HSCROLL,%SB_LINELEFT,0
                END IF
     
            CASE %VK_DOWN
                SendMessage hWnd,%WM_VSCROLL,%SB_LINEDOWN,0
     
            CASE %VK_UP
                SendMessage hWnd,%WM_VSCROLL,%SB_LINEUP,0
     
            CASE %VK_PGDN
                SendMessage hWnd,%WM_VSCROLL,%SB_PAGEDOWN,0
     
            CASE %VK_PGUP
                SendMessage hWnd,%WM_VSCROLL,%SB_PAGEUP,0
     
        END SELECT
    
    
     
     
    '-------------------------------------------------------------------------------
    '                        Scroll Bar handler
    '
    '-------------------------------------------------------------------------------
        CASE %WM_HSCROLL
     
          SELECT CASE LOWRD(wParam)
     
            CASE %SB_THUMBTRACK
              orgX = HIWRD(wParam)
     
            CASE %SB_LINERIGHT
              IF orgX < maxX-curdim.nRight THEN  orgX= orgX+10
     
            CASE %SB_LINELEFT
              IF orgX > 0 THEN  orgX= orgX -10
     
            CASE %SB_PAGERIGHT
              IF orgX+50 < maxX-curdim.nRight THEN orgX=orgX +50 Else orgX = maxX -curdim.nRight
     
            CASE %SB_PAGELEFT
              IF orgX-50 > 0 THEN orgX=orgX -50 Else orgX=0
     
            CASE %SB_TOP
              orgX = 0
     
            CASE %SB_BOTTOM
              orgX = maxX -curdim.nRight
     
          END SELECT
     
          si.fMask = %SIF_POS
          si.nPos = orgX
          SetScrollInfo hwnd, %SB_HORZ, si, 1
     
     
          Call MoveWindow(ghViewPort,-orgX,-orgY,maxX,maxY,%TRUE)
          Function = 0
          Exit Function
     
     
        CASE %WM_VSCROLL
     
          SELECT CASE LOWRD(wParam)
     
            CASE %SB_THUMBTRACK
              orgY = HIWRD(wParam)
     
            CASE %SB_LINEDOWN
              IF orgY < maxY-curdim.nBottom THEN orgY = orgY +10
     
            CASE %SB_LINEUP
              IF orgY > 0 THEN orgY = orgY -10
     
            CASE %SB_PAGEDOWN
              IF orgY+50 < maxY-curdim.nBottom THEN orgY = orgY +50 Else orgY = maxY -curdim.nBottom
     
            CASE %SB_PAGEUP
              IF orgY-50 > 0 THEN orgY = orgY -50  Else orgY = 0
     
            CASE %SB_TOP
              orgY = 0
     
            CASE %SB_BOTTOM
              orgY = maxY -curdim.nBottom
     
          END SELECT
     
          si.fMask = %SIF_POS
          si.nPos = orgY
          SetScrollInfo hwnd, %SB_VERT, si, 1
     
          Call MoveWindow(ghViewPort,-orgX,-orgY,maxX,maxY,%TRUE)
          Function = 0
          Exit Function
                 
    '---
        CASE %WM_SIZE
          'update virtual window origins if window size increasing
          inc = HIWRD(lParam)-curdim.nBottom
          IF(inc > 0) AND (orgY >= (maxY-curdim.nBottom)) THEN orgY= orgY -inc
          IF orgY < 0 THEN orgY = 0
          inc = LOWRD(lParam)-curdim.nRight
          IF (inc > 0) AND (orgX >= (maxX-curdim.nRight)) THEN orgX = orgX -inc
          IF orgX < 0 THEN  orgX = 0
           
          'store new window extents
          curdim.nRight  = LOWRD(lParam)
          curdim.nBottom = HIWRD(lParam)
           
          'reinitialize scroll bar ranges
          si.cbSize = sizeof(si)
          si.fMask = %SIF_RANGE OR %SIF_POS
          si.nMin = 0
          si.nMax = maxX-curdim.nRight
          si.nPos = orgX
          SetScrollInfo hwnd, %SB_HORZ, si, 1
          si.nMax = maxY-curdim.nBottom
          si.nPos = orgY
          SetScrollInfo hwnd, %SB_VERT, si, 1
      
        CASE %WM_DESTROY
     
        CASE ELSE
             FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam)
             EXIT FUNCTION
     
    END SELECT
        FUNCTION = 0
     
    END FUNCTION
     
     
     
    '-----------------------------------------------------------------------
    '  This is the window we are scolling and the one we paint things on.
    '
    '
    '-----------------------------------------------------------------------
    FUNCTION ViewPortProc(BYVAL hWnd AS LONG, _
                          BYVAL Msg AS LONG,BYVAL wParam AS LONG, _
                          BYVAL lParam AS LONG) AS LONG
     
      LOCAL  hDC    AS LONG
      LOCAL  ps     AS PAINTSTRUCT
      LOCAL  hbrush AS LONG
     
    '---
    SELECT CASE Msg
     
        CASE %WM_CREATE
     
            'test with a couple of button controls...
            hWndNew& =CreateWindowEx(0,"BUTTON", "&Button", _
                                     %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS _
                                     OR %BS_PUSHBUTTON, _
                                     100, _
                                     100, _
                                     100, _
                                     30, _
                                     hWnd, BYVAL %NULL, ghInst, ByVal %NULL)
     
            hWndNew& =CreateWindowEx(0,"BUTTON", "&Button", _
                                     %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS _
                                     OR %BS_PUSHBUTTON, _
                                     gEndptX\2, _
                                     gEndptY\2, _
                                     100, _
                                     30, _
                                     hWnd, BYVAL %NULL, ghInst, ByVal %NULL)
    
                
            
        CASE %WM_PAINT
     
          'test with a couple of objects...
          hdc = BeginPaint(hwnd, ps)
          hIcon&  = LoadIcon(%NULL,BYVAL %IDI_EXCLAMATION)
          Call DrawIcon(hDC,0,0,hIcon&)
          Call DrawIcon(hDC,gEndptX-32,gEndptY-32,hIcon&)
          hIcon&  = LoadIcon(%NULL,BYVAL %IDI_HAND)
          Call DrawIcon(hDC,0,gEndptY-32,hIcon&)
          Call DrawIcon(hDC,gEndptX-32,0,hIcon&)
          EndPaint hwnd, ps
    
     
     '---
     
        CASE %WM_SIZE
     
        CASE %WM_SETFOCUS
              Call SetFocus(ghViewScroll)
              Function = 0
              Exit Function
        
        CASE %WM_DESTROY
     
     
        CASE ELSE
             FUNCTION= DefWindowProc(hwnd, Msg, wParam, lParam)
             EXIT FUNCTION
     
    END SELECT
        FUNCTION = 0
     
    END FUNCTION

    [This message has been edited by Jules Marchildon (edited October 27, 2000).]
    Best regards
    Jules
    www.rpmarchildon.com

  • #2
    nice example, how ever,I've made the following changes to the scroll bar sections..

    CASE %WM_HSCROLL
    CASE %SB_PAGERIGHT
    IF orgX+1 < maxX-curdim.nRight THEN orgX=orgX +50
    CASE %SB_PAGELEFT
    IF orgX-49 > 0 THEN orgX=orgX -50
    CASE %WM_VSCROLL
    CASE %SB_PAGEDOWN
    IF orgY+1 < maxY-curdim.nBottom THEN orgY = orgY +50
    CASE %SB_PAGEUP
    IF orgY-49 > 0 THEN orgY = orgY -50

    This is because if you use the mouse to click on the scroll bars they never seemed to get to the end (or start) positions.

    Adrian Aitken

    ------------------

    Comment


    • #3
      Adrian, thanks for the input.

      I fixed the scroll bar handler, the Ctrl+Right(or Left) now pages to the extreme ends.
      I added the Home and End key suport as well. Also, there was an interesting problem
      with testing the VK_CONTROL keystate, If GetKeyState(%VK_CONTROL) < 0 Then...
      fixes it, otherwise you can still page left/right without depressing
      the Ctrl key.

      Regards, Jules




      ------------------
      Best regards
      Jules
      www.rpmarchildon.com

      Comment


      • #4
        Jules -
        Cool sample. I rebuilt it for DDT (w/o keyboard processing; mouse only).

        Code:
           #Compile Exe
           #Dim All
           #Register None
           #Include "WIN32API.INC"
        
           CallBack Function DlgProc2
              Select Case CbMsg
                 Case %WM_INITDIALOG
                    Local i As Long, j As Long
                    For i = 0 To 5: For j = 0 To 20
                       Control Add Button, CbHndl, -1, "Row =" + Str$(j) + "    Col =" + Str$(i), 5 + 120 * i, 5 + 30 * j, 100, 15
                    Next: Next
                 Case %WM_ERASEBKGND
                    PaintDesktop CbWparam: Function = 1: Exit Function
              End Select
           End Function
        
           CallBack Function DlgProc1
              Select Case CbMsg
                 Case %WM_INITDIALOG
                    Static hDlg2 As Long, siSz As POINTAPI, siPg As POINTAPI, siLn As POINTAPI
        
                    Dialog New CbHndl, "", 0, 0, 710, 630, %WS_CHILD To hDlg2
                    Dialog Show Modeless hDlg2 Call DlgProc2
        
                    Dim rc1 As RECT, rc2 As RECT
                    GetClientRect CbHndl, rc1
                    siPg.X = rc1.nRight - rc1.nLeft
                    siPg.Y = rc1.nBottom - rc1.nTop
        
                    GetWindowRect hDlg2, rc2
                    siSz.X = rc2.nRight - rc2.nLeft
                    siSz.Y = rc2.nBottom - rc2.nTop
        
                    siLn.X = 0.1 * siPg.X ' 10% of page
                    siLn.Y = 0.1 * siPg.Y ' 10% of page
        
                    Static siX As SCROLLINFO, siY As SCROLLINFO
                    siX.cbsize = SizeOf(siX)
                    siX.nMin = 0
                    siX.nPage = siPg.X
                    siX.fMask =  %SIF_RANGE Or %SIF_PAGE
                    siX.nMax = siSz.X
                    SetScrollInfo CbHndl, %SB_HORZ, siX, %False
        
                    siY = siX
                    siY.nPage = siPg.Y
                    siY.nMax = siSz.Y
                    SetScrollInfo CbHndl, %SB_VERT, siY, %False
        
                 Case %WM_HSCROLL
                    Local siRefresh As Long
                    Select Case LoWrd(CbWparam)
                       Case %SB_LINELEFT   : siX.nPos = siX.nPos - siLn.X: siRefresh = 1
                       Case %SB_LINERIGHT  : siX.nPos = siX.nPos + siLn.X: siRefresh = 1
                       Case %SB_PAGELEFT   : siX.nPos = siX.nPos - siPg.X: siRefresh = 1
                       Case %SB_PAGERIGHT  : siX.nPos = siX.nPos + siPg.X: siRefresh = 1
                       Case %SB_THUMBTRACK : siX.nPos = HiWrd(CbWparam)
                       Case Else           :  Exit Function
                    End Select
                    siX.nPos = Max(siX.nPos, 0): siX.nPos = Min(siX.nPos, siSz.X - siPg.X)
                    siX.fMask = %SIF_POS
                    SetScrollInfo CbHndl, %SB_HORZ, siX, siRefresh
                    SetWindowPos hDlg2, 0, -siX.nPos, -siY.nPos, 0, 0, %SWP_NOSIZE Or %SWP_NOZORDER Or %SWP_NOACTIVATE
                    SetWindowText GetParent(CbHndl), "PosX =" + Str$(siX.nPos) + " PosY =" + Str$(siY.nPos) + " (pixels)"
        
                 Case %WM_VSCROLL
                    Select Case LoWrd(CbWparam)
                       Case %SB_LINEUP     : siY.nPos = siY.nPos - siLn.Y: siRefresh = 1
                       Case %SB_LINEDOWN   : siY.nPos = siY.nPos + siLn.Y: siRefresh = 1
                       Case %SB_PAGEUP     : siY.nPos = siY.nPos - siPg.Y: siRefresh = 1
                       Case %SB_PAGEDOWN   : siY.nPos = siY.nPos + siPg.Y: siRefresh = 1
                       Case %SB_THUMBTRACK : siY.nPos = HiWrd(CbWparam)
                       Case Else           : Exit Function
                    End Select
                    siY.nPos = Max(siY.nPos, 0): siY.nPos = Min(siY.nPos, siSz.Y - siPg.Y)
                    siY.fMask = %SIF_POS
                    SetScrollInfo CbHndl, %SB_VERT, siY, siRefresh
                    SetWindowPos hDlg2, 0, -siX.nPos, -siY.nPos, 0, 0, %SWP_NOSIZE Or %SWP_NOZORDER Or %SWP_NOACTIVATE
                    SetWindowText GetParent(CbHndl), "PosX =" + Str$(siX.nPos) + " PosY =" + Str$(siY.nPos) + " (pixels)"
              End Select
           End Function
        
           CallBack Function DlgProc
              Select Case CbMsg
                 Case %WM_INITDIALOG
                    Local hDlg1 As Long
                    Dialog New CbHndl, "", 10, 10, 180, 180, %WS_CHILD Or %WS_VISIBLE Or %WS_CLIPCHILDREN Or %WS_CLIPSIBLINGS Or %WS_HSCROLL Or %WS_VSCROLL, %WS_EX_CLIENTEDGE Or %WS_VSCROLL To hDlg1
                    Dialog Show Modeless hDlg1  Call DlgProc1
              End Select
           End Function
        
           Function PbMain
              Local hDlg As Long
              Dialog New 0,"Scroll Bar",,, 200, 200, %WS_CAPTION Or %WS_SYSMENU Or %WS_CLIPCHILDREN Or %WS_CLIPSIBLINGS To hdlg
              Dialog Show Modal hdlg Call DlgProc
           End Function
        [This message has been edited by Semen Matusovski (edited October 28, 2000).]

        Comment


        • #5
          Semen's code with mouse wheel vertical scrolling added:
          Code:
          #COMPILE EXE
             #DIM ALL
             #REGISTER NONE
             #INCLUDE "WIN32API.INC"
          
             CALLBACK FUNCTION DlgProc2
                SELECT CASE CBMSG
                   CASE %WM_INITDIALOG
                      LOCAL i AS LONG, j AS LONG
                      FOR i = 0 TO 5: FOR j = 0 TO 20
                         CONTROL ADD BUTTON, CBHNDL, -1, "Row =" + STR$(j) + "    Col =" + STR$(i), 5 + 120 * i, 5 + 30 * j, 100, 15
                      NEXT: NEXT
                   CASE %WM_ERASEBKGND
                      PaintDesktop CBWPARAM: FUNCTION = 1: EXIT FUNCTION 
                END SELECT 	
             END FUNCTION
          
             CALLBACK FUNCTION DlgProc1
                SELECT CASE CBMSG
                   CASE %WM_INITDIALOG
                      STATIC hDlg2 AS LONG, siSz AS POINTAPI, siPg AS POINTAPI, siLn AS POINTAPI
                      DIALOG NEW CBHNDL, "", 0, 0, 710, 630, %WS_CHILD TO hDlg2
                      DIALOG SHOW MODELESS hDlg2 CALL DlgProc2
                      DIM rc1 AS RECT, rc2 AS RECT
                      GetClientRect CBHNDL, rc1
                      siPg.X = rc1.nRight - rc1.nLeft
                      siPg.Y = rc1.nBottom - rc1.nTop
                      GetWindowRect hDlg2, rc2
                      siSz.X = rc2.nRight - rc2.nLeft
                      siSz.Y = rc2.nBottom - rc2.nTop
                      siLn.X = 0.1 * siPg.X ' 10% of page
                      siLn.Y = 0.1 * siPg.Y ' 10% of page
                      STATIC siX AS SCROLLINFO, siY AS SCROLLINFO
                      siX.cbsize = SIZEOF(siX)
                      siX.nMin = 0
                      siX.nPage = siPg.X
                      siX.fMask =  %SIF_RANGE OR %SIF_PAGE
                      siX.nMax = siSz.X
                      SetScrollInfo CBHNDL, %SB_HORZ, siX, %False
                      siY = siX
                      siY.nPage = siPg.Y
                      siY.nMax = siSz.Y
                      SetScrollInfo CBHNDL, %SB_VERT, siY, %False
                   CASE %WM_HSCROLL
                      LOCAL siRefresh AS LONG
                      SELECT CASE LOWRD(CBWPARAM)
                         CASE %SB_LINELEFT   : siX.nPos = siX.nPos - siLn.X: siRefresh = 1
                         CASE %SB_LINERIGHT  : siX.nPos = siX.nPos + siLn.X: siRefresh = 1
                         CASE %SB_PAGELEFT   : siX.nPos = siX.nPos - siPg.X: siRefresh = 1
                         CASE %SB_PAGERIGHT  : siX.nPos = siX.nPos + siPg.X: siRefresh = 1
                         CASE %SB_THUMBTRACK : siX.nPos = HIWRD(CBWPARAM)
                         CASE ELSE           :  EXIT FUNCTION
                      END SELECT
                      siX.nPos = MAX(siX.nPos, 0): siX.nPos = MIN(siX.nPos, siSz.X - siPg.X)
                      siX.fMask = %SIF_POS
                      SetScrollInfo CBHNDL, %SB_HORZ, siX, siRefresh
                      SetWindowPos hDlg2, 0, -siX.nPos, -siY.nPos, 0, 0, %SWP_NOSIZE OR %SWP_NOZORDER OR %SWP_NOACTIVATE
                      SetWindowText GetParent(CBHNDL), "PosX =" + STR$(siX.nPos) + " PosY =" + STR$(siY.nPos) + " (pixels)"
                   CASE %WM_VSCROLL,%WM_MOUSEWHEEL
                      IF CBMSG=%WM_VSCROLL THEN
                        SELECT CASE LOWRD(CBWPARAM)
                           CASE %SB_LINEUP     : siY.nPos = siY.nPos - siLn.Y: siRefresh = 1
                           CASE %SB_LINEDOWN   : siY.nPos = siY.nPos + siLn.Y: siRefresh = 1
                           CASE %SB_PAGEUP     : siY.nPos = siY.nPos - siPg.Y: siRefresh = 1
                           CASE %SB_PAGEDOWN   : siY.nPos = siY.nPos + siPg.Y: siRefresh = 1
                           CASE %SB_THUMBTRACK : siY.nPos = HIWRD(CBWPARAM) 
                           CASE ELSE           : EXIT FUNCTION
                        END SELECT 
                      ELSE 'mouse wheel
                        siY.nPos = siY.nPos - HIINT(CBWPARAM)*siLn.Y/120 : siRefresh = 1
                      END IF 
                      siY.nPos = MAX(siY.nPos, 0): siY.nPos = MIN(siY.nPos, siSz.Y - siPg.Y)
                      siY.fMask = %SIF_POS
                      SetScrollInfo CBHNDL, %SB_VERT, siY, siRefresh
                      SetWindowPos hDlg2, 0, -siX.nPos, -siY.nPos, 0, 0, %SWP_NOSIZE OR %SWP_NOZORDER OR %SWP_NOACTIVATE
                      SetWindowText GetParent(CBHNDL), "PosX =" + STR$(siX.nPos) + " PosY =" + STR$(siY.nPos) + " (pixels)"
                END SELECT
             END FUNCTION
          
             CALLBACK FUNCTION DlgProc
                SELECT CASE CBMSG
                   CASE %WM_INITDIALOG
                      LOCAL hDlg1 AS LONG
                      DIALOG NEW CBHNDL, "", 10, 10, 180, 180, %WS_CHILD OR %WS_VISIBLE OR _
                        %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %WS_HSCROLL OR %WS_VSCROLL, _
                        %WS_EX_CLIENTEDGE OR %WS_VSCROLL TO hDlg1
                      DIALOG SHOW MODELESS hDlg1  CALL DlgProc1
                END SELECT
             END FUNCTION
          
             FUNCTION PBMAIN
                LOCAL hDlg AS LONG
                DIALOG NEW 0,"Scroll Bar",,, 200, 200, %WS_CAPTION OR %WS_SYSMENU OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS TO hdlg
                DIALOG SHOW MODAL hdlg CALL DlgProc
             END FUNCTION

          Comment


          • #6
            Alternatively add a separate CASE clause to CALLBACK FUNCTION DlgProc1:
            Code:
                CASE %WM_MOUSEWHEEL
                  LOCAL zDelta AS INTEGER
                  zDelta = HIWRD(CbWparam)
            
                  IF (LOWRD(CbwParam) AND %MK_CONTROL) = %MK_CONTROL THEN   'horizontal scroll
                    IF zDelta > 0 THEN                                      'scroll to the left
                      SendMessage CbHndl, %WM_HSCROLL, MAKLNG(%SB_LINELEFT, 0), 0
                    ELSE                                                    'scroll to the right
                      SendMessage CbHndl, %WM_HSCROLL, MAKLNG(%SB_LINERIGHT, 0), 0
                    END IF
                  ELSE                                                      'vertical scroll
                    IF zDelta > 0 THEN                                      'scroll upwards
                      SendMessage CbHndl, %WM_VSCROLL, MAKLNG(%SB_LINEUP, 0), 0
                    ELSE                                                    'scroll downwards
                      SendMessage CbHndl, %WM_VSCROLL, MAKLNG(%SB_LINEDOWN, 0), 0
                    END IF
                  END IF
            - Adds horizontal scolling too by use of CTRL/MouseWheel

            Rgds Dave

            ------------------
            Rgds, Dave

            Comment

            Working...
            X