Just paste this source code into a module called basListView and include it in your project.
'----------------------------------------------------------------------
'
' Module Name: basListView
' Written By: C&D Programming Corp.
' Create Date: 7/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
' This module allows sorting by data types other than text in the ListView
' control. It only allows for sorting on subitems in the control. It does
' not currently support sorting for the primary text field in the ListItems
' collection.
'
'
' Structures required to work with the ListView control
'
Public Type POINT
x As Long
y As Long
End Type
Public Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINT
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 Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
'Constants
Private Const LVFI_PARAM = 1
Private Const LVIF_TEXT = &H1
Private Const LVM_FIRST = &H1000
Private Const LVM_FINDITEM = LVM_FIRST + 13
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48
'
' API declarations for sending messages to the ListView Control
'
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public SortColumn As Long ' The column we are going to sort on
'CompareLongs: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for Long values.
Public Function CompareLongs(ByVal lngParam1 As Long, _
ByVal lngParam2 As Long, _
ByVal hWnd As Long) As Long
Dim lValue1 As Long
Dim lValue2 As Long
'Obtain the values corresponding to the input parameters
GetItemData lngParam1, hWnd, lValue1
GetItemData lngParam2, hWnd, lValue2
'Compare the values
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
If lValue1 < lValue2 Then
CompareLongs = 0
ElseIf lValue1 = lValue2 Then
CompareLongs = 1
Else
CompareLongs = 2
End If
End Function
'CompareDates: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.
Public Function CompareDates(ByVal lngParam1 As Long, _
ByVal lngParam2 As Long, _
ByVal hWnd As Long) As Long
Dim dDate1 As Date
Dim dDate2 As Date
'Obtain the dates corresponding to the input parameters
GetItemData lngParam1, hWnd, dDate1
GetItemData lngParam2, hWnd, dDate2
'Compare the values
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
If dDate1 < dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else
CompareDates = 2
End If
End Function
' GetItemData - Retrieves the data for an item specified by it
' index value.
Private Sub GetItemData(lngParam As Long, _
hWnd As Long, _
vValue As Variant)
Dim objFind As LV_FINDINFO
Dim lIndex As Long
Dim objItem As LV_ITEM
Dim baSortKey(64) As Byte
Dim lReturnLength As Long
'
' Convert the input parameter to an index in the list view
'
objFind.flags = LVFI_PARAM
objFind.lParam = lngParam
lIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))
'
' Obtain the data from the specified column
'
objItem.mask = LVIF_TEXT
objItem.iSubItem = SortColumn
objItem.pszText = VarPtr(baSortKey(0))
objItem.cchTextMax = 64 'UBound(baSortKey)
lReturnLength = SendMessage(hWnd, LVM_GETITEMTEXT, lIndex, _
VarPtr(objItem))
On Error GoTo BadValues
If lReturnLength > 0 Then
Select Case TypeName(vValue)
Case "Date"
vValue = CDate(Left$(StrConv(baSortKey, vbUnicode), lReturnLength))
Case "Long"
vValue = CLng(Left$(StrConv(baSortKey, vbUnicode), lReturnLength))
End Select
End If
Exit Sub
BadValues:
vValue = 0 ' if we have a bad value, let's just default it to zero.
Resume Next
End Sub