[VBnet Subclassing] WM_VSCROLL: Subclassing Listview Scrollbar Messages


	Visual Basic Subclassing Routines WM_VSCROLL: Subclassing Listview Scrollbar Messages

Posted:	Tuesday August 29, 2000
Updated:	Monday December 26, 2011

Applies to:	VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	VBnet - Randy Birch

Prerequisites

VB5 or VB6. This code was developed using the VB6 mscomctl.ocx ListView. It should function against the VB5 ListView control as well.

When it is necessary for your app to maintain synchronization between two or more Listview controls - or two or more List boxes for that matter - as the user interacts with the primary control's scrollbar, subclassing must be used in order to track the user's interaction and reflect that action in the other control(s).

This demo shows the minimum code you need to safely subclass a ListView control and, as the user manipulates the vertical scrollbar of ListView1, cause the same scrolling actions in the ListView2 control. Only Listview1 is actually subclassed - Listview2 simply receives normal SendMessage messages and processes them intrinsically without further intervention or code.

Despite the mass of code below the actual code to do this is a one-liner within the subclassing WindowProc - a simple SendMessage call passing WM_VSCROLL with the type of scrolling action to perform as the wParam message (a single line up or down, a page up or down, or thumb tracking).

Normally, were this method being employed to echo changes in a standard Windows' scrollbar the lParam parameter of the WindowProc procedure would receive the hwnd of the scrollbar being manipulated. But since ListView2's scrollbar is a child window of the listview control, lParam is not used.

The listview control API also has its own scroll message - LVM_SCROLL - which is also fired in response to a scrollbar action. However this message is useless to us as it is targeted more for the large and small icon views of the control. In those views, to scroll a ListView using LVM_SCROLL in a SendMessage call you specify the number of pixels to scroll, not the number of lines or pages. To scroll using LVM_SCROLL in Report view, you specify the line height in pixels. In report view, if the value to scroll exceeds a line height in pixels two lines or more will scroll. If the value is too small, then no scrolling occurs. Because of this, using the standard windows message is easier than using the listview message in report view.

Also included in the subclassing code below are some additional API methods that are not required for the procedure to work, but which demonstrate how to receive (and set) scrollbar information using GetScrollbarInfo and SetScrollbarInfo. Also shown are messages that could be used to change the action performed so that the mirrored control reacts differently than the subclassed control. And finally, just for fun, the code also demonstrates how to use subclassing to scroll the mirrored control, but negate the actual scrolling of the subclassed control. While not especially useful, it demonstrates how to trap and kill a scroll message.

Not covered in this demo is maintaining the mirrored ListView's top index when the keyboard is used to scroll the subclassed control's contents.

Subclassing is provided via Karl Peterson's HookMe subclassing method. Remember you can't hit the VB Stop button when subclassed -- use the Done or 'X' button instead to invoke the Unload code.

BAS Module 1 Code: lvheader.bas

Place the following code into the general declarations area of a bas module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'listview, header
Public Const ICC_LISTVIEW_CLASSES  As Long = &H1

Public Type tagINITCOMMONCONTROLSEX  'icc
   dwSize As Long                    'size of this structure
   dwICC As Long                     'which classes to be initialized
End Type

Public Declare Sub InitCommonControls Lib "comctl32.dll" ()

Public Declare Function InitCommonControlsEx Lib "comctl32.dll" _
   (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean


'Returns True if the current working version of Comctl32.dll
'supports IE3 styles & msgs. Returns False if old version.
'Also ensures that the Comctl32.dll library is loaded for use.
Public Function IsNewComctl32(dwFlags As Long) As Boolean

   Dim icc As tagINITCOMMONCONTROLSEX
   
   On Error GoTo Err_InitOldVersion
   
   icc.dwSize = Len(icc)
   icc.dwICC = dwFlags
   
   'VB will generate error 453 "Specified DLL function not found"
   'here if the new version isn't installed.
   IsNewComctl32 = InitCommonControlsEx(icc)
   
   Exit Function
   
Err_InitOldVersion:
   
   InitCommonControls
   
End Function

BAS Module 2 Code: HookMe.bas

Place the following code into the general declarations area of a second bas module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'*************************************************************************
' HookMe.bas
' Copyright (C)1997 Karl E. Peterson and Zane Thomas, All Rights Reserved
'
'  Used at VBnet by permission.
'  For the latest version see the Tools section at http://www.mvps.org/vb/
'*************************************************************************
' Warning: This computer program is protected by copyright law and
' international treaties. Unauthorized reproduction or distribution
' of this program, or any portion of it, may result in severe civil
' and criminal penalties, and will be prosecuted to the maximum
' extent possible under the law.
'
'Used at VBnet with permission.
'*************************************************************************
Public Declare Function GetProp Lib "user32" _
   Alias "GetPropA" _
  (ByVal hwnd As Long, ByVal lpString As String) As Long

Public Declare Function CallWindowProc Lib "user32" _
   Alias "CallWindowProcA" _
  (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
   ByVal msg As Long, ByVal wParam As Long, _
   ByVal lParam As Long) As Long

Private Declare Function SetProp Lib "user32" _
   Alias "SetPropA" _
  (ByVal hwnd As Long, ByVal lpString As String, _
   ByVal hData As Long) As Long

Private Declare Function SetWindowLong Lib "user32" _
   Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, _
   ByVal wNewWord As Long) As Long

