VB6 ListView Scroll Events

Example #1

You need to subclass your window to catch the WM_VSCROLL message (for vertical scrollbars) or WM_HSCROLL message (for horizontal scrollbars)

Here's an example.

Add to a Module.

Code:

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As LongDeclare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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 LongConst GWL_WNDPROC = (-4) Private Const WM_VSCROLL = &H115 Private Const WM_HSCROLL = &H114 Global WndProcOld As LongPublic Function WindProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If wMsg = WM_VSCROLL Then Form1.Print "Scrolling" WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, wParam&, lParam&) End FunctionSub SubClassWnd(hwnd As Long) WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindProc) End SubSub UnSubclassWnd(hwnd As Long) SetWindowLong hwnd, GWL_WNDPROC, WndProcOld& WndProcOld& = 0 End Sub

Add to a Form

Code:

Private Sub Form_Load() SubClassWnd ListView1.hwnd End SubPrivate Sub Form_Unload(Cancel As Integer) UnSubclassWnd ListView1.hwnd End Sub

Example #2:

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.

Example #3

You might think all there is to scrolling a Listview would be the .EnsureVisible Property, yes? Unfortunately, that is only part of the equation. .EnsureVisible does not care how visible the item is, as long as it's 'visible', and treats the column headers as visible. It also does not change the focus rectangle, which is important.

It's overall general sloppyness prompted me to construct this function that will attempt to set the highlighted item three lines down from the column headers, or as close as possible in the event the index is at the beginning or the end of the Listview. If the item is already in view, but not selected, it is merely selected without the need to move the listing.

This function clears the selected items prior to highlighting the index of choice.

Usage

The function's name is SetItemFocusA. It has 3 parameters:

Code:

Public Function SetItemFocusA(ByRef ctlListview As MSComctlLib.ListView, ByVal iIndex As Long, Optional ByVal iVisibleIndex = 3) As Boolean

ctlListview - This is the listview object. ex: Listview1
iIndex - The item's index you want highlighted.
[iVisibleIndex] - How far down the list to center the target item. The default places the targeted item as the third visible item.

The required code in it's entirety is listed below. Simply drop it into a module, and call the function. Included is a sample project with the code in a module.

Code:

Private Type LV_ITEM

Mask As Long

iItem As Long

iSubItem As Long

State As Long

stateMask As Long

pszText As String

cchTextMax As Long

iImage As Long

lParam As Long

iIndent As Long

End Type

Private Const LVM_FIRST As Long = &H1000

Private Const LVM_GETTOPINDEX As Long = (LVM_FIRST + 39)

Private Const LVM_GETCOUNTPERPAGE As Long = (LVM_FIRST + 40)

Private Const LVM_SETITEMSTATE As Long = (LVM_FIRST + 43)

Private Const LVIS_FOCUSED As Long = &H1

Private Const LVIS_SELECTED As Long = &H2

Private Const LVIF_STATE As Long = &H8

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

Public Function SetItemFocusA(ByRef ctlListview As MSComctlLib.ListView, ByVal iIndex As Long, Optional ByVal iVisibleIndex = 3) As Boolean

On Error GoTo Hell

Dim LV As LV_ITEM

Dim lvItemsPerPage As Long

Dim lvNeededItems As Long

Dim lvCurrentTopIndex As Long

With ctlListview

' Since this is a multi-select list, we want to unselect all items before selecting the current track.

With LV

.Mask = LVIF_STATE

.State = False

.stateMask = LVIS_SELECTED

End With

Call SendMessage(.hWnd, LVM_SETITEMSTATE, -1, LV) ' Poof

' Select and set the focus rectangle on the item.

With LV

.Mask = LVIF_STATE

.State = True

.stateMask = LVIS_SELECTED Or LVIS_FOCUSED

End With

Call SendMessage(.hWnd, LVM_SETITEMSTATE, iIndex - 1, LV) ' Listview index is 0-based in the API world

' Determine if desired index + number of items in view will exceed total items in the control

lvCurrentTopIndex = SendMessage(.hWnd, LVM_GETTOPINDEX, 0&, ByVal 0&)

lvItemsPerPage = SendMessage(.hWnd, LVM_GETCOUNTPERPAGE, 0&, ByVal 0&)

' Do we even need to scroll? Not if the selected track is already in view

If (lvCurrentTopIndex >= iIndex) Or (iIndex > lvCurrentTopIndex + lvItemsPerPage) Then

' Is 'x' above or below target index?

If lvCurrentTopIndex >= iIndex Then ' Going UP

If iIndex > iVisibleIndex Then

.ListItems((iIndex - iVisibleIndex + 1)).EnsureVisible ' Drops the highlighted item down a few so it's not hidden

' behind the Column header.

Else

.ListItems((iIndex)).EnsureVisible

End If

Else ' Going DOWN

' Are there sufficient items to set to the topindex

If (iIndex + lvItemsPerPage) > .ListItems.Count Then

' Can't be set to the top as the control has insufficient

' items, so just scroll to the end of listview

.ListItems(.ListItems.Count).EnsureVisible

Else

' It is below, and since a listview always moves the item just into view,

' have it instead move to the top by faking item we want to 'EnsureVisible'

' the item lvItemsPerPage -1(or -3) below the actual index of interest.

If iIndex > iVisibleIndex Then

.ListItems((iIndex + lvItemsPerPage) - iVisibleIndex).EnsureVisible

Else

.ListItems((iIndex + lvItemsPerPage) - 1).EnsureVisible

End If

End With

SetItemFocusA = True

Hell:

End Function

Revision History:

06-12-2005 - Added a parameter to allow control over how many items are visible above the target item. Also created better demo project.

Attachment last updated: 10/27/2007

___________________________

Dave Applegate

Microsoft VB MVP, ACE [FAQs]