[VBnet Callbacks] SendMessage: Controlling a ListView Sort Using Callbacks

	Visual Basic Callbacks SendMessage: Controlling a ListView Sort Using Callbacks

Posted:	Saturday September 6, 1997
Updated:	Monday December 26, 2011

Applies to:	VB5, VB6
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	MSDN, VBnet - Randy Birch

Prerequisites

This code works with both the VB6 mscomctl.ocx and VB5 comctl32.dll controls. When using the VB5 control, enhanced Comctl32 functionality is only available to users with comctl32.dll version 4.70 or greater installed. This dll is typically installed with IE3.x or greater.

Sorting numeric values with the ListView control's built-in sort mechanism has always left much to be desired. Because the ListView stores the item and SubItem data as strings, the default sorting algorithm sorted numbers in string format. This meant that instead of a sort of 1, 2, 3, 20, 35, the ListView sorted as 1, 2, 20, 3, 35.

Beginning with VB5, the AddressOf operator allows Visual Basic applications access to Windows callback functionality without the need for third-party message interceptors or subclassing agents.

By using AddressOf, SendMessage and some of the ListView API's data structures and messages, we have the ability to create routines providing customized and proper sorting based on the type of data in a given ListView item or SubItem column. This exercise creates such a ListView, populate it with strings, dates and values, and sort each correctly based on the data type in the column. Once the basic principles are grasped, the mechanism to perform this type of sort can be moved into virtually any ListView application, or extended to include currency or other formatted data types.

This demo is based, in part, on a MS Knowledge Base article discussing callbacks and sorting dates. However, instead of using the VB's VarPtr() function I've modified the routines to use the standard API data types associated with the ListView API. Those wanting further info on the VarPtr() method should search the Knowledge Base for article Q170884.

The code below contains all the requirements to construct the illustration as shown. Configuration of the ListView's report view and columns/data-creation is done through code.

BAS Module Code

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
  
'variable to hold the sort order (ascending or descending)
Public sOrder As Boolean

Public Type POINTAPI
  x As Long
  y As Long
End Type

Public Type LV_FINDINFO
  flags As Long
  psz As String
  lParam As Long
  pt As POINTAPI
  vkDirection As Long
End Type

Public 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
 
'Constants
Public Const LVFI_PARAM As Long = &H1
Public Const LVIF_TEXT As Long = &H1

Public Const LVM_FIRST As Long = &H1000
Public Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Public Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Public Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
     
'API declarations
Public 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 CompareDates(ByVal lParam1 As Long, _
                             ByVal lParam2 As Long, _
                             ByVal hWnd As Long) As Long
     
  'CompareDates: This is the sorting routine that gets passed to the
  'ListView control to provide the comparison test for date values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than

   Dim dDate1 As Date
   Dim dDate2 As Date
     
  'Obtain the item names and dates corresponding to the
  'input parameters     
   dDate1 = ListView_GetItemDate(hWnd,lParam1)
   dDate2 = ListView_GetItemDate(hWnd,lParam2)
     
  'based on the Public variable sOrder set in the
  'ColumnHeader click sub, sort the dates appropriately:     
   Select Case sOrder
      Case True 'sort descending
            
            If dDate1 < dDate2 Then
               CompareDates = 0
            ElseIf dDate1 = dDate2 Then
               CompareDates = 1
            Else 
               CompareDates = 2
            End If
      
      Case Else 'sort ascending
   
            If dDate1 > dDate2 Then
               CompareDates = 0
            ElseIf dDate1 = dDate2 Then
               CompareDates = 1
            Else
               CompareDates = 2
            End If
   
   End Select

End Function