Private Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, Source As Any, ByVal Length As Long)

Private Const GWL_WNDPROC  As Long = (-4)

Public Function HookFunc(ByVal hwnd As Long, _
                         ByVal msg As Long, _
                         ByVal wp As Long, _
                         ByVal lp As Long) As Long
   
   Dim foo As Long
   Dim obj As frmMain  'MUST be the correct name of the form

   foo = GetProp(hwnd, "ObjectPointer")
   '
   ' Ignore "impossible" bogus case
   '
   If (foo <> 0) Then
      CopyMemory obj, foo, 4
      On Error Resume Next
      HookFunc = obj.WindowProc(hwnd, msg, wp, lp)
      If (Err) Then
         UnhookWindow hwnd
         Debug.Print "Unhook on Error, #"; CStr(Err.Number)
         Debug.Print "  Desc: "; Err.Description
         Debug.Print "  Message, hWnd: &h"; Hex(hwnd), _
                            "Msg: &h"; Hex(msg), _
                            "Params:"; wp; lp
      End If
      '
      ' Make sure we don't get any foo->Release() calls
      '
      foo = 0
      CopyMemory obj, foo, 4
   End If
   
End Function


Public Sub HookWindow(hwnd As Long, thing As Object)
   
   Dim foo As Long

   CopyMemory foo, thing, 4

   Call SetProp(hwnd, "ObjectPointer", foo)
   Call SetProp(hwnd, "OldWindowProc", GetWindowLong(hwnd, GWL_WNDPROC))
   Call SetWindowLong(hwnd, GWL_WNDPROC, AddressOf HookFunc)
   
End Sub


Public Sub UnhookWindow(hwnd As Long)
   
   Dim foo As Long

   foo = GetProp(hwnd, "OldWindowProc")
   If (foo <> 0) Then
      Call SetWindowLong(hwnd, GWL_WNDPROC, foo)
   End If
   
End Sub


Public Function InvokeWindowProc(hwnd As Long, _
                                 msg As Long, _
                                 wp As Long, _
                                 lp As Long) As Long
   
   InvokeWindowProc = CallWindowProc(GetProp(hwnd, "OldWindowProc"), hwnd, msg, wp, lp)
   
End Function

Form Code

Add two Command buttons to the form (Command1 & Command2), as well as a listbox (List1). Add two ListView controls (ListView1 & ListView2). Add some ColumnHeaders to the ListView and set both to report mode. Important - name the form frmMain to match the HookMe code above, and then add the following code:

Option Explicit

Private Const WM_VSCROLL = &H115
Private Const SB_VERT = 1

Private Const SIF_RANGE = &H1
Private Const SIF_PAGE = &H2
Private Const SIF_POS = &H4
Private Const SIF_DISABLENOSCROLL = &H8
Private Const SIF_TRACKPOS = &H10
Private Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_TRACKPOS)

Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
Private Const SB_PAGEUP = 2
Private Const SB_PAGEDOWN = 3
Private Const SB_THUMBPOSITION = 4
Private Const SB_THUMBTRACK = 5
Private Const SB_TOP = 6
Private Const SB_BOTTOM = 7
Private Const SB_ENDSCROLL = 8

Private Type SCROLLINFO
   cbSize As Long
   fMask As Long
   nMin As Long
   nMax As Long
   nPage As Long
   nPos As Long
   nTrackPos As Long
End Type

Private Declare Function GetScrollInfo Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal n As Long, _
   lpScrollInfo As SCROLLINFO) As Long

Private Declare Function SetScrollInfo Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal n As Long, _
   lpcScrollInfo As SCROLLINFO, _
   ByVal fRedraw As Long) As Long

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hWnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long


