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

Scroll Bars for the Dialog

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

  • Scroll Bars for the Dialog

    Hi All,
    Here is the skeleton code for the Dialog's Scroll Bars which
    actualy does scroll the Dialog. Code has been made as simple
    as possible and is generously commented.
    Enjoy
    MN

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' WORKING Dialog's own Scroll Bars
    ' Based on code provided  by Borje Hagsten,
    ' simplified and "beautyfied" by Maciej Neyman.
    ' Free to use by all PB programers.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    '--------------------------------------------------------------------
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    
    '--------------------------------------------------------------------
    %IDC_LABEL1 = 200
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Dialog and Controls setup
    '--------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
       LOCAL hDlg AS DWORD
    
      DIALOG NEW 0, "Dialog's Scroll Bars ",,, 450, 250, _
      %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX,  TO hDlg
      DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74)
      '------------------------------------------------------------------
      CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !", 100, 100, 300, 200
      CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74)
    
      '------------------------------------------------------------------
      DIALOG SHOW MODAL hDlg CALL DlgProc
    
    END FUNCTION
    
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Main callback
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc() AS LONG
    
    
      ' initialize scrollbar constants here
      LOCAL w AS LONG, h AS LONG, oldPos AS LONG, si AS SCROLLINFO
      LOCAL vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG
    
    '==========================================================================
    'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
    'SCROLL BARS:   (try to experiment with these values)
    '==========================================================================
    
        w = 600    'This is the number of dialog units by which the Dialog's Window
                   'will scroll horizontaly if the thumb of the Scrolling Bar
                   'travels between its extreme positions left and right
                   'Reasonable (but not compulsory) value for it is between 200 to 2000
    
        h = 400    'This is the number of dialog units by which the Dialog's Window
                   'will scroll verticaly if the thumb of the Scrolling Bar
                   'travels between its extreme positions top and bottom
                   'Reasonable (but not compulsory) value for it is between 200 to 1600
    
        vt = 50    'lenght of the vertical scroll bar's thumb, this is also the amount
                   'of dialog units by which the dialog will scroll verticaly if mouse is
                   'clicked between the ends of the scroll bar and the thumb itself
                   'reasonable value for it is between 10 and h/2
    
        ht = 50    'lenght of the horizontal scroling bar's thumb, this is also the amount
                   'of dialog units by which the dialog will scroll horizontaly if mouse is
                   'clicked between the ends of the scroll bar and the thumb itself
                   'reasonable value for it is between 10 and w/2
    
        hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
                   'small arrow on either end of scroling bar is activated by mouse
                   'reasonable values for it is between 1 and 30. Small value produces
                   'smother but slower scrolling, the higher value is faster but more
                   'jerki - the Dialog scrolls by steps determined by this value.
    
        vs = 5     'number of dialog units by which the Dialog scrolls verticaly when the
                   'small arrow on either end of scroling bar is activated by mouse
                   'reasonable values for it is between 1 and 30. Small value produces
                   'smother but slower scrolling, the higher value is faster but more
                   'jerki - the Dialog scrolls by steps determined by this value.
    
    '----------------
       'If scroling by dialog units and not by pixels is giving you stomachache
       'remove REM from the next line.
    
       REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h
    
    '==========================================================================
    ' This is all you have to decide upon, the rest just copy.
    ' If you remove all comments, the code become quite lean!
    '==========================================================================
    
      SELECT CASE CBMSG
         CASE %WM_INITDIALOG
    
           ' initialize scrollbars here
           '---------------------------------------------------------------------------------
            si.cbSize = LEN(si)                   ' get place holders for the si parameters
            si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
            si.nMin   = 0                         ' min scroll pos
            si.nMax   = h                         ' max scroll pos
            si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
            SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                                  ' "TRUE" and causes redraw of the scroll bar
            '--------------------------------------------------------------------------------
            si.nMin   = 0                         ' min scroll pos
            si.nMax   = w                         ' max scroll pos
            si.nPage  = ht                        ' width of the horizontal scroll bar thumb
            si.nPos   = 0                         ' initial position of the thumbs
            SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                                  ' "TRUE" and causes redraw of the scroll bar
            '--------------------------------------------------------------------------------
    
    
         CASE %WM_COMMAND      ' <- a control is calling
            SELECT CASE CBCTL  ' <- look at control's id
               CASE %IDCANCEL
                  IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
                     DIALOG END CBHNDL
                  END IF
    
            END SELECT
    
    
         CASE %WM_HSCROLL  ' call from the horizontal scroll bar
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_HORZ, si
            oldPos = si.nPos
    
            SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINELEFT   : si.nPos = si.nPos - hs
                CASE %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
                CASE %SB_LINERIGHT  : si.nPos = si.nPos + hs
                CASE %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
                CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                CASE ELSE           : EXIT FUNCTION
            END SELECT
    
            'To limit scroling range remove REM from the next line.
            'If you don't then you can keep scrolling indefinitelly (well, almost)
            'by using small arrrows on the end of the scroll bar.
    
        REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage))
    
            ' Update the scroll bar and scroll the client area
            si.fMask  = %SIF_POS
            SetScrollInfo CBHNDL, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
            ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL   'actual scroling action
            FUNCTION = 1
    
    
         CASE %WM_VSCROLL  'call from the vertical scroll bar
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_VERT, si
            oldPos = si.nPos
    
            SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINEUP     : si.nPos = si.nPos - vs
                CASE %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
                CASE %SB_LINEDOWN   : si.nPos = si.nPos + vs
                CASE %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
                CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                CASE ELSE           : EXIT FUNCTION
            END SELECT
    
            'To limit scroling range remove REM from the next line
            'If you don't then you can keep scrolling indefinitelly (well, almost)
            'by using small arrrows on the end of the scroll bar.
    
        REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1))
    
            ' Update the scroll bar and scroll the client area
            si.fMask = %SIF_POS
            SetScrollInfo CBHNDL, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
            ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL  'actual scroling action
            FUNCTION = 1
    
      END SELECT
    END FUNCTION
    ------------------


    [This message has been edited (some spelling) by Maciej NEYMAN (edited January 08, 2005).]

    [This message has been edited by Maciej NEYMAN (edited January 17, 2005).]

  • #2
    This is new code which also provides scrolling with the Mouse Wheel
    and the keyboard.
    Enjoy,
    Maciej

    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' WORKING Dialog's own Scroll Bars
    ' Based on code provided  by Borje Hagsten,
    ' simplified and "beautyfied" by Maciej Neyman.
    ' Free to use by all PB programers.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Additional scroling using Mouse Wheel and keyboard based on code
    ' posted by Semen Matusowsky and others.
    ' Tested on WinME and XP (Home edition)
    ' Compiled with PBWin8
    '--------------------------------------------------------------------
    '--------------------------------------------------------------------
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    
    '--------------------------------------------------------------------
    %IDC_LABEL1 = 200
    GLOBAL Finito AS LONG
    GLOBAL hDlg AS LONG
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Dialog and Controls setup
    '--------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
      ' LOCAL hDlg AS DWORD
    
      DIALOG NEW 0, "Dialog's Scrolling System ",,, 450, 250, _
      %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX,  TO hDlg
      DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74)
      '------------------------------------------------------------------
      'CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !", 100, 100, 300, 200
      CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _
      "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _
      "Please note, there is additional switch (button) under the Wheel." + $CRLF +_
      "If you press hard the Wheel, the switch is activated and the"+ $CRLF +_
      "scrolling changes direction.", 100, 100, 300, 200
    
      CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74)
    
      '------------------------------------------------------------------
      DIALOG SHOW MODAL hDlg CALL DlgProc
    
    END FUNCTION
    
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' Main callback
    '--------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc() AS LONG
       REM  SetFocus hDlg    ' To prevent crashing the XP un-REM this statement
                             ' but keep it REM-ed in 9x varieties as it will
                             ' crash them stright away. Do not ask me why.
                             ' Ask Billy.  
    
      ' initialize scrollbar constants here
      LOCAL w AS LONG, h AS LONG, oldPos AS LONG, si AS SCROLLINFO
      LOCAL vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG
    
    '==========================================================================
    'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
    'SCROLL BARS:   (try to experiment with these values)
    '==========================================================================
    
        w = 600    'This is the number of dialog units by which the Dialog's Window
                   'will scroll horizontaly if the thumb of the Scrolling Bar
                   'travels between its extreme positions left and right
                   'Reasonable (but not compulsory) value for it is between 200 to 2000
    
        h = 400    'This is the number of dialog units by which the Dialog's Window
                   'will scroll verticaly if the thumb of the Scrolling Bar
                   'travels between its extreme positions top and bottom
                   'Reasonable (but not compulsory) value for it is between 200 to 1600
    
        vt = 50    'lenght of the vertical scroll bar's thumb, this is also the amount
                   'of dialog units by which the dialog will scroll verticaly if mouse is
                   'clicked between the ends of the scroll bar and the thumb itself
                   'reasonable value for it is between 10 and h/2
    
        ht = 50    'lenght of the horizontal scroling bar's thumb, this is also the amount
                   'of dialog units by which the dialog will scroll horizontaly if mouse is
                   'clicked between the ends of the scroll bar and the thumb itself
                   'reasonable value for it is between 10 and w/2
    
        hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
                   'small arrow on either end of scroling bar is activated by mouse
                   'reasonable values for it is between 1 and 30. Small value produces
                   'smother but slower scrolling, the higher value is faster but more
                   'jerki - the Dialog scrolls by steps determined by this value.
    
        vs = 5     'number of dialog units by which the Dialog scrolls verticaly when the
                   'small arrow on either end of scroling bar is activated by mouse
                   'reasonable values for it is between 1 and 30. Small value produces
                   'smother but slower scrolling, the higher value is faster but more
                   'jerki - the Dialog scrolls by steps determined by this value.
    
    '----------------
       'If scroling by dialog units and not by pixels is giving you stomachache
       'remove REM from the next line.
    
       REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h
    
    '==========================================================================
    ' This is all you have to decide upon, the rest just copy.
    ' If you remove all comments, the code become quite lean!
    '==========================================================================
    
      SELECT CASE CBMSG
         CASE %WM_DESTROY : Finito = 1
         CASE %WM_INITDIALOG
    
            DIALOG POST hDlg, %WM_MOUSEWHEEL, 0, 0 'For some, unknown to me reasons, without this statement
                                                   'Windows does not process keyboard PgUp, PgDn input
                                                   'necessary for  scroling using the Keyboard
    
    
           ' initialize scrollbars here
           '---------------------------------------------------------------------------------
            si.cbSize = LEN(si)                   ' get place holders for the si parameters
            si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
            si.nMin   = 0                         ' min scroll pos for thumb
            si.nMax   = h                         ' max scroll pos for thumb
            si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
            SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                                  ' "TRUE" and causes redraw of the scroll bar
            '--------------------------------------------------------------------------------
            si.nMin   = 0                         ' min scroll pos for thumb
            si.nMax   = w                         ' max scroll pos for thumb
            si.nPage  = ht                        ' width of the horizontal scroll bar thumb
            si.nPos   = 0                         ' initial position of the thumbs
            SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                                  ' "TRUE" and causes redraw of the scroll bar
            '--------------------------------------------------------------------------------
    
    
         CASE %WM_COMMAND      ' <- a control is calling
            SELECT CASE CBCTL  ' <- look at control's id
               CASE %IDCANCEL
                  IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
                     DIALOG END CBHNDL
                  END IF
    
            END SELECT
    
    
         CASE %WM_HSCROLL  ' call from the horizontal scroll bar
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_HORZ, si
            oldPos = si.nPos
    
            SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINELEFT   : si.nPos = si.nPos - hs
                CASE %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
                CASE %SB_LINERIGHT  : si.nPos = si.nPos + hs
                CASE %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
                CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                CASE ELSE           : EXIT FUNCTION
            END SELECT
    
            'To limit scroling range remove REM from the next line.
            'If you don't then you can keep scrolling indefinitelly (well, almost)
            'by using small arrrows on the end of the scroll bar.
    
        REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage))
    
            ' Update the scroll bar and scroll the client area
            si.fMask  = %SIF_POS
            SetScrollInfo CBHNDL, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
            ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL   'actual scroling action
            FUNCTION = 1
    
    
         CASE %WM_VSCROLL  'call from the vertical scroll bar
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_VERT, si
            oldPos = si.nPos
    
            SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINEUP     : si.nPos = si.nPos - vs
                CASE %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
                CASE %SB_LINEDOWN   : si.nPos = si.nPos + vs
                CASE %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
                CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                CASE ELSE           : EXIT FUNCTION
            END SELECT
    
            'To limit scroling range remove REM from the next line
            'If you don't then you can keep scrolling indefinitelly (well, almost)
            'by using small arrrows on the end of the scroll bar.
    
        REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1))
    
            ' Update the scroll bar and scroll the client area
            si.fMask = %SIF_POS
            SetScrollInfo CBHNDL, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
            ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL  'actual scroling action
            FUNCTION = 1
    
    '===============================================================================================
    ' Scrolling by Mouse wheel
    '===============================================================================================
          CASE %WM_MBUTTONDOWN     'Use of the Middle Mouse Button (under the wheel) click as the toggle
             GLOBAL D AS LONG      'for the V/H scroling change
             IF D = 0 THEN D = 1
             D= D*(-1)
         CASE %WM_MOUSEWHEEL
            LOCAL M AS LONG
            LOCAL K AS LONG
           ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ    ' Changing scrolling direction V/H
            IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1    'setting scrolling movement Up/Down, Left/Right
    
         IF D = -1 THEN
         si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_VERT, si
            oldPos = si.nPos
    
            si.nPos = si.nPos +vs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
    
         si.fMask = %SIF_POS
            SetScrollInfo CBHNDL, %SB_VERT, si, 1
            ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL
            FUNCTION = 1
         ELSE
           si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_HORZ, si
            oldPos = si.nPos
    
            si.nPos = si.nPos +hs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
    
         si.fMask = %SIF_POS
            SetScrollInfo CBHNDL, %SB_HORZ, si, 1
            ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL
            FUNCTION = 1
          END IF
    '===============================================================================================
    ' Scrolling by Keyboard ( PgUp, PgDn)
    ' I have decided to use the Arrow's Keys to jump between controls or cells
    ' You can use them for scroling if you wish, just replace %VK_PGUP/PGDN with
    ' the relevant arrow's equates. Also you can change "h" parameter to your heart content.
    '===============================================================================================
     ' Keyboard interception
    '-----------------------
       LOCAL Mes AS tagMsg  ' Windows inherent sub classing (Win32API)! Look under MSG
    
      DO WHILE GetMessage(Mes, %NULL, 0, 0) 'Keyboard interception
      SELECT CASE Mes.message
       CASE %WM_KEYDOWN
        SELECT CASE Mes.wParam
        CASE %WM_DESTROY
            Finito = 1
        CASE 27
            Finito = 1
    
        CASE %VK_PGDN
         '--------------------------------------
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_VERT, si
            oldPos = si.nPos
    
            si.nPos = si.nPos + h/2      ' h = number of units to scroll verticaly
    
            si.fMask = %SIF_POS
            SetScrollInfo hDlg, %SB_VERT, si, 1
            ScrollWindow hDlg, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL
    
        CASE %VK_PGUP
    
            si.cbSize = SIZEOF(si)
            si.fMask  = %SIF_ALL
            GetScrollInfo CBHNDL, %SB_VERT, si
            oldPos = si.nPos
    
            si.nPos = si.nPos - h/2      ' h/2 = number of units to scroll verticaly
    
            si.fMask = %SIF_POS
            SetScrollInfo hDlg, %SB_VERT, si, 1
            ScrollWindow hDlg, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL
    
    
        END SELECT
     END SELECT
        IF IsDialogMessage(hDlg, Mes) = %FALSE THEN
         TranslateMessage Mes
         DispatchMessage Mes
      END IF
         IF Finito <> 0 THEN EXIT DO
      LOOP
      FUNCTION = 1
    '============================================================================================================
    
      END SELECT
    END FUNCTION
    ------------------




    [This message has been edited by Maciej NEYMAN (edited March 21, 2006).]

    Comment


    • #3
      Hi All,
      I just have no more time to play with this silly scroll bars, so this is
      my final code. I have rearranged the code so keyboard interception
      is done in the modeless dialog and the scrolling is done in the
      call-back function. It seems to work now in the x98 and XP without
      crashes and without need to change the coding for different versions of the OS
      we all know and love:

      Code:
      '=======================================================================
      ' Working Dialog's Scroll Bars and simple keyboard interception sample
      ' (necessary for the scroling by PgUp & PgDown keys on the keyboard)
      '  by Maciej Neyman.
      '
      'Disclaimer:
      'This code is provided as-is and it does not have any warranty of any kind.
      'If it causes collapse of the Universe, the Author does not want to know it.
      'Refer that case to Inteligent Designer and blame Billy G. for it.
      '
      'User is  responsible for any use and/or misuse of the code.
      'If you don't agree please don't use this code.
      '=====================================================================
      
      #COMPILE EXE
      #REGISTER NONE
      DEFLNG A-Z
      #INCLUDE "Win32Api.Inc"
      GLOBAL Finito&
      GLOBAL V AS LONG
      GLOBAL S AS STRING
      DECLARE FUNCTION fVKDDT
      DECLARE FUNCTION ClearDisp
      DECLARE CALLBACK FUNCTION DlgProc()
      
      %IDC_TEXT8    = 148
      %IDC_TEXT9    = 149
      %IDC_TEXT10   = 150
      
      %IDC_LABEL1     = 200
      %IDC_LABEL10    = 210
      %IDC_LABEL11    = 211
      %IDC_LABEL12    = 212
      
      
       CALLBACK FUNCTION DlgProc AS LONG
      
        ' initialize scrollbar constants here
        LOCAL w AS LONG, vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG
        GLOBAL oldPos AS LONG, h AS LONG, si AS SCROLLINFO
        LOCAL Mes AS tagMsg  ' Windows inherent sub classing (Look under MSG in Win32API-help)
                             ' needed for the keyboard interception
      '==========================================================================
      'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
      'SCROLL BARS:   (try to experiment with these values)
      '==========================================================================
      
          w = 600    'This is the number of dialog units by which the Dialog's Window
                     'will scroll horizontaly if the thumb of the Scrolling Bar
                     'travels between its extreme positions left and right
                     'Reasonable (but not compulsory) value for it is between 200 to 2000
      
          h = 400    'This is the number of dialog units by which the Dialog's Window
                     'will scroll verticaly if the thumb of the Scrolling Bar
                     'travels between its extreme positions top and bottom
                     'Reasonable (but not compulsory) value for it is between 200 to 1600
      
          vt = 50    'lenght of the vertical scroll bar's thumb, this is also the amount
                     'of dialog units by which the dialog will scroll verticaly if mouse is
                     'clicked between the ends of the scroll bar and the thumb itself
                     'reasonable value for it is between 10 and h/2
      
          ht = 50    'lenght of the horizontal scroling bar's thumb, this is also the amount
                     'of dialog units by which the dialog will scroll horizontaly if mouse is
                     'clicked between the ends of the scroll bar and the thumb itself
                     'reasonable value for it is between 10 and w/2
      
          hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
                     'small arrow on either end of scroling bar is activated by mouse
                     'reasonable values for it is between 1 and 30. Small value produces
                     'smother but slower scrolling, the higher value is faster but more
                     'jerki - the Dialog scrolls by steps determined by this value.
      
          vs = 5     'number of dialog units by which the Dialog scrolls verticaly when the
                     'small arrow on either end of scroling bar is activated by mouse
                     'reasonable values for it is between 1 and 30. Small value produces
                     'smother but slower scrolling, the higher value is faster but more
                     'jerki - the Dialog scrolls by steps determined by this value.
      
      '----------------
         'If scroling by dialog units and not by pixels is giving you stomachache
         'remove REM from the next line.
      
         REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h
      
      '==========================================================================
      ' This is all you have to decide upon, the rest just copy.
      ' If you remove all comments, the code become quite lean!
      '==========================================================================
      
        SELECT CASE CBMSG
      
           CASE %WM_DESTROY : Finito = 1  : DIALOG END hDlg
           CASE %WM_INITDIALOG
      
             ' initialize scrollbars here
             '---------------------------------------------------------------------------------
              si.cbSize = LEN(si)                   ' get place holders for the si parameters
              si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
              si.nMin   = 0                         ' min scroll pos for thumb
              si.nMax   = h                         ' max scroll pos for thumb
              si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
              SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                                    ' "TRUE" and causes redraw of the scroll bar
              '--------------------------------------------------------------------------------
              si.nMin   = 0                         ' min scroll pos for thumb
              si.nMax   = w                         ' max scroll pos for thumb
              si.nPage  = ht                        ' width of the horizontal scroll bar thumb
              si.nPos   = 0                         ' initial position of the thumbs
              SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                                    ' "TRUE" and causes redraw of the scroll bar
              '--------------------------------------------------------------------------------
      
           CASE %WM_COMMAND      ' <- a control is calling
              SELECT CASE CBCTL  ' <- look at control's id
      
                    IF CBCTLMSG = %BN_CLICKED THEN
                         'Enter key is beheaving here as the TAB key!
                      SELECT CASE GetDlgCtrlId(GetFocus) 'Which control has focus?
                       CASE %IDC_TEXT8 TO %IDC_TEXT10
                        IF (GetKeyState(%VK_SHIFT) AND &H8000) = 0 THEN   'move focus
      
                            ' Is the above line another posibility to trap some keys?
      
                            SetFocus GetNextDlgTabItem(CBHNDL, GetFocus, 0)
                        ELSE 'Shift + Enter = move to previous control
                            SetFocus GetNextDlgTabItem(CBHNDL, GetFocus, 1)
                        END IF
      
                       CASE %IDOK     ' <- Ok or Enter key was pressed
                         MSGBOX "%IDOK", %MB_TASKMODAL, "DDT Equate"   ' your code here
      
                       CASE %IDCANCEL  ' If Cancel button has focus
                        DIALOG END CBHNDL, 0   '<- End prog
      
                      END SELECT
                    END IF
             '----------------------------------------------
            CASE %IDCANCEL  ' <- Cancel button was pressed
                IF CBCTLMSG = %BN_CLICKED THEN
                    DIALOG END CBHNDL, 0   '<- End prog
                END IF
            '--------------------------------------------------------------
           ' END SELECT
                 CASE %IDCANCEL
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
                       DIALOG END CBHNDL
                    END IF
      
              END SELECT
      
           CASE %WM_HSCROLL  ' call from the horizontal scroll bar
              si.cbSize = SIZEOF(si)
              si.fMask  = %SIF_ALL
              GetScrollInfo CBHNDL, %SB_HORZ, si
              oldPos = si.nPos
      
              SELECT CASE LOWRD(CBWPARAM)
                  CASE %SB_LINELEFT   : si.nPos = si.nPos - hs
                  CASE %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
                  CASE %SB_LINERIGHT  : si.nPos = si.nPos + hs
                  CASE %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
                  CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                  CASE ELSE           : EXIT FUNCTION
              END SELECT
      
              'To limit scroling range remove REM from the next line.
              'If you don't then you can keep scrolling indefinitelly (well, almost)
              'by using small arrrows on the end of the scroll bar.
      
          REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage))
      
              ' Update the scroll bar and scroll the client area
              si.fMask  = %SIF_POS
              SetScrollInfo CBHNDL, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
              ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL   'actual scroling action
              FUNCTION = 1
      
      
           CASE %WM_VSCROLL  'call from the vertical scroll bar
              si.cbSize = SIZEOF(si)
              si.fMask  = %SIF_ALL
              GetScrollInfo CBHNDL, %SB_VERT, si
              oldPos = si.nPos
      
              SELECT CASE LOWRD(CBWPARAM)
                  CASE %SB_LINEUP     : si.nPos = si.nPos - vs
                  CASE %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
                  CASE %SB_LINEDOWN   : si.nPos = si.nPos + vs
                  CASE %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
                  CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                  CASE ELSE           : EXIT FUNCTION
              END SELECT
      
              'To limit scroling range remove REM from the next line
              'If you don't then you can keep scrolling indefinitelly (well, almost)
              'by using small arrrows on the end of the scroll bar.
      
          REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1))
      
              ' Update the scroll bar and scroll the client area
              si.fMask = %SIF_POS
              SetScrollInfo CBHNDL, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
              ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL  'actual scroling action
              FUNCTION = 1
      
      '===============================================================================================
      ' Scrolling by Mouse wheel
      '===============================================================================================
            CASE %WM_MBUTTONDOWN     'Use of the Middle Mouse Button (under the wheel) click as the toggle
               GLOBAL D AS LONG      'for the V/H scroling change
               IF D = 0 THEN D = 1
               D= D*(-1)
            CASE %WM_MOUSEWHEEL
             ' LOCAL M AS LONG
              LOCAL K AS LONG
             ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ    ' Changing scrolling direction V/H
              IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1    'setting scrolling movement Up/Down, Left/Right
      
           IF D = -1 THEN
           si.cbSize = SIZEOF(si)
              si.fMask  = %SIF_ALL
              GetScrollInfo CBHNDL, %SB_VERT, si
              oldPos = si.nPos
      
              si.nPos = si.nPos +vs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
      
           si.fMask = %SIF_POS
              SetScrollInfo CBHNDL, %SB_VERT, si, 1
              ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL
              FUNCTION = 1
           ELSE
             si.cbSize = SIZEOF(si)
              si.fMask  = %SIF_ALL
              GetScrollInfo CBHNDL, %SB_HORZ, si
              oldPos = si.nPos
      
              si.nPos = si.nPos +hs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
      
           si.fMask = %SIF_POS
              SetScrollInfo CBHNDL, %SB_HORZ, si, 1
              ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL
              FUNCTION = 1
            END IF
      
      '===============================================================================================
      ' Scrolling by Keyboard ( PgUp, PgDn) is done in the  PBMAIN function (Dialog show MODELESS !!!)
      ' Scrolling using arrows is more complicated due to bizzare keyboard processing by Windows.
      ' On the other hand I think arrows are better left for use in conjunction with controls.
      '===============================================================================================
          END SELECT
      
      END FUNCTION
      ________________________________________________________________________________________________________________
      FUNCTION PBMAIN()
      
      GLOBAL hDlg AS DWORD
        DIALOG NEW 0, "Dialog's Scroling System & KeyBoard interception by M.Neyman",,, 450, 250, _
        %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX,  TO hDlg
        DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74)
        '------------------------------------------------------------------
        CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _
        "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _
        "Please note, there is additional switch (button) under the Wheel." + $CRLF +_
        "If you press hard the Wheel, the switch is activated (toggled) and the"+ $CRLF +_
        "scrolling changes direction.", 100, 100, 300, 200
      
        CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74)
      
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT8, "", 105, 225, 100, 13
        CONTROL ADD LABEL, hDlg, %IDC_LABEL10, "   Intercepted by:",     215, 215, 70, 12
        CONTROL ADD LABEL, hDlg, -1, "  %WM_KEYDOWN",   215,  227, 70, 10
      
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT10, "", 160, 208, 15, 13
        CONTROL ADD LABEL, hDlg, -1, "Character",   115, 210, 40, 10
      
        CONTROL ADD LABEL, hDlg, %IDC_LABEL12, "     DDT EQUATE :",     310, 215, 70, 10
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXT9, "",                 295, 225, 100, 13
        CONTROL SET COLOR  hDlg, %IDC_LABEL12, %RED, -1
      
      
        CONTROL ADD BUTTON, hDlg, %IDOK,     "Ok",       192, 255, 50, 14
        CONTROL ADD BUTTON, hDlg, %IDCANCEL, "&Cancel", 260, 255, 50, 14
      
           DIALOG SHOW MODELESS hDlg CALL DlgProc
      
      '------------------------------------------------------------------
      
       LOCAL Mes AS tagMsg  ' Windows inherent sub classing (Win32API)! Look under MSG
      
       DO WHILE GetMessage(Mes, %NULL, 0, 0)
       SELECT CASE Mes.message
      '---------------------------
       CASE %WM_CHAR
      
           CONTROL SET TEXT hDlg, %IDC_TEXT10, CHR$(Mes.wParam)
           Info6$ = ""
      CASE %WM_KEYDOWN
       SELECT CASE Mes.wParam
      
       CASE 27
           Finito = 1
           MSGBOX "You have pressed Escape key, the program will terminate" + _
                  $CRLF + $CRLF + "  DDT Equate =  %VK_ESCAPE,    DEC = 27,   HEX = 1B, " +  _
                  $CRLF + $CRLF + "   intercepted using   %WM_KEYDOWN   -  Code Block 8"
      
       CASE 33
          ScrollWindow hDlg, 0, oldPos + h, BYVAL %NULL, BYVAL %NULL    'Scroling up (jumping up ) by PageUp key
      
          V = Mes.wParam                          ' value for the translation into %VK_xxx equate
               CALL ClearDisp
           CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$          ' your code here
           CALL fVKDDT()                                      ' your code here
           CONTROL SET TEXT hDlg, %IDC_TEXT9, S    ' S = %VK_xxx equate derived from value of V (above)
           Info8$ = ""
       CASE 34
          ScrollWindow hDlg, 0, oldPos - h, BYVAL %NULL, BYVAL %NULL    'Scroling down (jumping down ) by PageDown key
      
          V = Mes.wParam                          ' value for the translation into %VK_xxx equate
           CALL ClearDisp
           CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$          ' your code here
           CALL fVKDDT()                                      ' your code here
           CONTROL SET TEXT hDlg, %IDC_TEXT9, S    ' S = %VK_xxx equate derived from value of V (above)
           Info8$ = ""
       CASE 1 TO 255 : Info8$ ="    DEC = " + STR$(Mes.wParam)+ "     HEX = " + HEX$(Mes.wParam)  'interception of all keys
           V = Mes.wParam                          ' value for the translation into %VK_xxx equate
           CALL ClearDisp
           CONTROL SET TEXT hDlg, %IDC_TEXT8, Info8$          ' your code here
           CALL fVKDDT()                                      ' your code here
           CONTROL SET TEXT hDlg, %IDC_TEXT9, S    ' S = %VK_xxx equate derived from value of V (above)
           Info8$ = ""
        END SELECT
      
      END SELECT
      
       IF IsDialogMessage(hDlg, Mes) = %FALSE THEN
          TranslateMessage Mes
          DispatchMessage Mes
       END IF
      IF Finito <> 0 THEN EXIT DO
      LOOP
      END FUNCTION
      '_____________________________________________________________________________________________________________________________
      
      '-------------------------------------------
      FUNCTION ClearDisp
      
           CONTROL SET TEXT hDlg, %IDC_TEXT8, ""
           CONTROL SET TEXT hDlg, %IDC_TEXT9, ""
           CONTROL SET TEXT hDlg, %IDC_TEXT10,""
      END FUNCTION
      
      '=============================================================================================================
      
      '================================
      FUNCTION fVKDDT                      'placement of the DDT equates into array
      '--------------------------------    'for the display purpose only.
      DIM VKDDT(255) AS STRING             'not important for your coding
      
      VKDDT(1) = "%VK_LBUTTON"
      VKDDT(2) = "%VK_RBUTTON"
      VKDDT(3) = "%VK_CANCEL"
      VKDDT(4) = "%VK_MBUTTON"
      VKDDT(5) = "%VK_XBUTTON1"
      VKDDT(6) = "%VK_XBUTTON2"
      VKDDT(8) = "%VK_BACK"
      VKDDT(9) = "%VK_TAB"
      VKDDT(10) = "%VK_LINEFEED"
      VKDDT(12) = "%VK_CLEAR"
      VKDDT(13) = "%VK_RETURN"
      VKDDT(16) = "%VK_SHIFT"
      VKDDT(17) = "%VK_CONTROL"
      VKDDT(18) = "%VK_MENU"
      VKDDT(19) = "%VK_PAUSE"
      VKDDT(20) = "%VK_CAPITAL"
      VKDDT(21) = "%VK_KANA "
      VKDDT(22) = "%VK_HANGUL"
      VKDDT(23) = "%VK_JUNJA"
      VKDDT(24) = "%VK_FINAL"
      VKDDT(25) = "%VK_HANJA"
      VKDDT(26) = "%VK_KANJI"
      VKDDT(27) = "%VK_ESCAPE"
      VKDDT(28) = "%VK_CONVERT"
      VKDDT(29) = "%VK_NONCONVERT"
      VKDDT(30) = "%VK_ACCEPT"
      VKDDT(31) = "%VK_MODECHANGE"
      VKDDT(32) = "%VK_SPACE"
      VKDDT(33) = "%VK_PGUP"
      VKDDT(34) = "%VK_NEXT"
      VKDDT(34) = "%VK_PGDN"
      VKDDT(35) = "%VK_END"
      VKDDT(36) = "%VK_HOME"
      VKDDT(37) = "%VK_LEFT"
      VKDDT(38) = "%VK_UP"
      VKDDT(39) = "%VK_RIGHT"
      VKDDT(40) = "%VK_DOWN "
      VKDDT(41) = "%VK_SELECT"
      VKDDT(42) = "%VK_PRINT"
      VKDDT(43) = "%VK_EXECUTE "
      VKDDT(44) = "%VK_SNAPSHOT"
      VKDDT(45) = "%VK_INSERT "
      VKDDT(46) = "%VK_DELETE "
      VKDDT(47) = "%VK_HELP "
      VKDDT(48) = "%VK_0"
      VKDDT(49) = "%VK_1"
      VKDDT(50) = "%VK_2"
      VKDDT(51) = "%VK_3"
      VKDDT(52) = "%VK_4"
      VKDDT(53) = "%VK_5"
      VKDDT(54) = "%VK_6"
      VKDDT(55) = "%VK_7"
      VKDDT(56) = "%VK_8"
      VKDDT(57) = "%VK_9"
      VKDDT(65) = "%VK_A"
      VKDDT(66) = "%VK_B"
      VKDDT(67) = "%VK_C"
      VKDDT(68) = "%VK_D"
      VKDDT(69) = "%VK_E"
      VKDDT(70) = "%VK_F"
      VKDDT(71) = "%VK_G"
      VKDDT(72) = "%VK_H"
      VKDDT(73) = "%VK_I"
      VKDDT(74) = "%VK_J"
      VKDDT(75) = "%VK_K"
      VKDDT(76) = "%VK_L"
      VKDDT(77) = "%VK_M"
      VKDDT(78) = "%VK_N"
      VKDDT(79) = "%VK_O"
      VKDDT(80) = "%VK_P"
      VKDDT(81) = "%VK_Q"
      VKDDT(82) = "%VK_R"
      VKDDT(83) = "%VK_S"
      VKDDT(84) = "%VK_T"
      VKDDT(85) = "%VK_U"
      VKDDT(86) = "%VK_V"
      VKDDT(87) = "%VK_W"
      VKDDT(88) = "%VK_X"
      VKDDT(89) = "%VK_Y"
      VKDDT(90) = "%VK_Z"
      VKDDT(91) = "%VK_LWIN"
      VKDDT(92) = "%VK_RWIN"
      VKDDT(93) = "%VK_APPS"
      VKDDT(95) = "%VK_SLEEP"
      VKDDT(96) = "%VK_NUMPAD0"
      VKDDT(97) = "%VK_NUMPAD1"
      VKDDT(98) = "%VK_NUMPAD2"
      VKDDT(99) = "%VK_NUMPAD3"
      VKDDT(100) = "%VK_NUMPAD4"
      VKDDT(101) = "%VK_NUMPAD5"
      VKDDT(102) = "%VK_NUMPAD6"
      VKDDT(103) = "%VK_NUMPAD7"
      VKDDT(104) = "%VK_NUMPAD8"
      VKDDT(105) = "%VK_NUMPAD9"
      VKDDT(106) = "%VK_MULTIPLY"
      VKDDT(107) = "%VK_ADD"
      VKDDT(108) = "%VK_SEPARATOR"
      VKDDT(109) = "%VK_SUBTRACT "
      VKDDT(110) = "%VK_DECIMAL "
      VKDDT(111) = "%VK_DIVIDE"
      VKDDT(112) = "%VK_F1"
      VKDDT(113) = "%VK_F2"
      VKDDT(114) = "%VK_F3"
      VKDDT(115) = "%VK_F4"
      VKDDT(116) = "%VK_F5"
      VKDDT(117) = "%VK_F6"
      VKDDT(118) = "%VK_F7"
      VKDDT(119) = "%VK_F8"
      VKDDT(120) = "%VK_F9"
      VKDDT(121) = "%VK_F10"
      VKDDT(122) = "%VK_F11"
      VKDDT(123) = "%VK_F12"
      VKDDT(124) = "%VK_F13"
      VKDDT(125) = "%VK_F14"
      VKDDT(126) = "%VK_F15"
      VKDDT(127) = "%VK_F16"
      VKDDT(128) = "%VK_F17"
      VKDDT(129) = "%VK_F18"
      VKDDT(130) = "%VK_F19"
      VKDDT(131) = "%VK_F20"
      VKDDT(132) = "%VK_F21"
      VKDDT(133) = "%VK_F22"
      VKDDT(134) = "%VK_F23"
      VKDDT(135) = "%VK_F24"
      VKDDT(144) = "%VK_NUMLOCK "
      VKDDT(145) = "%VK_SCROLL "
      VKDDT(146) = "%VK_OEM_NEC_EQUAL"
      VKDDT(147) = "%VK_OEM_FJ_MASSHOU"
      VKDDT(148) = "%VK_OEM_FJ_TOUROKU"
      VKDDT(149) = "%VK_OEM_FJ_LOYA"
      VKDDT(150) = "%VK_OEM_FJ_ROYA"
      VKDDT(160) = "%VK_LSHIFT"
      VKDDT(161) = "%VK_RSHIFT"
      VKDDT(162) = "%VK_LCONTROL"
      VKDDT(163) = "%VK_RCONTROL"
      VKDDT(164) = "%VK_LMENU"
      VKDDT(165) = "%VK_RMENU"
      VKDDT(166) = "%VK_BROWSER_BACK"
      VKDDT(167) = "%VK_BROWSER_FORWARD"
      VKDDT(168) = "%VK_BROWSER_REFRESH"
      VKDDT(169) = "%VK_BROWSER_STOP"
      VKDDT(170) = "%VK_BROWSER_SEARCH "
      VKDDT(171) = "%VK_BROWSER_FAVORITES"
      VKDDT(172) = "%VK_BROWSER_HOME"
      VKDDT(173) = "%VK_VOLUME_MUTE"
      VKDDT(174) = "%VK_VOLUME_DOWN"
      VKDDT(175) = "%VK_VOLUME_UP"
      VKDDT(176) = "%VK_MEDIA_NEXT_TRACK"
      VKDDT(177) = "%VK_MEDIA_PREV_TRACK"
      VKDDT(178) = "%VK_MEDIA_STOP"
      VKDDT(179) = "%VK_MEDIA_PLAY_PAUSE "
      VKDDT(180) = "%VK_LAUNCH_MAIL"
      VKDDT(181) = "%VK_LAUNCH_MEDIA_SELECT"
      VKDDT(182) = "%VK_LAUNCH_APP1"
      VKDDT(183) = "%VK_LAUNCH_APP2"
      VKDDT(186) = "%VK_OEM_1"
      VKDDT(187) = "%VK_OEM_PLUS"
      VKDDT(188) = "%VK_OEM_COMMA"
      VKDDT(189) = "%VK_OEM_MINUS"
      VKDDT(190) = "%VK_OEM_PERIOD"
      VKDDT(191) = "%VK_OEM_2"
      VKDDT(192) = "%VK_OEM_3"
      VKDDT(219) = "%VK_OEM_4"
      VKDDT(220) = "%VK_OEM_5"
      VKDDT(221) = "%VK_OEM_6 "
      VKDDT(222) = "%VK_OEM_7"
      VKDDT(223) = "%VK_OEM_8"
      VKDDT(225) = "%VK_OEM_AX"
      VKDDT(226) = "%VK_OEM_102"
      VKDDT(227) = "%VK_ICO_HELP"
      VKDDT(228) = "%VK_ICO_00"
      VKDDT(229) = "%VK_PROCESSKEY"
      VKDDT(230) = "%VK_ICO_CLEAR"
      VKDDT(231) = "%VK_PACKET"
      VKDDT(233) = "%VK_OEM_RESET"
      VKDDT(234) = "%VK_OEM_JUMP"
      VKDDT(235) = "%VK_OEM_PA1"
      VKDDT(236) = "%VK_OEM_PA2 "
      VKDDT(237) = "%VK_OEM_PA3 "
      VKDDT(238) = "%VK_OEM_WSCTRL"
      VKDDT(239) = "%VK_OEM_CUSEL"
      VKDDT(240) = "%VK_OEM_ATTN"
      VKDDT(241) = "%VK_OEM_FINISH"
      VKDDT(242) = "%VK_OEM_COPY"
      VKDDT(243) = "%VK_OEM_AUTO"
      VKDDT(244) = "%VK_OEM_ENLW"
      VKDDT(245) = "%VK_OEM_BACKTAB"
      VKDDT(246) = "%VK_ATTN"
      VKDDT(247) = "%VK_CRSEL"
      VKDDT(248) = "%VK_EXSEL"
      VKDDT(249) = "%VK_EREOF"
      VKDDT(250) = "%VK_PLAY "
      VKDDT(251) = "%VK_ZOOM "
      VKDDT(252) = "%VK_NONAME"
      VKDDT(253) = "%VK_PA1"
      VKDDT(254) = "%VK_OEM_CLEAR"
      
      S = VKDDT(V)
      
      END FUNCTION
      '=======================================
      ------------------


      [This message has been edited by Maciej NEYMAN (edited April 25, 2006).]

      Comment


      • #4
        And this is basic Skeleton Code of the Dialog with the working Scrolling system:

        Code:
        '=======================================================================
        ' Minimum Skeleton sample for Dialog with the Scrolling Bars
        '  by Maciej Neyman.
        '
        'Disclaimer:
        'This code is provided as-is and it does not have any warranty of any kind.
        'If it causes collapse of the Universe, the Author does not want to know it.
        'Refer that case to Inteligent Designer and blame Billy G. for it.
        '
        'User is  responsible for any use and/or misuse of the code.
        'If you don't agree please don't use this code.
        '=====================================================================
        
        #COMPILE EXE
        #REGISTER NONE
        DEFLNG A-Z
        #INCLUDE "Win32Api.Inc"
        GLOBAL Finito&
        GLOBAL V AS LONG
        GLOBAL S AS STRING
        DECLARE FUNCTION fVKDDT
        DECLARE FUNCTION ClearDisp
        DECLARE CALLBACK FUNCTION DlgProc()
        
        
        %IDC_LABEL1     = 200
        '===================================================
         CALLBACK FUNCTION DlgProc AS LONG
        
          ' initialize scrollbar constants here
          LOCAL w AS LONG, vt AS LONG, ht AS LONG, hs AS LONG, vs AS LONG
          GLOBAL oldPos AS LONG, h AS LONG, si AS SCROLLINFO
          LOCAL Mes AS tagMsg  ' Windows inherent sub classing (Look under MSG in Win32API-help)
                               ' needed for the keyboard interception
        '==========================================================================
        'HERE YOU WILL SETUP VALUES FOR THE CONSTANTS CONTROLING BEHAVIOUR OF THE
        'SCROLL BARS:   (try to experiment with these values)
        '==========================================================================
        
            w = 600    'This is the number of dialog units by which the Dialog's Window
                       'will scroll horizontaly if the thumb of the Scrolling Bar
                       'travels between its extreme positions left and right
                       'Reasonable (but not compulsory) value for it is between 200 to 2000
        
            h = 400    'This is the number of dialog units by which the Dialog's Window
                       'will scroll verticaly if the thumb of the Scrolling Bar
                       'travels between its extreme positions top and bottom
                       'Reasonable (but not compulsory) value for it is between 200 to 1600
        
            vt = 50    'lenght of the vertical scroll bar's thumb, this is also the amount
                       'of dialog units by which the dialog will scroll verticaly if mouse is
                       'clicked between the ends of the scroll bar and the thumb itself
                       'reasonable value for it is between 10 and h/2
        
            ht = 50    'lenght of the horizontal scroling bar's thumb, this is also the amount
                       'of dialog units by which the dialog will scroll horizontaly if mouse is
                       'clicked between the ends of the scroll bar and the thumb itself
                       'reasonable value for it is between 10 and w/2
        
            hs = 5     'number of dialog units by which the Dialog scrolls horizontaly when the
                       'small arrow on either end of scroling bar is activated by mouse
                       'reasonable values for it is between 1 and 30. Small value produces
                       'smother but slower scrolling, the higher value is faster but more
                       'jerki - the Dialog scrolls by steps determined by this value.
        
            vs = 5     'number of dialog units by which the Dialog scrolls verticaly when the
                       'small arrow on either end of scroling bar is activated by mouse
                       'reasonable values for it is between 1 and 30. Small value produces
                       'smother but slower scrolling, the higher value is faster but more
                       'jerki - the Dialog scrolls by steps determined by this value.
        
        '----------------
           'If scroling by dialog units and not by pixels is giving you stomachache
           'remove REM from the next line.
        
           REM DIALOG UNITS CBHNDL, w, h TO PIXELS w, h
        
        '==========================================================================
        ' This is all you have to decide upon, the rest just copy.
        ' If you remove all comments, the code become quite lean!
        '==========================================================================
        
          SELECT CASE CBMSG
        
             CASE %WM_DESTROY : Finito = 1   : DIALOG END hDlg
             CASE %WM_INITDIALOG
        
               ' initialize scrollbars here
               '---------------------------------------------------------------------------------
                si.cbSize = LEN(si)                   ' get place holders for the si parameters
                si.fMask  = %SIF_ALL                  ' setting the topological space for the scroll bars
                si.nMin   = 0                         ' min scroll pos for thumb
                si.nMax   = h                         ' max scroll pos for thumb
                si.nPage  = vt                        ' lenght of the vertical scroll bar's thumb
                SetScrollInfo CBHNDL, %SB_VERT, si, 1 ' initial setup of the vertical scrollbar, "1" represents
                                                      ' "TRUE" and causes redraw of the scroll bar
                '--------------------------------------------------------------------------------
                si.nMin   = 0                         ' min scroll pos for thumb
                si.nMax   = w                         ' max scroll pos for thumb
                si.nPage  = ht                        ' width of the horizontal scroll bar thumb
                si.nPos   = 0                         ' initial position of the thumbs
                SetScrollInfo CBHNDL, %SB_HORZ, si, 1 ' initial setup of the horizontal scrollbar, "1" represents
                                                      ' "TRUE" and causes redraw of the scroll bar
                '--------------------------------------------------------------------------------
                     CASE %IDCANCEL
                      IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN 'end prog
                         DIALOG END CBHNDL
                      END IF
        
             CASE %WM_HSCROLL  ' call from the horizontal scroll bar
                si.cbSize = SIZEOF(si)
                si.fMask  = %SIF_ALL
                GetScrollInfo CBHNDL, %SB_HORZ, si
                oldPos = si.nPos
        
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINELEFT   : si.nPos = si.nPos - hs
                    CASE %SB_PAGELEFT   : si.nPos = si.nPos - si.nPage
                    CASE %SB_LINERIGHT  : si.nPos = si.nPos + hs
                    CASE %SB_PAGERIGHT  : si.nPos = si.nPos + si.nPage
                    CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                    CASE ELSE           : EXIT FUNCTION
                END SELECT
        
                'To limit scroling range remove REM from the next line.
                'If you don't then you can keep scrolling indefinitelly (well, almost)
                'by using small arrrows on the end of the scroll bar.
        
            REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage))
        
                ' Update the scroll bar and scroll the client area
                si.fMask  = %SIF_POS
                SetScrollInfo CBHNDL, %SB_HORZ, si, 1     'remember new geometry of the horizontal scroll bar
                ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL   'actual scroling action
                FUNCTION = 1
        
        
             CASE %WM_VSCROLL  'call from the vertical scroll bar
                si.cbSize = SIZEOF(si)
                si.fMask  = %SIF_ALL
                GetScrollInfo CBHNDL, %SB_VERT, si
                oldPos = si.nPos
        
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINEUP     : si.nPos = si.nPos - vs
                    CASE %SB_PAGEUP     : si.nPos = si.nPos - si.nPage
                    CASE %SB_LINEDOWN   : si.nPos = si.nPos + vs
                    CASE %SB_PAGEDOWN   : si.nPos = si.nPos + si.nPage
                    CASE %SB_THUMBTRACK : si.nPos = HIWRD(CBWPARAM)
                    CASE ELSE           : EXIT FUNCTION
                END SELECT
        
                'To limit scroling range remove REM from the next line
                'If you don't then you can keep scrolling indefinitelly (well, almost)
                'by using small arrrows on the end of the scroll bar.
        
            REM    si.nPos = MAX&(si.nMin, MIN&(si.nPos, si.nMax - si.nPage + 1))
        
                ' Update the scroll bar and scroll the client area
                si.fMask = %SIF_POS
                SetScrollInfo CBHNDL, %SB_VERT, si, 1    'remember new geometry of the vertical scroll bar
                ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL  'actual scroling action
                FUNCTION = 1
        
        '===============================================================================================
        ' Scrolling by Mouse wheel
        '===============================================================================================
              CASE %WM_MBUTTONDOWN     'Use of the Middle Mouse Button (under the wheel) click as the toggle
                 GLOBAL D AS LONG      'for the V/H scroling change
                 IF D = 0 THEN D = 1
                 D= D*(-1)
              CASE %WM_MOUSEWHEEL
               ' LOCAL M AS LONG
                LOCAL K AS LONG
               ' If D = -1 THEN M = %SB_VERT Else M = %SB_HORZ    ' Changing scrolling direction V/H
                IF HIWRD(CBWPARAM)> 50000 THEN K = 1 ELSE K = -1    'setting scrolling movement Up/Down, Left/Right
        
             IF D = -1 THEN
             si.cbSize = SIZEOF(si)
                si.fMask  = %SIF_ALL
                GetScrollInfo CBHNDL, %SB_VERT, si
                oldPos = si.nPos
        
                si.nPos = si.nPos +vs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
        
             si.fMask = %SIF_POS
                SetScrollInfo CBHNDL, %SB_VERT, si, 1
                ScrollWindow CBHNDL, 0, oldPos - si.nPos, BYVAL %NULL, BYVAL %NULL
                FUNCTION = 1
             ELSE
               si.cbSize = SIZEOF(si)
                si.fMask  = %SIF_ALL
                GetScrollInfo CBHNDL, %SB_HORZ, si
                oldPos = si.nPos
        
                si.nPos = si.nPos +hs*3*K   'multiplied by 3 here to increase speed of scrolling - could be changed
        
             si.fMask = %SIF_POS
                SetScrollInfo CBHNDL, %SB_HORZ, si, 1
                ScrollWindow CBHNDL, oldPos - si.nPos, 0, BYVAL %NULL, BYVAL %NULL
                FUNCTION = 1
              END IF
        
        '===============================================================================================
        ' Scrolling by Keyboard ( PgUp, PgDn) is done in the  PBMAIN function (Dialog show MODELESS !!!)
        ' Scrolling using arrows is more complicated due to bizzare keyboard processing by Windows.
        ' On the other hand I think arrows are better left for use in conjunction with controls.
        '===============================================================================================
            END SELECT
        
        END FUNCTION
        ________________________________________________________________________________________________________________
        FUNCTION PBMAIN()
        
        GLOBAL hDlg AS DWORD
          DIALOG NEW 0, "Skeleton Dialog with Scroling bars by Maciej Neyman",,, 450, 250, _
          %WS_CAPTION OR %WS_SYSMENU OR %WS_MAXIMIZEBOX OR %WS_MINIMIZEBOX,  TO hDlg
          DIALOG SET COLOR hDlg, -1, RGB(74, 164, 74)
          '------------------------------------------------------------------
          CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Keep scrolling !" + $CRLF + _
          "Try also PgUp, PgDn keys and the Mouse wheel if you have Mouse with the wheel."+ $CRLF + _
          "Please note, there is additional switch (button) under the Wheel." + $CRLF +_
          "If you press hard the Wheel, the switch is activated (toggled) and the"+ $CRLF +_
          "scrolling changes direction.", 100, 100, 300, 200
        
          CONTROL SET COLOR hDlg, %IDC_LABEL1, -1, RGB(74, 255, 74)
        
             DIALOG SHOW MODELESS hDlg CALL DlgProc
        
        '------------------------------------------------------------------
        
         LOCAL Mes AS tagMsg  ' Windows inherent sub classing (Win32API)! Look under MSG
        
         DO WHILE GetMessage(Mes, %NULL, 0, 0)
         SELECT CASE Mes.message
        '---------------------------
         CASE %WM_KEYDOWN
        
         SELECT CASE Mes.wParam
        
         CASE 27
             Finito = 1
        
         CASE 33
            ScrollWindow hDlg, 0, oldPos + h, BYVAL %NULL, BYVAL %NULL    'Scroling up (jumping up ) by PageUp key
        
         CASE 34
            ScrollWindow hDlg, 0, oldPos - h, BYVAL %NULL, BYVAL %NULL    'Scroling down (jumping down ) by PageDown key
        
          END SELECT
        
        END SELECT
        
         IF IsDialogMessage(hDlg, Mes) = %FALSE THEN
            TranslateMessage Mes
            DispatchMessage Mes
         END IF
        IF Finito <> 0 THEN EXIT DO
        LOOP
        END FUNCTION
        '__________________________________________________________
        'Enjoy M.N.


        Code cleaned up now from inadvertend debris! Sorry.

        [This message has been edited by Maciej NEYMAN (edited April 25, 2006).]

        Comment

        Working...
        X