Public Function CompareValues(ByVal lParam1 As Long, _
                              ByVal lParam2 As Long, _
                              ByVal hWnd As Long) As Long
     
  'CompareValues: This is the sorting routine that gets passed to the
  'ListView control to provide the comparison test for numeric values.

  'Compare returns:
  ' 0 = Less Than
  ' 1 = Equal
  ' 2 = Greater Than     
  
   Dim val1 As Long
   Dim val2 As Long
     
  'Obtain the item names and values corresponding
  'to the input parameters     
   val1 = ListView_GetItemValueStr(hWnd, lParam1)
   val2 = ListView_GetItemValueStr(hWnd, lParam2)
     
  'based on the Public variable sOrder set in the
  'columnheader click sub, sort the values appropriately:     
   Select Case sOrder
      Case True 'sort descending
            
            If val1 < val2 Then
               CompareValues = 0
            ElseIf val1 = val2 Then
               CompareValues = 1
            Else
               CompareValues = 2
            End If
      
      Case Else 'sort ascending
   
            If val1 > val2 Then
               CompareValues = 0
            ElseIf val1 = val2 Then
               CompareValues = 1
            Else
               CompareValues = 2
            End If
   
   End Select

End Function


Public Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
  
   Dim hIndex As Long
   Dim r as Long
  
  'Convert the input parameter to an index in the list view     
   objFind.flags = LVFI_PARAM
   objFind.lParam = lParam
   hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
     
  'Obtain the value of the specified list view item.
  'The objItem.iSubItem member is set to the index
  'of the column that is being retrieved.     
   objItem.mask = LVIF_TEXT
   objItem.iSubItem = 1
   objItem.pszText = Space$(32)
   objItem.cchTextMax = Len(objItem.pszText)
     
  'get the string at subitem 1         
  'and convert it into a date and exit     
   r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
   If r > 0 Then
      ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
   End If
  
  
End Function


Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long

   Dim hIndex As Long
   Dim r As Long
  
  'Convert the input parameter to an index in the list view     
   objFind.flags = LVFI_PARAM
   objFind.lParam = lParam
   hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
     
  'Obtain the value of the specified list view item.
  'The objItem.iSubItem member is set to the index
  'of the column that is being retrieved.     
   objItem.mask = LVIF_TEXT
   objItem.iSubItem = 2
   objItem.pszText = Space$(32)
   objItem.cchTextMax = Len(objItem.pszText)
     
  'get the string at subitem 2     
  'and convert it into a long     
   r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
   If r > 0 Then
      ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
   End If

End Function


Public Function FARPROC(ByVal pfn As Long) As Long
  
  'A procedure that receives and returns
  'the value of the AddressOf operator.
  'This workaround is needed as you can't assign
  'AddressOf directly to an API when you are also
  'passing the value ByVal in the statement
  '(as is being done with SendMessage)
 
  FARPROC = pfn

End Function

Form Code

You will need three command buttons (Command1-Command3), a listview (Listview1) and a picturebox (used to display the printout shown in the illustration.) To this form, add the following code:

Option Explicit

Private Sub Form_Load()

   Dim itmX As ListItem
     
  'Add three Column Headers to the control     
   ListView1.ColumnHeaders.Add ,, "Name"
   ListView1.ColumnHeaders.Add ,, Text:="Date"
   ListView1.ColumnHeaders.Add ,, "Value"
     
  'Set the ListView to Report view   
   ListView1.View = lvwReport
     
  'Add some data to the ListView control     
   Set itmX = ListView1.ListItems.Add(Text:="Joe")
   itmX.SubItems(1) = "05/07/97"
   itmX.SubItems(2) = "44"

   Set itmX = ListView1.ListItems.Add(Text:="Sally")
   itmX.SubItems(1) = "04/08/93"
   itmX.SubItems(2) = "16"

   Set itmX = ListView1.ListItems.Add(Text:="Bill")
   itmX.SubItems(1) = "05/29/94"
   itmX.SubItems(2) = "1"

   Set itmX = ListView1.ListItems.Add(Text:="Fred")
   itmX.SubItems(1) = "03/17/95"
   itmX.SubItems(2) = "215"

   Set itmX = ListView1.ListItems.Add(Text:="Anne")
   itmX.SubItems(1) = "07/01/97"
   itmX.SubItems(2) = "20"

   Set itmX = ListView1.ListItems.Add(Text:="Bob")
   itmX.SubItems(1) = "04/01/91"
   itmX.SubItems(2) = "21"

   Set itmX = ListView1.ListItems.Add(Text:="John")
   itmX.SubItems(1) = "12/25/92"
   itmX.SubItems(2) = "176"

   Set itmX = ListView1.ListItems.Add(Text:="Paul")
   itmX.SubItems(1) = "11/23/95"
   itmX.SubItems(2) = "113"

   Set itmX = ListView1.ListItems.Add(Text:="Maria")
   itmX.SubItems(1) = "02/01/96"
   itmX.SubItems(2) = "567"
   
   Command1.Caption = "via API"
   Command2.Caption = "via Collection"  
   Command3.Caption = "Quit"   