Private Sub Form_Load()

  'assure the common control library is loaded
   Call IsNewComctl32(ICC_LISTVIEW_CLASSES)

   Dim x As Integer
   
  'Add a few items to the listviews.
  'Nothing pretty or efficient here!
   Do
   
      x = x + 1
      ListView1.ListItems.Add x, , "Item " & CStr(x)
      ListView2.ListItems.Add x, , "Item " & CStr(x)
      
   Loop While x < 50
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   Call UnhookWindow(ListView1.hwnd)

End Sub


Friend Function WindowProc(hwnd As Long, _
                           msg As Long, _
                           wParam As Long, _
                           lParam As Long) As Long
   
'**************************************
'Subclassing
'**************************************
   
  Dim sci As SCROLLINFO

  If hWnd = ListView1.hWnd Then
  
      Select Case msg
            
        'message of interest
         Case WM_VSCROLL
                     
'           '------------------------------------------
'           'this block (between the dashed lines)
'           'demonstrates obtaining scrollbar information
'           'and can actually be commented out without
'           'impacting the method!
'
'           'fill a SCROLLINFO structure to receive
'           'scrollbar data from the subclassed
'           'listview and call the GetScrollInfo API
'            With sci
'               .cbSize = Len(sci)
'               .fMask = SIF_ALL
'            End With
'
'            Call GetScrollInfo(hWnd, SB_VERT, sci)
'
'           'Information only: shows the values
'           'returned by the API as tabbed list items
'            With List1
'               .AddItem sci.nMin & vbTab & _
'                        sci.nMax & vbTab & _
'                        sci.nPage & vbTab & _
'                        sci.nPos & vbTab & _
'                        sci.nTrackPos & vbTab & _
'                        wParam & vbTab & lParam
'               .TopIndex = .NewIndex
'            End With
'
'           'If you wanted to provide any special
'           'capability, ie if a user enacted a line up but
'           'you wanted to translate that into a page down,
'           'etc, you could do that here.
'            Select Case wParam
'               Case SB_LINEUP:         '0
'                 'wParam = SB_LINEDOWN  'tweak the action!
'               Case SB_LINEDOWN:       '1
'               Case SB_PAGEUP:         '2
'               Case SB_PAGEDOWN:       '3
'               Case SB_THUMBPOSITION:  '4
'               Case SB_THUMBTRACK:     '5
'               Case SB_TOP:            '6
'               Case SB_BOTTOM:         '7
'               Case SB_ENDSCROLL:      '8
'            End Select
'
'           'SetScrollInfo sets the target window's
'           'scrollbar's characteristics to match the
'           'source. Where a value is outside a valid
'           'range, (ie if the source returned 100 for
'           'nMax, but the target only had 50 items,
'           'the target will set the nMax number to 50).
'            Call SetScrollInfo(ListView2.hWnd, SB_VERT, sci, 1&)
'           '------------------------------------------

           'The actual scrolling method - a one-liner!
           'On entering this routine, wParam
           'contains one of the SB_xxx messages
           'listed above. By passing it directly
           'to the mirrored listview, the mirror
           'tracks as the subclassed listview
           'is scrolled.
            Call SendMessage(ListView2.hWnd, _
                             WM_VSCROLL, _
                             wParam, _
                             ByVal 0&)
            
           'If you want to disable scrolling in the
           'subclassed listview, but want the mirrored
           'listview to scroll as if its scrollbar had
           'been used, uncomment the two lines below.
'           WindowProc = 0
'           Exit Function
            
         Case Else
      End Select
   
   End If

  'pass on to the default window procedure
   WindowProc = CallWindowProc(GetProp(hWnd, "OldWindowProc"), _
                               hWnd, msg, _
                               wParam, lParam)

End Function


Private Sub Command1_Click()

   Call HookWindow(ListView1.hwnd, Me)
   
   Command1.Caption = "Subclassed!"
   Command1.Enabled = False
   
End Sub


Private Sub Command2_Click()

   Unload Me
   
End Sub

Comments

Run the project, press Comand1, and scroll the subclassed listview. The second listview will mirror the scrollbar action. Scrollbar information from GetScrollbarInfo will be relayed in the listbox if the code between the dashed lines has been uncommented.

Incidentally, this same SendMessage call can also be used to scroll a listview programmatically. To demo this, add a third command button to the form (Command3) with the following:

Private Sub Command3_Click()

   Call SendMessage(ListView1.hwnd, WM_VSCROLL, SB_PAGEDOWN, ByVal 0&)

End Sub

If this code is called when the subclassing above is activated, both listview controls will scroll.

PayPal Link