sombell
asked on
Listview custom sort - ItemClick problem
Hi,
I have encountered a tricky little problem that's got me a bit stumped.
I have a Listview which has two columns, the first containing a name, and the second containing a number.
I've written the _ColumnClick so that the Name column uses the standard ListView sorting, while clicking on the Number column uses my own custom sort routing (so that numbers are sorted 1, 5, 10 and not 1, 10, 5).
This works fine... almost.
Everything looks fine on the screen, scrolling up and down the listview shows me exactly what i expect.
HOWEVER, if you click on an item when the list is sorted by Number, the ITEM parameter passed to the _ItemClick event is NOT the item that was clicked in the listview.
After investigation, this is because the custom sort (invoked with SendMessage LVM_SORTITEMS) does not re-order the listitems collection.
I need to be able to access the correct Item in the _ItemClick event. As far as I can see this means either:
1) Re-order the listitems collection
2) Ignore the item passed to the event and work out for myself which one was clicked & retrieve it using the API
Note that it's not enough to be able to retrieve the text items (.text and .subitems()) data. I need to be able to access the correct listitem object.
Any help and/or suggestions are most welcome.
There is a simple example which illustrates this problem at http://www.mvps.org/vbnet/index.html?code/callback/lvsortcallback.htm
Regards,
Sombell
I have encountered a tricky little problem that's got me a bit stumped.
I have a Listview which has two columns, the first containing a name, and the second containing a number.
I've written the _ColumnClick so that the Name column uses the standard ListView sorting, while clicking on the Number column uses my own custom sort routing (so that numbers are sorted 1, 5, 10 and not 1, 10, 5).
This works fine... almost.
Everything looks fine on the screen, scrolling up and down the listview shows me exactly what i expect.
HOWEVER, if you click on an item when the list is sorted by Number, the ITEM parameter passed to the _ItemClick event is NOT the item that was clicked in the listview.
After investigation, this is because the custom sort (invoked with SendMessage LVM_SORTITEMS) does not re-order the listitems collection.
I need to be able to access the correct Item in the _ItemClick event. As far as I can see this means either:
1) Re-order the listitems collection
2) Ignore the item passed to the event and work out for myself which one was clicked & retrieve it using the API
Note that it's not enough to be able to retrieve the text items (.text and .subitems()) data. I need to be able to access the correct listitem object.
Any help and/or suggestions are most welcome.
There is a simple example which illustrates this problem at http://www.mvps.org/vbnet/index.html?code/callback/lvsortcallback.htm
Regards,
Sombell
Another possible solution, create another column which contains the numbers from your second column prefixed with "0000000" so you get a fixed length value which can be correctly sorted. Set the column width of this to zero and when you get the column click event, sort on the third correctly formatted column rather than the second with the unstuffed numbers in it.
Try this functions
You must use the SortListView function
ListView -> Your listView control to sort
Index -> Index of the column to sort, in the columnheaderclick, you can use ColumnHeader.Index -1
DataType -> Choose one in the enum
Ascending -> true for Ascending, False for Descending
Sorry, all comment in functions are in french
'
' Pour les ListView
'
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_HITTEST As Long = (LVM_FIRST + 18)
Public Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
Public Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)
Public Const LVHT_NOWHERE As Long = &H1
Public Const LVHT_ONITEMICON As Long = &H2
Public Const LVHT_ONITEMLABEL As Long = &H4
Public Const LVHT_ONITEMSTATEICON As Long = &H8
Public Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or LVHT_ONITEMSTATEICON)
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type LVHITTESTINFO
pt As POINTAPI
flags As Long
iItem As Long
iSubItem As Long
End Type
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
'
' Pour trier les Listview
'
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Public Enum ListDataType
ldtString = 0
ldtNumber = 1
ldtDateTime = 2
End Enum
Public Sub SortListView(ListView As ListView, ByVal Index As Integer, ByVal DataType As ListDataType, ByVal Ascending As Boolean)
'
' Classer un ListView en fonction du type d'une de ces colonnes
'
Dim I As Integer
Dim l As Long
Dim strFormat As String
Dim blnRestoreFromTag As Boolean
Dim lngCursor As Long
Dim dte As Date
On Error Resume Next
'
' Mettre le sablier
'
lngCursor = ListView.MousePointer
ListView.MousePointer = vbHourglass
'
' Bloquer le ListView, pendant le temps de blocage, les MAJ sont impossibles
'
LockWindowUpdate ListView.hwnd
'
' Suivant le type de la colonne, utiliser une methode de classement diff?rente
'
Select Case DataType
Case ldtString
'
' Pour les chaines, utiliser la methode du ListView
'
blnRestoreFromTag = False
Case ldtNumber
'
' Pour les nombres, les formatter avant le tri
'
strFormat = String$(20, "0") & "." & String$(10, "0")
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
.Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
If IsNumeric(.Item(l).SubItem
If CDbl(.Item(l).SubItems(Ind
.Item(l).SubItems(Index) = Format(CDbl(.Item(l).SubIt
Else
.Item(l).SubItems(Index) = "&" & InvNumber(Format(0 - CDbl(.Item(l).SubItems(Ind
End If
Else
.Item(l).SubItems(Index) = ""
End If
Next l
End If
End With
blnRestoreFromTag = True
Case ldtDateTime
'
' Formatter les dates avant de les trier
'
strFormat = "YYYYMMDDHhNnSs"
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
Else
For l = 1 To .Count
.Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
dte = CDate(.Item(l).SubItems(In
.Item(l).SubItems(Index) = Format$(dte, strFormat)
Next l
End If
End With
blnRestoreFromTag = True
End Select
'
' Classer le ListView par ordre alpha
'
ListView.SortOrder = IIf(Ascending, lvwAscending, lvwDescending)
ListView.SortKey = Index
ListView.Sorted = True
'
' Enlever le formattage
'
If blnRestoreFromTag Then
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
I = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, I - 1)
.Tag = Mid$(.Tag, I + 1)
End With
Next l
Else
For l = 1 To .Count
I = InStr(.Item(l).Tag, Chr$(0))
.Item(l).SubItems(Index) = Left$(.Item(l).Tag, I - 1)
.Item(l).Tag = Mid$(.Item(l).Tag, I + 1)
Next l
End If
End With
End If
'
' D?bloquer l'affichage
'
LockWindowUpdate 0&
'
' Placer l'ancien curseur
'
ListView.MousePointer = lngCursor
End Sub
Private Function InvNumber(ByVal Number As String) As String
'
' Inverser le nombre
'
Static I As Integer
For I = 1 To Len(Number)
Select Case Mid$(Number, I, 1)
Case "-"
Mid$(Number, I, 1) = " "
Case "0"
Mid$(Number, I, 1) = "9"
Case "1"
Mid$(Number, I, 1) = "8"
Case "2"
Mid$(Number, I, 1) = "7"
Case "3"
Mid$(Number, I, 1) = "6"
Case "4"
Mid$(Number, I, 1) = "5"
Case "5"
Mid$(Number, I, 1) = "4"
Case "6"
Mid$(Number, I, 1) = "3"
Case "7"
Mid$(Number, I, 1) = "2"
Case "8"
Mid$(Number, I, 1) = "1"
Case "9"
Mid$(Number, I, 1) = "0"
End Select
Next
InvNumber = Number
End Function
You must use the SortListView function
ListView -> Your listView control to sort
Index -> Index of the column to sort, in the columnheaderclick, you can use ColumnHeader.Index -1
DataType -> Choose one in the enum
Ascending -> true for Ascending, False for Descending
Sorry, all comment in functions are in french
'
' Pour les ListView
'
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_HITTEST As Long = (LVM_FIRST + 18)
Public Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
Public Const LVM_GETSUBITEMRECT As Long = (LVM_FIRST + 56)
Public Const LVHT_NOWHERE As Long = &H1
Public Const LVHT_ONITEMICON As Long = &H2
Public Const LVHT_ONITEMLABEL As Long = &H4
Public Const LVHT_ONITEMSTATEICON As Long = &H8
Public Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or LVHT_ONITEMSTATEICON)
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type LVHITTESTINFO
pt As POINTAPI
flags As Long
iItem As Long
iSubItem As Long
End Type
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
'
' Pour trier les Listview
'
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Public Enum ListDataType
ldtString = 0
ldtNumber = 1
ldtDateTime = 2
End Enum
Public Sub SortListView(ListView As ListView, ByVal Index As Integer, ByVal DataType As ListDataType, ByVal Ascending As Boolean)
'
' Classer un ListView en fonction du type d'une de ces colonnes
'
Dim I As Integer
Dim l As Long
Dim strFormat As String
Dim blnRestoreFromTag As Boolean
Dim lngCursor As Long
Dim dte As Date
On Error Resume Next
'
' Mettre le sablier
'
lngCursor = ListView.MousePointer
ListView.MousePointer = vbHourglass
'
' Bloquer le ListView, pendant le temps de blocage, les MAJ sont impossibles
'
LockWindowUpdate ListView.hwnd
'
' Suivant le type de la colonne, utiliser une methode de classement diff?rente
'
Select Case DataType
Case ldtString
'
' Pour les chaines, utiliser la methode du ListView
'
blnRestoreFromTag = False
Case ldtNumber
'
' Pour les nombres, les formatter avant le tri
'
strFormat = String$(20, "0") & "." & String$(10, "0")
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
.Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
If IsNumeric(.Item(l).SubItem
If CDbl(.Item(l).SubItems(Ind
.Item(l).SubItems(Index) = Format(CDbl(.Item(l).SubIt
Else
.Item(l).SubItems(Index) = "&" & InvNumber(Format(0 - CDbl(.Item(l).SubItems(Ind
End If
Else
.Item(l).SubItems(Index) = ""
End If
Next l
End If
End With
blnRestoreFromTag = True
Case ldtDateTime
'
' Formatter les dates avant de les trier
'
strFormat = "YYYYMMDDHhNnSs"
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
Else
For l = 1 To .Count
.Item(l).Tag = .Item(l).SubItems(Index) & Chr$(0) & .Item(l).Tag
dte = CDate(.Item(l).SubItems(In
.Item(l).SubItems(Index) = Format$(dte, strFormat)
Next l
End If
End With
blnRestoreFromTag = True
End Select
'
' Classer le ListView par ordre alpha
'
ListView.SortOrder = IIf(Ascending, lvwAscending, lvwDescending)
ListView.SortKey = Index
ListView.Sorted = True
'
' Enlever le formattage
'
If blnRestoreFromTag Then
With ListView.ListItems
If (Index = 0) Then
For l = 1 To .Count
With .Item(l)
I = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, I - 1)
.Tag = Mid$(.Tag, I + 1)
End With
Next l
Else
For l = 1 To .Count
I = InStr(.Item(l).Tag, Chr$(0))
.Item(l).SubItems(Index) = Left$(.Item(l).Tag, I - 1)
.Item(l).Tag = Mid$(.Item(l).Tag, I + 1)
Next l
End If
End With
End If
'
' D?bloquer l'affichage
'
LockWindowUpdate 0&
'
' Placer l'ancien curseur
'
ListView.MousePointer = lngCursor
End Sub
Private Function InvNumber(ByVal Number As String) As String
'
' Inverser le nombre
'
Static I As Integer
For I = 1 To Len(Number)
Select Case Mid$(Number, I, 1)
Case "-"
Mid$(Number, I, 1) = " "
Case "0"
Mid$(Number, I, 1) = "9"
Case "1"
Mid$(Number, I, 1) = "8"
Case "2"
Mid$(Number, I, 1) = "7"
Case "3"
Mid$(Number, I, 1) = "6"
Case "4"
Mid$(Number, I, 1) = "5"
Case "5"
Mid$(Number, I, 1) = "4"
Case "6"
Mid$(Number, I, 1) = "3"
Case "7"
Mid$(Number, I, 1) = "2"
Case "8"
Mid$(Number, I, 1) = "1"
Case "9"
Mid$(Number, I, 1) = "0"
End Select
Next
InvNumber = Number
End Function
'Make sure the module name is
'mLVSort. Set this in
'your properties window
Option Explicit
Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
'variable to hold the sort order (ascending or descending)
Public sOrder As Boolean
'variable to hold sort column
Public sColumn As Long
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 String
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
'Constants
Public Const LVFI_PARAM = 1
Public Const LVIF_TEXT = &H1
Public Const LVM_FIRST = &H1000
Public Const LVM_FINDITEM = LVM_FIRST + 13
Public Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48
'API declarations
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private lngListColour 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, dDate2 As Date, dE As Boolean, d2E As Boolean
On Error GoTo CDERR
'Obtain the item names and dates corresponding to the
'input parameters
dDate1 = ListView_GetItemDate(hWnd,
dDate2 = ListView_GetItemDate(hWnd,
'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
Exit Function
CDERR:
CompareDates = 1
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, val2 As Long
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemValueStr(h
val2 = ListView_GetItemValueStr(h
'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
Exit Function
CDERR:
CompareValues = 1
End Function
Public Function CompareCurrency(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 Currency, val2 As Currency
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemCurrency(h
val2 = ListView_GetItemCurrency(h
'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
CompareCurrency = 0
ElseIf val1 = val2 Then
CompareCurrency = 1
Else
CompareCurrency = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
CompareCurrency = 0
ElseIf val1 = val2 Then
CompareCurrency = 1
Else
CompareCurrency = 2
End If
End Select
Exit Function
CDERR:
CompareCurrency = 1
End Function
Public Function ComparePercent(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 Single, val2 As Single
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemPercent(hW
val2 = ListView_GetItemPercent(hW
'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
ComparePercent = 0
ElseIf val1 = val2 Then
ComparePercent = 1
Else
ComparePercent = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
ComparePercent = 0
ElseIf val1 = val2 Then
ComparePercent = 1
Else
ComparePercent = 2
End If
End Select
Exit Function
CDERR:
ComparePercent = 1
End Function
Private Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 1
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a date and exit
If r > 0 Then
If IsDate(Left$(objItem.pszTe
ListView_GetItemDate = CDate(Left$(objItem.pszTex
Else
ListView_GetItemDate = DateSerial(4501, 1, 1)
End If
End If
End Function
Public Function ListView_GetItemValueStr(h
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
ListView_GetItemValueStr = CLng(Left$(objItem.pszText
End If
End Function
Public Function ListView_GetItemCurrency(h
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
ListView_GetItemCurrency = CCur(Left$(objItem.pszText
End If
End Function
Public Function ListView_GetItemPercent(hW
Dim r As Long, hIndex As Long, temp As String
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
temp = Left$(objItem.pszText, r)
If Right$(temp, 1) = "%" Then
temp = Left$(temp, Len(temp) - 1)
End If
ListView_GetItemPercent = CSng(temp)
End If
End Function
Public Sub SortLvwOnDate(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareDates
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnLong(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareValues
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnCurrency(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareCurrency
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnPercent(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf ComparePercent
Screen.MousePointer = vbDefault
End Sub
Private Function GetListColour() As Long
'=========================
Dim DB As Object
Dim rs As Object
On Error Resume Next
Set DB = CreateObject("ADODB.Connec
Set rs = CreateObject("ADODB.Record
' Only retrieve connection string if it has not been set already
If gConnectionString = "" Then gConnectionString = GEN_GetConnectionString
DB.Open gConnectionString
rs.Open "SELECT ListColour FROM Users WHERE UserID = " & gUserID, DB, 0, 1
If Not rs.EOF Then
GetListColour = rs!ListColour
End If
rs.Close
DB.Close
End Function
Public Sub SetListViewColor(pCtrlList
pCtrlPictureBox As PictureBox, _
Color1 As Long, Color2 As Long)
'=========================
On Error GoTo SetListViewColor_Error
Dim iLineHeight As Long
Dim iBarHeight As Long
Dim lBarWidth As Long
' Variables not really necessary
' Can set the values directly
' Dim lColor1 As Long
' Dim lColor2 As Long
' lColor1 = Color1
' lColor2 = Color2
' Only retrieve the list colour if it has not been set already
If lngListColour = 0 Then lngListColour = GetListColour
If pCtrlListView.View = lvwReport Then
' pCtrlListView.Picture = LoadPicture("")
' pCtrlListView.Refresh
' pCtrlPictureBox.Cls
With pCtrlListView
.Picture = LoadPicture("")
.Refresh
End With
' pCtrlPictureBox.AutoRedraw
' pCtrlPictureBox.BorderStyl
' pCtrlPictureBox.ScaleMode = vbTwips
' pCtrlPictureBox.Visible = False
With pCtrlPictureBox
.Cls
.AutoRedraw = True
.BorderStyle = vbBSNone
.ScaleMode = vbTwips
.Visible = False
End With
' pCtrlListView.PictureAlign
' pCtrlPictureBox.Font = pCtrlListView.Font
' pCtrlPictureBox.Top = pCtrlListView.Top
' With pCtrlPictureBox.Font
' .Size = pCtrlListView.Font.Size ' + 2.75
' .Bold = pCtrlListView.Font.Bold
' .Charset = pCtrlListView.Font.Charset
' .Italic = pCtrlListView.Font.Italic
' .Name = pCtrlListView.Font.Name
' .Strikethrough = pCtrlListView.Font.Striket
' .Underline = pCtrlListView.Font.Underli
' .Weight = pCtrlListView.Font.Weight
' End With
' pCtrlPictureBox.Refresh
pCtrlListView.PictureAlign
With pCtrlPictureBox
.Font = pCtrlListView.Font
.Top = pCtrlListView.Top
With .Font
.Size = pCtrlListView.Font.Size
.Bold = pCtrlListView.Font.Bold
.Charset = pCtrlListView.Font.Charset
.Italic = pCtrlListView.Font.Italic
.Name = pCtrlListView.Font.Name
.Strikethrough = pCtrlListView.Font.Striket
.Underline = pCtrlListView.Font.Underli
.Weight = pCtrlListView.Font.Weight
End With
.Refresh
End With
iLineHeight = pCtrlPictureBox.TextHeight
iBarHeight = (iLineHeight * 1)
lBarWidth = pCtrlListView.Width
pCtrlPictureBox.Height = iBarHeight * 2
pCtrlPictureBox.Width = lBarWidth
'paint the two bars of color
pCtrlPictureBox.Line (0, 0)-(lBarWidth, iBarHeight), Color1, BF
'pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Color2, BF
pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), lngListColour, BF
pCtrlPictureBox.AutoSize = True
'set the pCtrlListView picture to the
'pCtrlPictureBox image
pCtrlListView.Picture = pCtrlPictureBox.Image
Else
pCtrlListView.Picture = LoadPicture("")
End If
pCtrlListView.Refresh
Exit Sub
SetListViewColor_Error:
' Clear ListView's picture and then exit
' pCtrlListView.Picture = LoadPicture("")
' pCtrlListView.Refresh
With pCtrlListView
.Picture = LoadPicture("")
.Refresh
End With
End Sub
'mLVSort. Set this in
'your properties window
Option Explicit
Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
'variable to hold the sort order (ascending or descending)
Public sOrder As Boolean
'variable to hold sort column
Public sColumn As Long
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 String
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
'Constants
Public Const LVFI_PARAM = 1
Public Const LVIF_TEXT = &H1
Public Const LVM_FIRST = &H1000
Public Const LVM_FINDITEM = LVM_FIRST + 13
Public Const LVM_GETITEMTEXT = LVM_FIRST + 45
Public Const LVM_SORTITEMS = LVM_FIRST + 48
'API declarations
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private lngListColour 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, dDate2 As Date, dE As Boolean, d2E As Boolean
On Error GoTo CDERR
'Obtain the item names and dates corresponding to the
'input parameters
dDate1 = ListView_GetItemDate(hWnd,
dDate2 = ListView_GetItemDate(hWnd,
'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
Exit Function
CDERR:
CompareDates = 1
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, val2 As Long
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemValueStr(h
val2 = ListView_GetItemValueStr(h
'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
Exit Function
CDERR:
CompareValues = 1
End Function
Public Function CompareCurrency(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 Currency, val2 As Currency
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemCurrency(h
val2 = ListView_GetItemCurrency(h
'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
CompareCurrency = 0
ElseIf val1 = val2 Then
CompareCurrency = 1
Else
CompareCurrency = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
CompareCurrency = 0
ElseIf val1 = val2 Then
CompareCurrency = 1
Else
CompareCurrency = 2
End If
End Select
Exit Function
CDERR:
CompareCurrency = 1
End Function
Public Function ComparePercent(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 Single, val2 As Single
On Error GoTo CDERR
'Obtain the item names and values corresponding
'to the input parameters
val1 = ListView_GetItemPercent(hW
val2 = ListView_GetItemPercent(hW
'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
ComparePercent = 0
ElseIf val1 = val2 Then
ComparePercent = 1
Else
ComparePercent = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
ComparePercent = 0
ElseIf val1 = val2 Then
ComparePercent = 1
Else
ComparePercent = 2
End If
End Select
Exit Function
CDERR:
ComparePercent = 1
End Function
Private Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 1
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a date and exit
If r > 0 Then
If IsDate(Left$(objItem.pszTe
ListView_GetItemDate = CDate(Left$(objItem.pszTex
Else
ListView_GetItemDate = DateSerial(4501, 1, 1)
End If
End If
End Function
Public Function ListView_GetItemValueStr(h
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
ListView_GetItemValueStr = CLng(Left$(objItem.pszText
End If
End Function
Public Function ListView_GetItemCurrency(h
Dim r As Long, hIndex As Long
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
ListView_GetItemCurrency = CCur(Left$(objItem.pszText
End If
End Function
Public Function ListView_GetItemPercent(hW
Dim r As Long, hIndex As Long, temp As String
'Convert the input parameter to an index in the list view
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessageAny(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 = sColumn
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
'get the string at subitem 2
r = SendMessageAny(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
'and convert it into a long
If r > 0 Then
temp = Left$(objItem.pszText, r)
If Right$(temp, 1) = "%" Then
temp = Left$(temp, Len(temp) - 1)
End If
ListView_GetItemPercent = CSng(temp)
End If
End Function
Public Sub SortLvwOnDate(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareDates
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnLong(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareValues
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnCurrency(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf CompareCurrency
Screen.MousePointer = vbDefault
End Sub
Public Sub SortLvwOnPercent(lvw As ListView, ColIndex As Long)
Screen.MousePointer = vbHourglass
lvw.Sorted = False
If lvw.SortKey = ColIndex - 1 Then
If lvw.SortOrder = lvwAscending Then
lvw.SortOrder = lvwDescending
Else
lvw.SortOrder = lvwAscending
End If
Else
lvw.SortKey = ColIndex - 1
lvw.SortOrder = lvwAscending
End If
mLVSort.sColumn = ColIndex - 1
mLVSort.sOrder = (lvw.SortOrder = lvwAscending)
SendMessageLong lvw.hWnd, LVM_SORTITEMS, lvw.hWnd, AddressOf ComparePercent
Screen.MousePointer = vbDefault
End Sub
Private Function GetListColour() As Long
'=========================
Dim DB As Object
Dim rs As Object
On Error Resume Next
Set DB = CreateObject("ADODB.Connec
Set rs = CreateObject("ADODB.Record
' Only retrieve connection string if it has not been set already
If gConnectionString = "" Then gConnectionString = GEN_GetConnectionString
DB.Open gConnectionString
rs.Open "SELECT ListColour FROM Users WHERE UserID = " & gUserID, DB, 0, 1
If Not rs.EOF Then
GetListColour = rs!ListColour
End If
rs.Close
DB.Close
End Function
Public Sub SetListViewColor(pCtrlList
pCtrlPictureBox As PictureBox, _
Color1 As Long, Color2 As Long)
'=========================
On Error GoTo SetListViewColor_Error
Dim iLineHeight As Long
Dim iBarHeight As Long
Dim lBarWidth As Long
' Variables not really necessary
' Can set the values directly
' Dim lColor1 As Long
' Dim lColor2 As Long
' lColor1 = Color1
' lColor2 = Color2
' Only retrieve the list colour if it has not been set already
If lngListColour = 0 Then lngListColour = GetListColour
If pCtrlListView.View = lvwReport Then
' pCtrlListView.Picture = LoadPicture("")
' pCtrlListView.Refresh
' pCtrlPictureBox.Cls
With pCtrlListView
.Picture = LoadPicture("")
.Refresh
End With
' pCtrlPictureBox.AutoRedraw
' pCtrlPictureBox.BorderStyl
' pCtrlPictureBox.ScaleMode = vbTwips
' pCtrlPictureBox.Visible = False
With pCtrlPictureBox
.Cls
.AutoRedraw = True
.BorderStyle = vbBSNone
.ScaleMode = vbTwips
.Visible = False
End With
' pCtrlListView.PictureAlign
' pCtrlPictureBox.Font = pCtrlListView.Font
' pCtrlPictureBox.Top = pCtrlListView.Top
' With pCtrlPictureBox.Font
' .Size = pCtrlListView.Font.Size ' + 2.75
' .Bold = pCtrlListView.Font.Bold
' .Charset = pCtrlListView.Font.Charset
' .Italic = pCtrlListView.Font.Italic
' .Name = pCtrlListView.Font.Name
' .Strikethrough = pCtrlListView.Font.Striket
' .Underline = pCtrlListView.Font.Underli
' .Weight = pCtrlListView.Font.Weight
' End With
' pCtrlPictureBox.Refresh
pCtrlListView.PictureAlign
With pCtrlPictureBox
.Font = pCtrlListView.Font
.Top = pCtrlListView.Top
With .Font
.Size = pCtrlListView.Font.Size
.Bold = pCtrlListView.Font.Bold
.Charset = pCtrlListView.Font.Charset
.Italic = pCtrlListView.Font.Italic
.Name = pCtrlListView.Font.Name
.Strikethrough = pCtrlListView.Font.Striket
.Underline = pCtrlListView.Font.Underli
.Weight = pCtrlListView.Font.Weight
End With
.Refresh
End With
iLineHeight = pCtrlPictureBox.TextHeight
iBarHeight = (iLineHeight * 1)
lBarWidth = pCtrlListView.Width
pCtrlPictureBox.Height = iBarHeight * 2
pCtrlPictureBox.Width = lBarWidth
'paint the two bars of color
pCtrlPictureBox.Line (0, 0)-(lBarWidth, iBarHeight), Color1, BF
'pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), Color2, BF
pCtrlPictureBox.Line (0, iBarHeight)-(lBarWidth, iBarHeight * 2), lngListColour, BF
pCtrlPictureBox.AutoSize = True
'set the pCtrlListView picture to the
'pCtrlPictureBox image
pCtrlListView.Picture = pCtrlPictureBox.Image
Else
pCtrlListView.Picture = LoadPicture("")
End If
pCtrlListView.Refresh
Exit Sub
SetListViewColor_Error:
' Clear ListView's picture and then exit
' pCtrlListView.Picture = LoadPicture("")
' pCtrlListView.Refresh
With pCtrlListView
.Picture = LoadPicture("")
.Refresh
End With
End Sub
ASKER
Thanks for the comments and suggestions so far.
I'm running through them one by one and will come back with any feedback once ive been through them.
Just to make myself clear. I am already aware of all sorts of other methods of "tweaking" the listview to do the sort in a different way.
What I'm looking for is a method to "resynchronise" the data held by the listview itself (and shown on screen) and the data maintained in the listitems collection by the VBwrapper for listview.
Sombell
I'm running through them one by one and will come back with any feedback once ive been through them.
Just to make myself clear. I am already aware of all sorts of other methods of "tweaking" the listview to do the sort in a different way.
What I'm looking for is a method to "resynchronise" the data held by the listview itself (and shown on screen) and the data maintained in the listitems collection by the VBwrapper for listview.
Sombell
ASKER
OK.
I've been through the comments posted so far. I'll take them one by one.
Please understand, I'm not saying most(if not all of these suggestions work as alternative methods of sorting - I've used most of them in the past myself. But I'm not looking for an alternative sorting method - I was hoping to solve the problem that makes using LVM_SORTITEMS pretty useless
ryancys:
This sample uses a kludge I am aware of for sorting listviews. Once again it points out the problem to which I am trying to find a solution, but then neither does it solve the problem.
TimCottee:
Same again I'm afraid.
casassus:
A rather more involved (but more general solution) using the "dummy column" technique. But without actually using a dummy column. (the french wasnt a problem I worked for a french company for 20 years, so my schoolboy language skills are well tuned :o)
Vogon:
I presume quite a bit of this code is not pertinant to your answer. If this is code you use in your projects then you have exactly the problem I'm trying to find a solution to. If you click on an item after sorting using the LVM_SORTITEMS message to get it sorted, then the ITEM passed to the _ItemClicked event is NOT always the same as the one you think you clicked on the screen (they'll be the same if their position in the order hasnt changed otherwise you get the wrong it).
I know I can avoid this whole problem by using some other method (which is what i do at the moment), but what I want to do is to find some way of solving the problem that is created by using the LVM_SORTITEMS message. It's not blocking my development since it's currently coded to use an "alternate kludge". It just seems to me that with all the expertise available we ought to be able to find a solution.
Think of it as an intellectual exercise.
So, just to refresh. It seems there are two potential routes to a solution.
Route 1 is to re-synchronise the VBWrapper data collection to the order displayed in the ListView
Route 2 is to determine which element of the listview has been clicked and get the right object in the VBwrapper collection using that.
The question is, how ? (and i suppose which is cleaner and/or more efficient)
Sombell
I've been through the comments posted so far. I'll take them one by one.
Please understand, I'm not saying most(if not all of these suggestions work as alternative methods of sorting - I've used most of them in the past myself. But I'm not looking for an alternative sorting method - I was hoping to solve the problem that makes using LVM_SORTITEMS pretty useless
ryancys:
This sample uses a kludge I am aware of for sorting listviews. Once again it points out the problem to which I am trying to find a solution, but then neither does it solve the problem.
TimCottee:
Same again I'm afraid.
casassus:
A rather more involved (but more general solution) using the "dummy column" technique. But without actually using a dummy column. (the french wasnt a problem I worked for a french company for 20 years, so my schoolboy language skills are well tuned :o)
Vogon:
I presume quite a bit of this code is not pertinant to your answer. If this is code you use in your projects then you have exactly the problem I'm trying to find a solution to. If you click on an item after sorting using the LVM_SORTITEMS message to get it sorted, then the ITEM passed to the _ItemClicked event is NOT always the same as the one you think you clicked on the screen (they'll be the same if their position in the order hasnt changed otherwise you get the wrong it).
I know I can avoid this whole problem by using some other method (which is what i do at the moment), but what I want to do is to find some way of solving the problem that is created by using the LVM_SORTITEMS message. It's not blocking my development since it's currently coded to use an "alternate kludge". It just seems to me that with all the expertise available we ought to be able to find a solution.
Think of it as an intellectual exercise.
So, just to refresh. It seems there are two potential routes to a solution.
Route 1 is to re-synchronise the VBWrapper data collection to the order displayed in the ListView
Route 2 is to determine which element of the listview has been clicked and get the right object in the VBwrapper collection using that.
The question is, how ? (and i suppose which is cleaner and/or more efficient)
Sombell
Mind I have a ride?
ASKER
No problem, the more the merrier
Hi
The problem is - VB ListView control is not same as SysListView32 window class. It store listitems in separate collection, so when you use custom sorting, indexes in collection and in listview aren't same.
>>HOWEVER, if you click on an item when the list is sorted by Number, the ITEM parameter passed to the
_ItemClick event is NOT the item that was clicked in the listview.<<
Nope! _ItemClick (or.SelectedItem) return CORRECT ListItem, only index is diffrent (it was setting BEFORE sorting) so you can not access any item by index. You have two ways -
1. Using subclassing and continue all staff with API.
2. Store info in .Key or .Tag properties.
IMHO, better to use .Key property (note that it shoul begin from letter, not digit, but you can add any letter before digits).
Cheers
The problem is - VB ListView control is not same as SysListView32 window class. It store listitems in separate collection, so when you use custom sorting, indexes in collection and in listview aren't same.
>>HOWEVER, if you click on an item when the list is sorted by Number, the ITEM parameter passed to the
_ItemClick event is NOT the item that was clicked in the listview.<<
Nope! _ItemClick (or.SelectedItem) return CORRECT ListItem, only index is diffrent (it was setting BEFORE sorting) so you can not access any item by index. You have two ways -
1. Using subclassing and continue all staff with API.
2. Store info in .Key or .Tag properties.
IMHO, better to use .Key property (note that it shoul begin from letter, not digit, but you can add any letter before digits).
Cheers
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Excellent !
That does the trick.
Just to explain (and hopefully make the problem and solution clear):
The VB Listview control is a "wrapper" for the Listview common control. This allows use of the control to be simplified, and allows for the items in the list to be managed as a collection.
One of the things that this wrapping also does is to provide a "standard" sorting mechanism implemented in VB with the .Sortkey, .Sortorder and .Sorted properties.
Unfortunately this "standard" sorting only uses text comparison of values in the column used as the sort key (it also only allows the use of one key - equal key values remain sorted in the previous sorted [or unsorted] sequence).
The major impact of this is that using a column of numerical values as a sort key results in a sequence not ordered by value (the same applies to date columns unless the date is formatted in descending unit order - yyyy/mm/dd).
While it is possible to work around this problem by formatting a "dummy" column for the purpose of sorting, this method is a bit "kludgy".
It is possible, however, to invoke a cutom sort order for the Listview common control using the LVM_SORTITEMS message. This allows sorting to be done using any sequencing method (for instance its possible to sort a text colum in some arbitrary order - such as calendar months (Jan, Feb etc) in calendar order and not in alphabetical order).
The problem with this is that when an item in the list is clicked after the list has been sorted using this custom method, the item object passed to the _ItemClicked event is not the item that has been clicked on the screen:
When using the "standard" sorting method of the vb control
the item object collection is re-ordered and displayed in that order on screen (item.index=1 for the first item on screen, item.index=2 for the second etc)
When using the LVM_SORTITEMS sorting method the screen is updated to show the items on screen in their sorted order, but the item object collection is NOT re-ordered, so possibly item.index=12 for the first item on screen, item.index=5 for the second, and so on.
The solution provided by Ark is to ignore the item object passed to the _ItemClicked event and use the .ItemSelected object which will be the correct item.
I'll post a simple example illustrating this problem and its solution later today.
Meanwhile, thank you Ark.
Sombell
That does the trick.
Just to explain (and hopefully make the problem and solution clear):
The VB Listview control is a "wrapper" for the Listview common control. This allows use of the control to be simplified, and allows for the items in the list to be managed as a collection.
One of the things that this wrapping also does is to provide a "standard" sorting mechanism implemented in VB with the .Sortkey, .Sortorder and .Sorted properties.
Unfortunately this "standard" sorting only uses text comparison of values in the column used as the sort key (it also only allows the use of one key - equal key values remain sorted in the previous sorted [or unsorted] sequence).
The major impact of this is that using a column of numerical values as a sort key results in a sequence not ordered by value (the same applies to date columns unless the date is formatted in descending unit order - yyyy/mm/dd).
While it is possible to work around this problem by formatting a "dummy" column for the purpose of sorting, this method is a bit "kludgy".
It is possible, however, to invoke a cutom sort order for the Listview common control using the LVM_SORTITEMS message. This allows sorting to be done using any sequencing method (for instance its possible to sort a text colum in some arbitrary order - such as calendar months (Jan, Feb etc) in calendar order and not in alphabetical order).
The problem with this is that when an item in the list is clicked after the list has been sorted using this custom method, the item object passed to the _ItemClicked event is not the item that has been clicked on the screen:
When using the "standard" sorting method of the vb control
the item object collection is re-ordered and displayed in that order on screen (item.index=1 for the first item on screen, item.index=2 for the second etc)
When using the LVM_SORTITEMS sorting method the screen is updated to show the items on screen in their sorted order, but the item object collection is NOT re-ordered, so possibly item.index=12 for the first item on screen, item.index=5 for the second, and so on.
The solution provided by Ark is to ignore the item object passed to the _ItemClicked event and use the .ItemSelected object which will be the correct item.
I'll post a simple example illustrating this problem and its solution later today.
Meanwhile, thank you Ark.
Sombell
ASKER
Forgot to accept the answer earlier !
OK here is the example showing the solution
You need a form with a listview on it (make is a bit wider than default) and a module.
then paste the first block into the form, the second block into the module:
==================== First Block
Option Explicit
Private Sub Form_Load()
Dim xCol As ColumnHeader
Dim xItem As ListItem
'Add two Column Headers to the ListView control
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
'Set the view property of the Listview control to Report view
ListView1.View = lvwReport
'Add data to the ListView control
Set xItem = ListView1.ListItems.Add(, , "Fred Bloggs")
xItem.SubItems(1) = "3"
xItem.SubItems(2) = "13/1/1999"
xItem.SubItems(3) = "Fred Bloggs"
Set xItem = ListView1.ListItems.Add(, , "Bill Smith")
xItem.SubItems(1) = "17"
xItem.SubItems(2) = "1/1/1999"
xItem.SubItems(3) = "Bill Smith"
Set xItem = ListView1.ListItems.Add(, , "Sid Williams")
xItem.SubItems(1) = "1"
xItem.SubItems(2) = "4/1/1999"
xItem.SubItems(3) = "Sid Williams"
Set xItem = ListView1.ListItems.Add(, , "Fred Jones")
xItem.SubItems(1) = "22"
xItem.SubItems(2) = "1/2/1999"
xItem.SubItems(3) = "Fred Jones"
Set xItem = ListView1.ListItems.Add(, , "Anna Conder")
xItem.SubItems(1) = "2"
xItem.SubItems(2) = "1/1/1998"
xItem.SubItems(3) = "Anna Conder"
End Sub
Private Sub ListView1_ColumnClick(ByVa
Select Case ColumnHeader.Index - 1
Case 0 'name - invoke the standard sort method
ListView1.SortKey = 0
ListView1.Sorted = True
Case 1 ' number
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareNumber
Case 2 '
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareDate
Case 3 '
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareSurname
End Select
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Debug.Print "+++++++++++++++++++++++++
Debug.Print , "Param Item", "Selected Item"
Debug.Print "Index:", Item.Index, ListView1.SelectedItem.Ind
Debug.Print "Text:", Item.Text, ListView1.SelectedItem.Tex
End Sub
Private Sub DebugDump(s As String, pItem As ListItem)
Debug.Print s
Debug.Print " Index="; pItem.Index
Debug.Print " Text = "; pItem.Text
End Sub
==================== Second Block
Option Explicit
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
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
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
Public Function CompareNumber(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As Integer, xVal2 As Integer
xVal1 = CInt(lvGetItemData(lngPara
xVal2 = CInt(lvGetItemData(lngPara
'Compare the dates
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
' concatenate surname forename for comparison
If xVal1 < xVal2 Then
CompareNumber = 0
ElseIf xVal1 = xVal2 Then
CompareNumber = 1
Else
CompareNumber = 2
End If
End Function
Public Function CompareDate(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As Date, xVal2 As Date
xVal1 = CDate(lvGetItemData(lngPar
xVal2 = CDate(lvGetItemData(lngPar
If xVal1 < xVal2 Then
CompareDate = 0
ElseIf xVal1 = xVal2 Then
CompareDate = 1
Else
CompareDate = 2
End If
End Function
Public Function CompareSurname(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As String, xVal2 As String, v() As String
xVal1 = lvGetItemData(lngParam1, hWnd, 3)
xVal2 = lvGetItemData(lngParam2, hWnd, 3)
v = Split(xVal1)
xVal1 = v(UBound(v))
v = Split(xVal2)
xVal2 = v(UBound(v))
'Compare the dates
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
' concatenate surname forename for comparison
If xVal1 < xVal2 Then
CompareSurname = 0
ElseIf xVal1 = xVal2 Then
CompareSurname = 1
Else
CompareSurname = 2
End If
End Function
'GetItemData - Given Retrieves
Private Function lvGetItemData(lngParam As Long, hWnd As Long, pCol As String) As String
Dim objFind As LV_FINDINFO
Dim lngIndex As Long
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long
'
' Convert the input parameter to an index in the list view
'
objFind.flags = LVFI_PARAM
objFind.lParam = lngParam
lngIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))
objItem.mask = LVIF_TEXT
objItem.iSubItem = pCol
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
lvGetItemData = Left$(StrConv(baBuffer, vbUnicode), lngLength)
End Function
OK here is the example showing the solution
You need a form with a listview on it (make is a bit wider than default) and a module.
then paste the first block into the form, the second block into the module:
==================== First Block
Option Explicit
Private Sub Form_Load()
Dim xCol As ColumnHeader
Dim xItem As ListItem
'Add two Column Headers to the ListView control
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
Set xCol = ListView1.ColumnHeaders.Ad
'Set the view property of the Listview control to Report view
ListView1.View = lvwReport
'Add data to the ListView control
Set xItem = ListView1.ListItems.Add(, , "Fred Bloggs")
xItem.SubItems(1) = "3"
xItem.SubItems(2) = "13/1/1999"
xItem.SubItems(3) = "Fred Bloggs"
Set xItem = ListView1.ListItems.Add(, , "Bill Smith")
xItem.SubItems(1) = "17"
xItem.SubItems(2) = "1/1/1999"
xItem.SubItems(3) = "Bill Smith"
Set xItem = ListView1.ListItems.Add(, , "Sid Williams")
xItem.SubItems(1) = "1"
xItem.SubItems(2) = "4/1/1999"
xItem.SubItems(3) = "Sid Williams"
Set xItem = ListView1.ListItems.Add(, , "Fred Jones")
xItem.SubItems(1) = "22"
xItem.SubItems(2) = "1/2/1999"
xItem.SubItems(3) = "Fred Jones"
Set xItem = ListView1.ListItems.Add(, , "Anna Conder")
xItem.SubItems(1) = "2"
xItem.SubItems(2) = "1/1/1998"
xItem.SubItems(3) = "Anna Conder"
End Sub
Private Sub ListView1_ColumnClick(ByVa
Select Case ColumnHeader.Index - 1
Case 0 'name - invoke the standard sort method
ListView1.SortKey = 0
ListView1.Sorted = True
Case 1 ' number
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareNumber
Case 2 '
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareDate
Case 3 '
ListView1.Sorted = False
SendMessage ListView1.hWnd, LVM_SORTITEMS, ListView1.hWnd, AddressOf CompareSurname
End Select
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Debug.Print "+++++++++++++++++++++++++
Debug.Print , "Param Item", "Selected Item"
Debug.Print "Index:", Item.Index, ListView1.SelectedItem.Ind
Debug.Print "Text:", Item.Text, ListView1.SelectedItem.Tex
End Sub
Private Sub DebugDump(s As String, pItem As ListItem)
Debug.Print s
Debug.Print " Index="; pItem.Index
Debug.Print " Text = "; pItem.Text
End Sub
==================== Second Block
Option Explicit
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
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
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
Public Function CompareNumber(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As Integer, xVal2 As Integer
xVal1 = CInt(lvGetItemData(lngPara
xVal2 = CInt(lvGetItemData(lngPara
'Compare the dates
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
' concatenate surname forename for comparison
If xVal1 < xVal2 Then
CompareNumber = 0
ElseIf xVal1 = xVal2 Then
CompareNumber = 1
Else
CompareNumber = 2
End If
End Function
Public Function CompareDate(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As Date, xVal2 As Date
xVal1 = CDate(lvGetItemData(lngPar
xVal2 = CDate(lvGetItemData(lngPar
If xVal1 < xVal2 Then
CompareDate = 0
ElseIf xVal1 = xVal2 Then
CompareDate = 1
Else
CompareDate = 2
End If
End Function
Public Function CompareSurname(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
Dim xVal1 As String, xVal2 As String, v() As String
xVal1 = lvGetItemData(lngParam1, hWnd, 3)
xVal2 = lvGetItemData(lngParam2, hWnd, 3)
v = Split(xVal1)
xVal1 = v(UBound(v))
v = Split(xVal2)
xVal2 = v(UBound(v))
'Compare the dates
'Return 0 ==> Less Than
' 1 ==> Equal
' 2 ==> Greater Than
' concatenate surname forename for comparison
If xVal1 < xVal2 Then
CompareSurname = 0
ElseIf xVal1 = xVal2 Then
CompareSurname = 1
Else
CompareSurname = 2
End If
End Function
'GetItemData - Given Retrieves
Private Function lvGetItemData(lngParam As Long, hWnd As Long, pCol As String) As String
Dim objFind As LV_FINDINFO
Dim lngIndex As Long
Dim objItem As LV_ITEM
Dim baBuffer(32) As Byte
Dim lngLength As Long
'
' Convert the input parameter to an index in the list view
'
objFind.flags = LVFI_PARAM
objFind.lParam = lngParam
lngIndex = SendMessage(hWnd, LVM_FINDITEM, -1, VarPtr(objFind))
objItem.mask = LVIF_TEXT
objItem.iSubItem = pCol
objItem.pszText = VarPtr(baBuffer(0))
objItem.cchTextMax = UBound(baBuffer)
lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
VarPtr(objItem))
lvGetItemData = Left$(StrConv(baBuffer, vbUnicode), lngLength)
End Function
ASKER
There are a few comments on the above:
1)
If you add a new listitem to the listview when it is sorted using the "standard" method, it will get inserted in the correct place according to the sort parameters. If the list is sorted using the "custom" method it will be inserted at the end (assuming an index isnt given in the .Add method).
2)
the Comparexxxx functions return 0, 1 and 2
I have seen them coded using -1, 0 and 1 elsewhere, and it seems to work just as well.
Anyone have any comments ?
3)
There is still quite a bit of "hard coding" in the sorting code. Really I'd like to get rid of this and have a "general" solution.
I can see two possible ways to achieve this:
a) find the listview object from the .hwnd property passed as a parameter - is this possible if so how ?
b) use a different parameter, that allows the listview object to be found in the compare routine. Is there a way of doing this ?
If anyone has a solution for 3) i'll be happy to post it as a proper question & award points
1)
If you add a new listitem to the listview when it is sorted using the "standard" method, it will get inserted in the correct place according to the sort parameters. If the list is sorted using the "custom" method it will be inserted at the end (assuming an index isnt given in the .Add method).
2)
the Comparexxxx functions return 0, 1 and 2
I have seen them coded using -1, 0 and 1 elsewhere, and it seems to work just as well.
Anyone have any comments ?
3)
There is still quite a bit of "hard coding" in the sorting code. Really I'd like to get rid of this and have a "general" solution.
I can see two possible ways to achieve this:
a) find the listview object from the .hwnd property passed as a parameter - is this possible if so how ?
b) use a different parameter, that allows the listview object to be found in the compare routine. Is there a way of doing this ?
If anyone has a solution for 3) i'll be happy to post it as a proper question & award points
Hi
Take a look at http://www.freevbcode.com/ShowCode.Asp?ID=2977
Here is brief extraction of my compare process wihich I used to sort FileList by Name/Date/Size. You can see that it works OK. I removed part of code to determine if item is folder (Folder should be sorted separately before files).
Any time you need sorting (add new item, column click etc):
n = ListView1.SortKey
If ListView1.SortOrder = lvwDescending Then n = n Or SORT_DESCENDING
Call ListView_SortItems(ListVie
'===Bas module====
Public Function ListView_SortItems(hwndLV As Long, pfnCompare As Long, lParamSort As Long) As Boolean
ListView_SortItems = SendMessage(hwndLV, LVM_SORTITEMS, ByVal lParamSort, ByVal pfnCompare)
End Function
'VB TreeView and ListView can sort items only by strings
'Here is process to compare items by date and size
'Works both with TreeView and ListView
'>>the Comparexxxx functions return 0, 1 and 2<<
'-1,0 and 1 more better when using Sgn function
Public Function CompareProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As Long) As Long
Dim nColumn As Long
Dim hr As Long
Dim sCompare1 As String
Dim sCompare2 As String
Dim Item1 As Object, Item2 As Object
On Error GoTo ErrCompare
Set Item1 = GetItemFromlParam(lParam1)
Set Item2 = GetItemFromlParam(lParam2)
nColumn = lParamSort And Not SORT_DESCENDING
If nColumn = 0 Then
sCompare1 = Item1.Text
sCompare2 = Item2.Text
Else
sCompare1 = Item1.SubItems(nColumn)
sCompare2 = Item2.SubItems(nColumn)
End If
If IsDate(sCompare1) And IsDate(sCompare2) Then
hr = Sgn(CDate(sCompare1) - CDate(sCompare2))
'Change to IsNumeric if you want
ElseIf IsSize(sCompare1) And IsSize(sCompare2) Then
hr = Sgn(fldItem1.Size - fldItem2.Size)
Else
hr = StrComp(sCompare1, sCompare2)
End If
If (lParamSort And SORT_DESCENDING) Then hr = hr * (-1)
ErrCompare:
Set Item1 = Nothing
Set Item2 = Nothing
CompareProc = hr
End Function
'Determining if string can be size.
'Donno about all locales (espec. China, Japan etc)
'But usually size string looks like xxx KB, where
'xxx is numeric
Private Function IsSize(s As String) As Boolean
On Error Resume Next
IsSize = IsNumeric(Left(s, Len(s) - 3))
End Function
'Thanks to Brad Martinez for this trick. It's very usefull
'for comparing process
Public Function GetItemFromlParam(lParam As Long) As Object
Dim pItem As Long
Dim oItem As Object
If lParam Then
CopyMemory pItem, ByVal lParam + 8, 4
If pItem Then
CopyMemory oItem, pItem, 4&
Set GetItemFromlParam = oItem
FillMemory oItem, 4, 0
End If
End If
End Function
Cheers
Take a look at http://www.freevbcode.com/ShowCode.Asp?ID=2977
Here is brief extraction of my compare process wihich I used to sort FileList by Name/Date/Size. You can see that it works OK. I removed part of code to determine if item is folder (Folder should be sorted separately before files).
Any time you need sorting (add new item, column click etc):
n = ListView1.SortKey
If ListView1.SortOrder = lvwDescending Then n = n Or SORT_DESCENDING
Call ListView_SortItems(ListVie
'===Bas module====
Public Function ListView_SortItems(hwndLV As Long, pfnCompare As Long, lParamSort As Long) As Boolean
ListView_SortItems = SendMessage(hwndLV, LVM_SORTITEMS, ByVal lParamSort, ByVal pfnCompare)
End Function
'VB TreeView and ListView can sort items only by strings
'Here is process to compare items by date and size
'Works both with TreeView and ListView
'>>the Comparexxxx functions return 0, 1 and 2<<
'-1,0 and 1 more better when using Sgn function
Public Function CompareProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal lParamSort As Long) As Long
Dim nColumn As Long
Dim hr As Long
Dim sCompare1 As String
Dim sCompare2 As String
Dim Item1 As Object, Item2 As Object
On Error GoTo ErrCompare
Set Item1 = GetItemFromlParam(lParam1)
Set Item2 = GetItemFromlParam(lParam2)
nColumn = lParamSort And Not SORT_DESCENDING
If nColumn = 0 Then
sCompare1 = Item1.Text
sCompare2 = Item2.Text
Else
sCompare1 = Item1.SubItems(nColumn)
sCompare2 = Item2.SubItems(nColumn)
End If
If IsDate(sCompare1) And IsDate(sCompare2) Then
hr = Sgn(CDate(sCompare1) - CDate(sCompare2))
'Change to IsNumeric if you want
ElseIf IsSize(sCompare1) And IsSize(sCompare2) Then
hr = Sgn(fldItem1.Size - fldItem2.Size)
Else
hr = StrComp(sCompare1, sCompare2)
End If
If (lParamSort And SORT_DESCENDING) Then hr = hr * (-1)
ErrCompare:
Set Item1 = Nothing
Set Item2 = Nothing
CompareProc = hr
End Function
'Determining if string can be size.
'Donno about all locales (espec. China, Japan etc)
'But usually size string looks like xxx KB, where
'xxx is numeric
Private Function IsSize(s As String) As Boolean
On Error Resume Next
IsSize = IsNumeric(Left(s, Len(s) - 3))
End Function
'Thanks to Brad Martinez for this trick. It's very usefull
'for comparing process
Public Function GetItemFromlParam(lParam As Long) As Object
Dim pItem As Long
Dim oItem As Object
If lParam Then
CopyMemory pItem, ByVal lParam + 8, 4
If pItem Then
CopyMemory oItem, pItem, 4&
Set GetItemFromlParam = oItem
FillMemory oItem, 4, 0
End If
End If
End Function
Cheers
another similar link: http://www.codeguru.com/vb/articles/1818.shtml
Don't know if it's help and i hope so, regards.