End Sub


Private Sub Command2_Click()

   Dim hIndex As Long
   Dim hItem As Long
  
   Picture1.Cls
        
  'loop trough the ListItems collection
   For hIndex = 1 To ListView1.ListItems.Count
     
    '(note the trailing comma) 
     Picture1.Print ListView1.ListItems.Item(hIndex).Text,
       
     'For each item in the collection, loop through the subitems
     '(note the trailing comma)
      For hItem = 1 To 2
      
         Picture1.Print ListView1.ListItems.Item(hIndex).SubItems(hItem),
      
      Next hItem
       
     'print the index
      Picture1.Print hIndex
   
   Next hIndex
   
End Sub


Private Sub Command1_Click()

   Dim hIndex As Long
   Dim hItem As Long
   Dim sItem As String
   Dim r As Long
  
   Picture1.Cls
        
  'loop trough the ListItems collection     
   For hIndex = 0 To ListView1.ListItems.Count - 1
               
     'For each item in the collection, loop through the subitems.
     'Setting subitem to 0 retrieves the main listview item value.     
      For hItem = 0 To 2
           
        'initialize the LV_ITEM type     
         With objItem
            .mask = LVIF_TEXT
            .iSubItem = hItem
            .pszText = Space$(32)
            .cchTextMax = Len(.pszText)
         End With
              
        'get the value of the item corresponding
        'to the index and item numbers     
         r = SendMessage(ListView1.hWnd, LVM_GETITEMTEXT, hIndex, objItem)
              
        'and trim the item     
         sItem = Left$(objItem.pszText, r)
           
        'print the item with a tab (note the trailing comma)     
         Picture1.Print sItem,
      
      Next hItem
           
     'print the index
      Picture1.Print hIndex
   
   Next hIndex
   
End Sub


Private Sub Command3_Click()

   Unload Me
   
End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
     
  'toggle the sort order for use in the CompareXX routines    
   sOrder = Not sOrder
    
   ListView1.SortKey = ColumnHeader.Index - 1
   
   Select Case ColumnHeader.Index - 1
      Case 0:    
              'Use default sorting to sort the items in the list     
               ListView1.SortKey = 0
               ListView1.SortOrder = Abs(sOrder) '=Abs(Not ListView1.SortOrder = 1)
               ListView1.Sorted = True
      
      Case 1:    
              'Use sort routine to sort by date     
               ListView1.Sorted = False
               SendMessage ListView1.hWnd, _
                           LVM_SORTITEMS, _
                           ListView1.hWnd, _
                           ByVal FARPROC(AddressOf CompareDates)
                   
      Case 2:    
              'Use sort routine to sort by value     
               ListView1.Sorted = False
               SendMessage ListView1.hWnd, _
                           LVM_SORTITEMS, _
                           ListView1.hWnd, _
                           ByVal FARPROC(AddressOf CompareValues)
               
   End Select
   
End Sub

Comments

Save and run the project. The ListView will be populated with the data shown in the illustration.

Clicking the "Name" column header will invoke the control's default string-sorting routine. Clicking either of the "Date" or "Value" headers will invoke the callback routines. Repeated clicking will toggle the sort between ascending and descending.

The two command buttons print out the list items to demonstrate a serious point. When using the intrinsic (default) sort (no callbacks), both the visual representation of data and the control's underlying ListItem collection remain in sync after sorting.

However, when the list has been sorted using callbacks, the underlying collection (which has not been sorted by the API) and the visual display of the items (which has) become out-of-sync. When using callbacks the sorting occurs only for the visual elements of the control; the underlying ListItem collection remains in its last-sorted order. Therefore, to accurately retrieve data (i.e. a via a user's selection) when the list has been sorted using a callback, the API-method of obtaining the selected list item must be employed.

To sort decimal numbers, change the Dim'med variable type for val1 and val2 to "As Single" in the CompareValues method.

PayPal Link