home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / UserContro1952811212005.psc / gucScrollControl.ctl < prev    next >
Text File  |  2005-11-30  |  24KB  |  624 lines
  1. VERSION 5.00
  2. Begin VB.UserControl gucScrollControl 
  3.    BorderStyle     =   1  'Fest Einfach
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4800
  8.    ControlContainer=   -1  'True
  9.    ScaleHeight     =   240
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   320
  12.    Begin VB.PictureBox picWorkArea 
  13.       AutoRedraw      =   -1  'True
  14.       BackColor       =   &H80000005&
  15.       BorderStyle     =   0  'Kein
  16.       Height          =   1515
  17.       Left            =   1110
  18.       ScaleHeight     =   1515
  19.       ScaleWidth      =   2625
  20.       TabIndex        =   0
  21.       Top             =   810
  22.       Width           =   2625
  23.    End
  24. End
  25. Attribute VB_Name = "gucScrollControl"
  26. Attribute VB_GlobalNameSpace = False
  27. Attribute VB_Creatable = True
  28. Attribute VB_PredeclaredId = False
  29. Attribute VB_Exposed = True
  30. Option Explicit
  31.  
  32. 'FILE INFO
  33. '---------
  34. 'Control:       gucScrollControl
  35. 'IPN prefix:    gsc
  36. 'Purpose:       User control with native windows scrollbars, using gifSubClassing for
  37. '               subclassing. Use this control as a basis to design other controls with full
  38. '               scrollbar functionality.
  39.  
  40. 'Author:        Herbert Glarner
  41. 'Contact:       herbert.glarner@bluewin.ch
  42. 'Copyright:     (c) 2005 by Herbert Glarner
  43. '               Freeware, provided you include credits and mail.
  44.  
  45.  
  46.  
  47. 'CONSTITUTING CONTROLS
  48. '---------------------
  49. 'picWorkArea        Represents the inner work area. Note, that the client area is automatically
  50. '                   adjusted, when scrollbars are shown/hidden (i.e. "ScaleWidth" and "ScaleHeight"
  51. '                   always reflect the really visible client area).
  52.  
  53. 'INTERFACES
  54. '----------
  55. 'gifSubClassing     IDE-safe subclassing [by Paul Caton]
  56.  
  57.  
  58.  
  59. 'USAGE
  60. '-----
  61. '(1) Assign the type of scrollbar(s) to be used (Horiz/Vert/Both) with "ActiveScrollbars".
  62. '
  63. '(2) Use "Min", "Max", "LargeChange" and "Value" to specify the scrollbars' properties.
  64. '    Until now, nothing was displayed: we defined just how the future scrollbar(s) will look like.
  65. '
  66. '(3) Above definitions are communicated to windows now.
  67. '    Use "SetScrollbar" to inform Windows about what we want (once for each scrollbar).
  68. '
  69. '(4) Time to display the scrollbar(s) now (both in one go, if both were defined).
  70. '    Display the scrollbar(s) via "ShowScrollbars" (hide them via "HideScrollbars")
  71. '    The scrollbars are displayed and functional now, i.e., they will trigger events.
  72.  
  73.  
  74.  
  75. 'PUBLIC PROPERTIES
  76. '-----------------
  77. 'ActiveScrollbars   r/w
  78. 'LargeChange        r/w
  79. 'Max                r/w
  80. 'Min                r/w
  81. 'ScaleHeight        r/-
  82. 'ScaleWidth         r/-
  83. 'SmallChange        r/w
  84. 'Value              r/w
  85. 'WorkArea           r/-
  86.  
  87. 'PUBLIC METHODS
  88. '--------------
  89. 'HideScrollbars
  90. 'LineDown           Suggest a line down/pos right, raises events as if the scrollbar was clicked.
  91. 'LineUp             Suggest a line up/pos left, raises events as if the scrollbar was clicked.
  92. 'SetScrollbar
  93. 'ShowScrollbars
  94.  
  95. 'PRIVATE METHODS
  96. '---------------
  97. 'GetHiWord
  98. 'GetLoWord
  99. 'ProcessScrollBar
  100.  
  101.  
  102.  
  103. 'CONSTANTS
  104. '---------
  105.  
  106. 'Windows messages that we're going to filter for callback.
  107. Private Const gscWMHScroll      As Long = &H114&
  108. Private Const gscWMVScroll      As Long = &H115&
  109. Private Const gscWMMouseWheel   As Long = &H20A&
  110.  
  111.  
  112. 'ENUMS
  113. '-----
  114.  
  115. 'Pressed keys while rotating the mouse wheel
  116. Public Enum egscMouseKeys
  117.     egscMKShift = 4&
  118.     egscMKControl = 8&
  119. End Enum
  120.  
  121. 'Type of scrollbar. Used in API calls.
  122. Public Enum egscSBDefinition
  123.     egscSBDHorizontal = 0&
  124.     egscSBDVertical = 1&
  125.     egscSBDBoth = 3&
  126. End Enum
  127.  
  128. 'Our properties allow setting the value for either one of the scrollbars, but not
  129. 'for both together: we have an individual record of the "tgswScrollInfo" structure
  130. 'for each.
  131. Public Enum egscSBOrientation
  132.     egscSBOHorizontal = 0&
  133.     egscSBOVertical = 1&
  134. End Enum
  135.  
  136. 'The scrollbar notification types are delivered in the low word of the DWord
  137. '"wParam". Use the private function "GetLoWord" to extract that word from wParam.
  138. Public Enum egscSBNotification
  139.     'Set scroll value to value - SmallChange
  140.     egscSBNLineLeft = 0
  141.     egscSBNLineUp = 0
  142.     'Set scroll value to value + SmallChange
  143.     egscSBNLineDown = 1
  144.     egscSBNLineRight = 1
  145.     'Set scroll value to value - LargeChange
  146.     egscSBNPageLeft = 2
  147.     egscSBNPageUp = 2
  148.     'Set scroll value to value + LargeChange
  149.     egscSBNPageRight = 3
  150.     egscSBNPageDown = 3
  151.     'Set scroll value to track position, Track Event if wanted
  152.     egscSBNThumbTrack = 5       'while Tracking
  153.     egscSBNThumbPosition = 4    'End of Tracking
  154.     'Set scroll value to min
  155.     egscSBNLeft = 6
  156.     egscSBNTop = 6
  157.     'Set scroll value to max
  158.     egscSBNRight = 7
  159.     egscSBNBottom = 7
  160.     'Raise a Change Event
  161.     egscSBNEndScroll = 8
  162. End Enum
  163.  
  164. 'Used in the "Mask" field of the structure "tgswScrollInfo".
  165. Public Enum egscScrollInfoMask
  166.     egscSIMRange = &H1
  167.     egscSIMPage = &H2
  168.     egscSIMPos = &H4
  169.     egscSIMDisableNoScroll = &H8
  170.     egscSIMTrackPos = &H10
  171.     egscSIMAll = (egscSIMRange Or egscSIMPage Or egscSIMPos Or egscSIMTrackPos)
  172. End Enum
  173.  
  174.  
  175.  
  176. 'TYPES
  177. '-----
  178.  
  179. 'MS's SCROLLINFO structure. Used to set/retrieve scrollbar values.
  180. Private Type tgscScrollInfo
  181.     Size As Long                'Size of (this) structure
  182.     Mask As egscScrollInfoMask  'Values to change
  183.     Min As Long                 'Minimum value of the scrollbar
  184.     Max As Long                 'Maximum value of the scrollbar
  185.     Page As Long                'What VB calls "LargeChange"
  186.     Pos As Long                 'Current value
  187.     TrackPos As Long            '[Is actually in HiWord of wParam]
  188. End Type
  189. Private Const cSizeofScrollInfo As Long = 28&
  190. 'Note, that the actual maximal value of the scrollbar is actually equal to the
  191. 'structure's "Max" value plus its "Page" value.
  192.  
  193.  
  194.  
  195.  
  196. 'PRIVATE VARIABLES
  197. '-----------------
  198.  
  199. 'Declaring the subclasser
  200. Private gscSubClasser As gclSubClassing  'Declare the subclasser
  201.  
  202. 'Stores the active scrollbar(s). Use "ActiveScrollbars" to set/read this value.
  203. Private glSBDefinition As egscSBDefinition
  204.  
  205. 'We need a "tgswScrollInfo" record per scrollbar, i.e. one each for the
  206. 'horizontal (egswSBOHorizontal) and the vertical (egswSBOVertical) scrollbar.
  207. Private grScrollInfo(egscSBOHorizontal To egscSBOVertical) As tgscScrollInfo
  208.  
  209. 'To not destroy above data when it's needed to call the "GetScrollInfo" API (i.e.
  210. 'when requesting the 32-bit-thumb value while scrolling), another structure pair
  211. 'is defined for that purpose.
  212. Private grScrollInfoTrack(egscSBOHorizontal To egscSBOVertical) As tgscScrollInfo
  213.  
  214. 'We're only raising a "Change" event if there is a new value. This variable holds
  215. 'the last value for which such an event was raised.
  216. Private glLastEventValue(egscSBOHorizontal To egscSBOVertical) As Long
  217.  
  218. 'A "small change" is not realized via the structure. Still, we can't assume "1"
  219. 'all the time, that depends on the clients implementation. Thus, we store that
  220. 'value in a global variable.
  221. 'Usually 1, and initialized with that value
  222. Private glSmallChange(egscSBOHorizontal To egscSBOVertical) As Long
  223.  
  224.  
  225.  
  226.  
  227. 'EXPOSED EVENTS
  228. '--------------
  229.  
  230. 'Use these individual events, if you need a precise control (alignments in grids
  231. 'and the like). As the second argument implies, this is a *suggested* change value
  232. 'only. You can modify this argument and when *your* event procedure was handled the
  233. 'changed value will be applied. (You even can 'cancel' the event by setting this
  234. 'value to 0).
  235. 'Separating the events for the different scrollbars. Vertical scrollbar:
  236. Public Event LineUp(SuggestedChange As Long)
  237. Public Event LineDown(SuggestedChange As Long)
  238. Public Event PageUp(SuggestedChange As Long)
  239. Public Event PageDown(SuggestedChange As Long)
  240. 'Horizontal scrollbar
  241. Public Event PosLeft(SuggestedChange As Long)
  242. Public Event PosRight(SuggestedChange As Long)
  243. Public Event PageLeft(SuggestedChange As Long)
  244. Public Event PageRight(SuggestedChange As Long)
  245. 'When clicking onto the thumb and when dragging it, a suggested *position* (and
  246. 'not a suggested *change* value) is communicated. This position can be manipulated
  247. 'by the client's event procedure: if the value is modified, it is that value which
  248. 'is applied.
  249. Public Event VScroll(SuggestedPos As Long)
  250. Public Event HScroll(SuggestedPos As Long)
  251.  
  252. 'Raised when there is a new Value for the scrollbar. Communicated *after* above
  253. 'events, taking into account a possibly modified suggestion value.
  254. Public Event Change(Scrollbar As egscSBOrientation, Value As Long)
  255.  
  256.  
  257. Public Event MouseWheel(hWnd As Long, X As Long, Y As Long, Value As Long, Key As egscMouseKeys)
  258.  
  259.  
  260.  
  261. 'API DECLARATIONS
  262. '----------------
  263.  
  264. 'Shows or hides a scrollbar
  265. Private Declare Function ShowScrollBar Lib "user32.dll" _
  266.     (ByVal hWnd As Long, ByVal wBar As egscSBDefinition, _
  267.     ByVal bShow As Boolean) As Long
  268.  
  269. 'Sets the properties of a scrollbar
  270. Private Declare Function SetScrollInfo Lib "user32.dll" _
  271.     (ByVal hWnd As Long, ByVal wBar As egscSBOrientation, _
  272.     ByRef lpScrollInfo As tgscScrollInfo, ByVal bool As Boolean) As Long
  273.     
  274. 'Gets the properties of a scrollbar
  275. Private Declare Function GetScrollInfo Lib "user32.dll" _
  276.     (ByVal hWnd As Long, ByVal wBar As egscSBOrientation, _
  277.     ByRef lpScrollInfo As tgscScrollInfo) As Long
  278.     
  279. 'Initializing data structures
  280. Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" _
  281.     (Destination As Long, ByVal Length As Long)
  282.  
  283.  
  284.  
  285. 'IMTERFACES
  286. '----------
  287.  
  288. 'We're implementing the interfaces declared in iSuperClass. Once the following declaration is in
  289. 'place you'll find an entry in the left hand combo-box at the top of the code window for gifSubClassing.
  290. Implements gifSubClassing
  291.  
  292.  
  293.  
  294. 'USERCONTROL CONSTRUCTOR AND DESTRUCTOR
  295. '--------------------------------------
  296.  
  297. Private Sub UserControl_Initialize()
  298.     Dim lSize As Long
  299.     
  300.     'The field "Size" of the two variables of structure type "tgswScrollInfo"
  301.     'needs to be set once only: it won't change.
  302.     lSize = Len(grScrollInfo(egscSBOHorizontal))  'Either one (Hor/Vert) does the job
  303.     grScrollInfo(egscSBOHorizontal).Size = lSize
  304.     grScrollInfo(egscSBOVertical).Size = lSize
  305.     
  306.     grScrollInfo(egscSBOHorizontal).Mask = egscSIMAll
  307.     grScrollInfo(egscSBOVertical).Mask = egscSIMAll
  308.     
  309.     'Initializing the small change value is '1' (can be overwritten with the
  310.     'property "SmallChange").
  311.     glSmallChange(egscSBOHorizontal) = 1&
  312.     glSmallChange(egscSBOVertical) = 1&
  313.     
  314.     'Subclass the scrollbar messages. Create a SubClasser instance.
  315.     Set gscSubClasser = New gclSubClassing
  316.     
  317.     'Position picture box representing the work area.
  318.     picWorkArea.Left = 0&
  319.     picWorkArea.Top = 0&
  320.  
  321.     'Tell the subclasser which messages to callback on (filtered mode).
  322.     With gscSubClasser
  323.         'Note: There's an optional second parameter to AddMsg which should be set to True if you
  324.         '      wish to receive the message *before* default processing.
  325.         Call .AddMsg(gscWMHScroll, True)
  326.         Call .AddMsg(gscWMVScroll, True)
  327.         Call .AddMsg(gscWMMouseWheel, True)
  328.     
  329.         'Start subclassing.
  330.         Call .Subclass(hWnd, Me)
  331.     End With
  332. End Sub
  333.  
  334. Private Sub UserControl_Terminate()
  335.     'Destroy the SubClasser.
  336.     Set gscSubClasser = Nothing
  337. End Sub
  338.  
  339. Private Sub UserControl_Resize()
  340.     'The picture box representing the work area rakes the whole inner client area
  341.     '(without occupying the space needed for the scrollbars).
  342.     picWorkArea.Width = ScaleWidth
  343.     picWorkArea.Height = ScaleHeight
  344. End Sub
  345.  
  346.  
  347.  
  348. 'SUBCLASSER INTERFACE MESSAGES
  349. '-----------------------------
  350.  
  351. Private Sub gifSubClassing_After _
  352.     (lReturn As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  353.     
  354.     'Not used, but existence of the Sub is an implementation requirement.
  355. End Sub
  356.  
  357. 'This implemented interface is called BEFORE default processing, i.e. *before* the previous WndProc.
  358. 'Set "lReturn" to '0' and "lHandled" to 'True' when the message was handled.
  359. Private Sub gifSubClassing_Before _
  360.     (lHandled As Long, _
  361.      lReturn As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  362.      
  363.     Dim lX As Long, lY As Long
  364.     Dim lDelta As Long, lKeys As egscMouseKeys
  365.     
  366.     Select Case uMsg
  367.         Case gscWMMouseWheel
  368.             'Get the coordinates relative to the *Screen* (not relative to this control or its owner).
  369.             lX = GetLoWord(lParam): lY = GetHiWord(lParam)
  370.             'We need the delta value signed.
  371.             lDelta = (wParam And &HFFFF0000) \ &H10000
  372.             lKeys = GetLoWord(wParam)
  373.             'Owner handles this event.
  374.             RaiseEvent MouseWheel(hWnd, lX, lY, lDelta, lKeys)
  375.             lHandled = True
  376.             lReturn = 0
  377.         Case gscWMHScroll
  378.             'Horizontal scrollbar messages
  379.             ProcessScrollBar egscSBOHorizontal, GetLoWord(wParam), GetHiWord(wParam)
  380.             lHandled = True
  381.             lReturn = 0
  382.         Case gscWMVScroll
  383.             'Vertical scrollbar messages
  384.             ProcessScrollBar egscSBOVertical, GetLoWord(wParam), GetHiWord(wParam)
  385.             lHandled = True
  386.             lReturn = 0
  387.     End Select
  388. End Sub
  389.  
  390.  
  391.  
  392. 'PUBLIC PROPERTIES
  393. '-----------------
  394.  
  395. 'Returns the work area (picture box) to the client for direct drawing.
  396. Public Property Get WorkArea() As Object
  397.     Set WorkArea = picWorkArea
  398. End Property
  399.  
  400. 'Assign the type of scrollbar(s) to be displayed, read what type(s) were assigned.
  401. Public Property Let ActiveScrollbars(BarsToDisplay As egscSBDefinition)
  402.     glSBDefinition = BarsToDisplay
  403. End Property
  404. Public Property Get ActiveScrollbars() As egscSBDefinition
  405.     ActiveScrollbars = glSBDefinition
  406. End Property
  407.  
  408. 'Assign/Read the scrollbar property Min/Max/Value/LargeChange/SmallChange for one
  409. 'of the two scrollbars (horizontal or vertical).
  410. Public Property Let LargeChange(Scrollbar As egscSBOrientation, NewValue As Long)
  411.     grScrollInfo(Scrollbar).Page = NewValue
  412. End Property
  413. Public Property Get LargeChange(Scrollbar As egscSBOrientation) As Long
  414.     LargeChange = grScrollInfo(Scrollbar).Page
  415. End Property
  416.  
  417. '(A "small change" is not realized via the structure. Still, we can't assume "1"
  418. 'all the time, that depends on the clients implementation. Thus, we store that
  419. 'value in a global variable.)
  420. Public Property Let SmallChange(Scrollbar As egscSBOrientation, NewValue As Long)
  421.     glSmallChange(Scrollbar) = NewValue
  422. End Property
  423. Public Property Get SmallChange(Scrollbar As egscSBOrientation) As Long
  424.     SmallChange = glSmallChange(Scrollbar)
  425. End Property
  426.  
  427. Public Property Let Max(Scrollbar As egscSBOrientation, NewMaximum As Long)
  428.     grScrollInfo(Scrollbar).Max = NewMaximum
  429. End Property
  430. Public Property Get Max(Scrollbar As egscSBOrientation) As Long
  431.     Max = grScrollInfo(Scrollbar).Max
  432. End Property
  433.  
  434. Public Property Let Min(Scrollbar As egscSBOrientation, NewMinimum As Long)
  435.     grScrollInfo(Scrollbar).Min = NewMinimum
  436. End Property
  437. Public Property Get Min(Scrollbar As egscSBOrientation) As Long
  438.     Min = grScrollInfo(Scrollbar).Min
  439. End Property
  440.  
  441. Public Property Let Value(Scrollbar As egscSBOrientation, NewValue As Long)
  442.     grScrollInfo(Scrollbar).Pos = NewValue
  443. End Property
  444. Public Property Get Value(Scrollbar As egscSBOrientation) As Long
  445.     Value = grScrollInfo(Scrollbar).Pos
  446. End Property
  447.  
  448. 'Retrieving the work area dimensions (read only)
  449. Public Property Get ScaleHeight() As Long
  450.     ScaleHeight = UserControl.ScaleHeight
  451. End Property
  452. Public Property Get ScaleWidth() As Long
  453.     ScaleWidth = UserControl.ScaleWidth
  454. End Property
  455.  
  456.  
  457.  
  458. 'PUBLIC METHODS
  459. '--------------
  460.  
  461. 'Communicating the desired settings (Min, Max, Value, LargeChange) to Windows.
  462. Public Sub SetScrollbar(Scrollbar As egscSBOrientation)
  463.     SetScrollInfo hWnd, Scrollbar, grScrollInfo(Scrollbar), True
  464. End Sub
  465.  
  466. 'Showing the scrollbars as defined in "ActiveScrollbars".
  467. Public Sub ShowScrollbars()
  468.     ShowScrollBar hWnd, glSBDefinition, True
  469. End Sub
  470.  
  471. 'Hide the scrollbars as defined in "ActiveScrollbars".
  472. Public Sub HideScrollbars()
  473.     ShowScrollBar hWnd, glSBDefinition, False
  474. End Sub
  475.  
  476. 'It is possible to tell the control to trigger any event to the owner. Use this instead
  477. 'of setting a position with the "Value" property, when your client performs value manipulation
  478. 'in order to ensure a dedicated position.
  479. Public Sub LineDown(Scrollbar As egscSBOrientation)
  480.     ProcessScrollBar Scrollbar, egscSBNLineDown, glSmallChange(Scrollbar)
  481. End Sub
  482. Public Sub LineUp(Scrollbar As egscSBOrientation)
  483.     ProcessScrollBar Scrollbar, egscSBNLineUp, glSmallChange(Scrollbar)
  484. End Sub
  485.  
  486.  
  487.  
  488. 'PRIVATE METHODS
  489. '---------------
  490. 'Processing a scrollbar notification. Called by InterceptedWinMsg for either of
  491. 'the two scrollbar orientations (Scrollbar tells for which).
  492. Private Sub ProcessScrollBar(Scrollbar As egscSBOrientation, _
  493.     Notification As egscSBNotification, nPos As Long)
  494.     
  495.     Dim lValue As Long
  496.     Dim lChangeValue As Long            'This is user-modifiable on page/line up/down
  497.     Dim eMask As egscScrollInfoMask
  498.     Dim lEffMax As Long
  499.     
  500.     With grScrollInfo(Scrollbar)
  501.         'The other notifications all change the position (the 'value').
  502.         Select Case Notification
  503.             Case egscSBNThumbTrack, egscSBNThumbPosition
  504.                 'Usual 16-bit technique:
  505.                 '    'Set scroll value to track position. Here, the scroll position
  506.                 '    'is provided in nPos (ex the Hi Word of wParam).
  507.                 '    lValue = nPos
  508.                 'Circumventing the usual 16 bit value and getting the 32 bit value.
  509.                 '   Microsoft states: "The GetScrollInfo function enables applications to use
  510.                 '   32-bit scroll positions. Although the messages that indicate scroll-bar position,
  511.                 '   WM_HSCROLL and WM_VSCROLL, provide only 16 bits of position data, the functions
  512.                 '   SetScrollInfo and GetScrollInfo provide 32 bits of scroll-bar position data.
  513.                 '   Thus, an application can call GetScrollInfo while processing either the WM_HSCROLL or
  514.                 '   WM_VSCROLL messages to obtain 32-bit scroll-bar position data."
  515.                 '   (To not to destroy the data in the usual ScrollInfo structures, we use the separate
  516.                 '   structure variable "grScrollInfoTrack()" instead of "grScrollInfo()".)
  517.                 ZeroMemory ByVal VarPtr(grScrollInfoTrack(Scrollbar)), cSizeofScrollInfo
  518.                 grScrollInfoTrack(Scrollbar).Size = cSizeofScrollInfo
  519.                 grScrollInfoTrack(Scrollbar).Mask = egscSIMTrackPos
  520.                 GetScrollInfo hWnd, Scrollbar, grScrollInfoTrack(Scrollbar)
  521.                 'The function returns the tracking position of the scroll box in the nTrackPos member
  522.                 'of the SCROLLINFO structure.
  523.                 lValue = grScrollInfoTrack(Scrollbar).TrackPos
  524.                 
  525.                 'The event *suggests* a final position. This can be changed by
  526.                 'the client's event procedure (for example to force a start at
  527.                 'the beginning of rows/columns in grids etc.)
  528.                 If Scrollbar = egscSBOVertical Then
  529.                     RaiseEvent VScroll(lValue)
  530.                 Else
  531.                     RaiseEvent HScroll(lValue)
  532.                 End If
  533. 'To deactivate if not of use:
  534. 'lValue = .Pos
  535.             Case egscSBNLineUp      'also egswSBNLineLeft
  536.                 'Set scroll value to value - SmallChange
  537.                 lChangeValue = glSmallChange(Scrollbar)
  538.                 'Events enabling the client to correct the suggested value
  539.                 '(User can change lChangeValue).
  540.                 If Scrollbar = egscSBOVertical Then
  541.                     RaiseEvent LineUp(lChangeValue)
  542.                 Else
  543.                     RaiseEvent PosLeft(lChangeValue)
  544.                 End If
  545.                 lValue = .Pos - lChangeValue    'Default is 1
  546.                 If lValue < .Min Then lValue = .Min
  547.             Case egscSBNLineDown    'also egswSBNLineRight
  548.                 'Set scroll value to value + SmallChange
  549.                 lChangeValue = glSmallChange(Scrollbar)
  550.                 'Events enabling the client to correct the suggested value
  551.                 '(User can change lChangeValue).
  552.                 If Scrollbar = egscSBOVertical Then
  553.                     RaiseEvent LineDown(lChangeValue)
  554.                 Else
  555.                     RaiseEvent PosRight(lChangeValue)
  556.                 End If
  557.                 lValue = .Pos + lChangeValue    'Default is 1
  558.                 lEffMax = .Max - .Page + 1&
  559.                 If lValue > lEffMax Then lValue = lEffMax
  560.             Case egscSBNPageUp      'also egswSBNPageLeft
  561.                 'Set scroll value to value - LargeChange
  562.                 lChangeValue = .Page
  563.                 'Events enabling the client to correct the suggested value
  564.                 '(User can change lChangeValue).
  565.                 If Scrollbar = egscSBOVertical Then
  566.                     RaiseEvent PageUp(lChangeValue)
  567.                 Else
  568.                     RaiseEvent PageLeft(lChangeValue)
  569.                 End If
  570.                 lValue = .Pos - lChangeValue
  571.                 If lValue < .Min Then lValue = .Min
  572.             Case egscSBNPageDown    'also egswSBNPageRight
  573.                 'Set scroll value to value + LargeChange
  574.                 lChangeValue = .Page
  575.                 'Events enabling the client to correct the suggested value
  576.                 '(User can change lChangeValue).
  577.                 If Scrollbar = egscSBOVertical Then
  578.                     RaiseEvent PageDown(lChangeValue)
  579.                 Else
  580.                     RaiseEvent PageRight(lChangeValue)
  581.                 End If
  582.                 lValue = .Pos + lChangeValue
  583.                 lEffMax = .Max - .Page + 1&
  584.                 If lValue > lEffMax Then lValue = lEffMax
  585.             Case egscSBNTop         'also egswSBNLeft
  586.                 'Set scroll value to min
  587.                 lValue = .Min
  588.             Case egscSBNBottom      'also egswSBNRight
  589.                 'Set scroll value to max
  590.                 lValue = .Max
  591.         End Select
  592.         
  593.         'Provide the new values for Windows (not for egswSBNEndScroll)
  594.         If Notification <> egscSBNEndScroll Then
  595.             .Pos = lValue
  596.             grScrollInfo(Scrollbar).Mask = egscSIMAll
  597.             SetScrollbar Scrollbar
  598.         End If
  599.         
  600.         '"glLastEventValue" holds the last value for which a "Change" event was
  601.         'raised. A new event is raised only when it differs from the last event.
  602.         'If you don't want hot tracking, use "egswSBNEndScroll" to raise a "Change"
  603.         'event and "egswSBNThumbTrack" to raise a "Scroll" event.
  604.         If glLastEventValue(Scrollbar) <> .Pos Then
  605.             RaiseEvent Change(Scrollbar, .Pos)
  606.             glLastEventValue(Scrollbar) = .Pos
  607.         End If
  608.     End With
  609. End Sub
  610.  
  611. 'Extracting the High Word of a DWord.
  612. Private Function GetHiWord(ByVal DWord As Long) As Long
  613.     GetHiWord = (DWord And &HFFFF0000) \ &H10000
  614.     If GetHiWord < 0& Then GetHiWord = GetHiWord + 65536
  615. End Function
  616.  
  617. 'Extracting the Low Word of a DWord.
  618. Private Function GetLoWord(ByVal DWord As Long) As Long
  619.     DWord = DWord And &HFFFF&
  620.     If DWord > 32767 Then GetLoWord = DWord - 65536 Else GetLoWord = DWord
  621. End Function
  622.  
  623.  
  624.