Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
sorting a date in listveiw control
- Thread starter chrisp909
- Start date
for the column that is a Date set the TAG property to SORTDATE
Then put code in the columnclick event like this:
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Common_ListView_ColumnClick ListView1, ColumnHeader
End Sub
Then Put the below code into a module:
Private mobjItemFind As LV_FINDINFO
Private mobjListItem As LV_ITEM
'variable to hold the sort order (ascending or descending)
Private mlngSortOrder As Long
'variable to hold the sort key
Private mlngSortKey As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINTAPI
vkDirection As Long
End Type
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
'Constants
Private Const LVFI_PARAM As Long = &H1
Private Const LVIF_TEXT As Long = &H1
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Private Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Private Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
Public Const LVM_GETTEXTCOLOR = (LVM_FIRST + 35)
Public Const LVM_SETTEXTCOLOR = (LVM_FIRST + 36)
'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 apiListViewCompareDates(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
'apiListViewCompareDates: 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 = apiListViewGetItemDate(hWnd, lParam1)
dDate2 = apiListViewGetItemDate(hWnd, lParam2)
'based on the Public variable mlngSortOrder set in the
'columnheader click sub, sort the dates appropriately:
Select Case mlngSortOrder
Case lvwDescending: 'sort descending
If dDate1 < dDate2 Then
apiListViewCompareDates = 2
ElseIf dDate1 = dDate2 Then
apiListViewCompareDates = 1
Else
apiListViewCompareDates = 0
End If
Case Else: 'sort ascending
If dDate1 > dDate2 Then
apiListViewCompareDates = 2
ElseIf dDate1 = dDate2 Then
apiListViewCompareDates = 1
Else
apiListViewCompareDates = 0
End If
End Select
End Function
Public Function apiListViewCompareValues(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
'apiListViewCompareValues: 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 Double
Dim val2 As Double
'Obtain the item names and values corresponding
'to the input parameters
val1 = apiListViewGetItemValueStr(hWnd, lParam1)
val2 = apiListViewGetItemValueStr(hWnd, lParam2)
'based on the Public variable mlngSortOrder set in the
'columnheader click sub, sort the values appropriately:
Select Case mlngSortOrder
Case lvwDescending: 'sort descending
If val1 < val2 Then
apiListViewCompareValues = 2
ElseIf val1 = val2 Then
apiListViewCompareValues = 1
Else: apiListViewCompareValues = 0
End If
Case Else: 'sort ascending
If val1 > val2 Then
apiListViewCompareValues = 2
ElseIf val1 = val2 Then
apiListViewCompareValues = 1
Else: apiListViewCompareValues = 0
End If
End Select
End Function
Public Function apiListViewGetItemDate(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
mobjItemFind.flags = LVFI_PARAM
mobjItemFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, mobjItemFind)
'Obtain the value of the specified list view item.
'The mobjListItem.iSubItem member is set to the index
'of the column that is being retrieved.
mobjListItem.mask = LVIF_TEXT
mobjListItem.iSubItem = mlngSortKey
mobjListItem.pszText = Space$(32)
mobjListItem.cchTextMax = Len(mobjListItem.pszText)
'get the string at subitem 1
'and convert it into a date and exit
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, mobjListItem)
If r > 0 Then
If IsDate(Left$(mobjListItem.pszText, r)) Then
apiListViewGetItemDate = CDate(Left$(mobjListItem.pszText, r))
Else
apiListViewGetItemDate = CDate("1/1/1900"
End If
Else
apiListViewGetItemDate = CDate("1/1/1900"
End If
End Function
Public Function apiListViewGetItemValueStr(hWnd As Long, lParam As Long) As Double
Dim hIndex As Long
Dim r As Long
'Convert the input parameter to an index in the list view
mobjItemFind.flags = LVFI_PARAM
mobjItemFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, mobjItemFind)
'Obtain the value of the specified list view item.
'The mobjListItem.iSubItem member is set to the index
'of the column that is being retrieved.
mobjListItem.mask = LVIF_TEXT
mobjListItem.iSubItem = mlngSortKey
mobjListItem.pszText = Space$(32)
mobjListItem.cchTextMax = Len(mobjListItem.pszText)
'get the string at subitem 2
'and convert it into a long
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, mobjListItem)
If r > 0 Then
If IsNumeric(Left$(mobjListItem.pszText, r)) Then
apiListViewGetItemValueStr = CDbl(Left$(mobjListItem.pszText, r))
Else
apiListViewGetItemValueStr = 0
End If
End If
End Function
Public Function apiFARPROC(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)
apiFARPROC = pfn
End Function
'*******************************************************************************
' Public Sub Common_ListView_ColumnClick(ByRef objListView As ListView, ByRef ColumnHeader As MSComctlLib.ColumnHeader)
' Purpose: Sort the ListView based on the column that was clicked
' Input: objListView is the listview which had a column click event
' ColumnHeader is the ColumnHeader that was passed in the ColumnClick event
' Created: 08-21-2001 ATC Created
'*******************************************************************************
'Additional Notes:
'
' To sort dates and numbers correctly, set the column header's
' tag property to
' SORTDATE to sort dates
' SORTNUMBER to sort numbers
Public Sub Common_ListView_ColumnClick(ByRef objListView As ListView, ByRef ColumnHeader As MSComctlLib.ColumnHeader)
Dim strSortType As String
If objListView.ListItems.Count = 0 Then Exit Sub 'If there is nothing in the listview get out to avoid error
mlngSortKey = ColumnHeader.Index - 1
strSortType = UCase$(ColumnHeader.Tag)
If objListView.SortKey = mlngSortKey Then
If objListView.SortOrder = lvwAscending Then
mlngSortOrder = lvwDescending
Else
mlngSortOrder = lvwAscending
End If
Else
mlngSortOrder = lvwAscending
End If
Select Case strSortType
Case "SORTDATE"
objListView.Sorted = False
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
SendMessage objListView.hWnd, _
LVM_SORTITEMS, _
objListView.hWnd, _
ByVal apiFARPROC(AddressOf apiListViewCompareDates)
Case "SORTNUMBER"
'Use sort routine to sort by value
objListView.Sorted = False
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
SendMessage objListView.hWnd, _
LVM_SORTITEMS, _
objListView.hWnd, _
ByVal apiFARPROC(AddressOf apiListViewCompareValues)
Case Else
'Use default sorting to sort the items in the list
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
objListView.Sorted = True
End Select
objListView.SelectedItem.EnsureVisible
End Sub
-Adam T. Courtney
Stratagem, Inc.
Then put code in the columnclick event like this:
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Common_ListView_ColumnClick ListView1, ColumnHeader
End Sub
Then Put the below code into a module:
Private mobjItemFind As LV_FINDINFO
Private mobjListItem As LV_ITEM
'variable to hold the sort order (ascending or descending)
Private mlngSortOrder As Long
'variable to hold the sort key
Private mlngSortKey As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINTAPI
vkDirection As Long
End Type
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
'Constants
Private Const LVFI_PARAM As Long = &H1
Private Const LVIF_TEXT As Long = &H1
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Private Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Private Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
Public Const LVM_GETTEXTCOLOR = (LVM_FIRST + 35)
Public Const LVM_SETTEXTCOLOR = (LVM_FIRST + 36)
'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 apiListViewCompareDates(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
'apiListViewCompareDates: 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 = apiListViewGetItemDate(hWnd, lParam1)
dDate2 = apiListViewGetItemDate(hWnd, lParam2)
'based on the Public variable mlngSortOrder set in the
'columnheader click sub, sort the dates appropriately:
Select Case mlngSortOrder
Case lvwDescending: 'sort descending
If dDate1 < dDate2 Then
apiListViewCompareDates = 2
ElseIf dDate1 = dDate2 Then
apiListViewCompareDates = 1
Else
apiListViewCompareDates = 0
End If
Case Else: 'sort ascending
If dDate1 > dDate2 Then
apiListViewCompareDates = 2
ElseIf dDate1 = dDate2 Then
apiListViewCompareDates = 1
Else
apiListViewCompareDates = 0
End If
End Select
End Function
Public Function apiListViewCompareValues(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
'apiListViewCompareValues: 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 Double
Dim val2 As Double
'Obtain the item names and values corresponding
'to the input parameters
val1 = apiListViewGetItemValueStr(hWnd, lParam1)
val2 = apiListViewGetItemValueStr(hWnd, lParam2)
'based on the Public variable mlngSortOrder set in the
'columnheader click sub, sort the values appropriately:
Select Case mlngSortOrder
Case lvwDescending: 'sort descending
If val1 < val2 Then
apiListViewCompareValues = 2
ElseIf val1 = val2 Then
apiListViewCompareValues = 1
Else: apiListViewCompareValues = 0
End If
Case Else: 'sort ascending
If val1 > val2 Then
apiListViewCompareValues = 2
ElseIf val1 = val2 Then
apiListViewCompareValues = 1
Else: apiListViewCompareValues = 0
End If
End Select
End Function
Public Function apiListViewGetItemDate(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
mobjItemFind.flags = LVFI_PARAM
mobjItemFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, mobjItemFind)
'Obtain the value of the specified list view item.
'The mobjListItem.iSubItem member is set to the index
'of the column that is being retrieved.
mobjListItem.mask = LVIF_TEXT
mobjListItem.iSubItem = mlngSortKey
mobjListItem.pszText = Space$(32)
mobjListItem.cchTextMax = Len(mobjListItem.pszText)
'get the string at subitem 1
'and convert it into a date and exit
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, mobjListItem)
If r > 0 Then
If IsDate(Left$(mobjListItem.pszText, r)) Then
apiListViewGetItemDate = CDate(Left$(mobjListItem.pszText, r))
Else
apiListViewGetItemDate = CDate("1/1/1900"
End If
Else
apiListViewGetItemDate = CDate("1/1/1900"
End If
End Function
Public Function apiListViewGetItemValueStr(hWnd As Long, lParam As Long) As Double
Dim hIndex As Long
Dim r As Long
'Convert the input parameter to an index in the list view
mobjItemFind.flags = LVFI_PARAM
mobjItemFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, mobjItemFind)
'Obtain the value of the specified list view item.
'The mobjListItem.iSubItem member is set to the index
'of the column that is being retrieved.
mobjListItem.mask = LVIF_TEXT
mobjListItem.iSubItem = mlngSortKey
mobjListItem.pszText = Space$(32)
mobjListItem.cchTextMax = Len(mobjListItem.pszText)
'get the string at subitem 2
'and convert it into a long
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, mobjListItem)
If r > 0 Then
If IsNumeric(Left$(mobjListItem.pszText, r)) Then
apiListViewGetItemValueStr = CDbl(Left$(mobjListItem.pszText, r))
Else
apiListViewGetItemValueStr = 0
End If
End If
End Function
Public Function apiFARPROC(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)
apiFARPROC = pfn
End Function
'*******************************************************************************
' Public Sub Common_ListView_ColumnClick(ByRef objListView As ListView, ByRef ColumnHeader As MSComctlLib.ColumnHeader)
' Purpose: Sort the ListView based on the column that was clicked
' Input: objListView is the listview which had a column click event
' ColumnHeader is the ColumnHeader that was passed in the ColumnClick event
' Created: 08-21-2001 ATC Created
'*******************************************************************************
'Additional Notes:
'
' To sort dates and numbers correctly, set the column header's
' tag property to
' SORTDATE to sort dates
' SORTNUMBER to sort numbers
Public Sub Common_ListView_ColumnClick(ByRef objListView As ListView, ByRef ColumnHeader As MSComctlLib.ColumnHeader)
Dim strSortType As String
If objListView.ListItems.Count = 0 Then Exit Sub 'If there is nothing in the listview get out to avoid error
mlngSortKey = ColumnHeader.Index - 1
strSortType = UCase$(ColumnHeader.Tag)
If objListView.SortKey = mlngSortKey Then
If objListView.SortOrder = lvwAscending Then
mlngSortOrder = lvwDescending
Else
mlngSortOrder = lvwAscending
End If
Else
mlngSortOrder = lvwAscending
End If
Select Case strSortType
Case "SORTDATE"
objListView.Sorted = False
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
SendMessage objListView.hWnd, _
LVM_SORTITEMS, _
objListView.hWnd, _
ByVal apiFARPROC(AddressOf apiListViewCompareDates)
Case "SORTNUMBER"
'Use sort routine to sort by value
objListView.Sorted = False
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
SendMessage objListView.hWnd, _
LVM_SORTITEMS, _
objListView.hWnd, _
ByVal apiFARPROC(AddressOf apiListViewCompareValues)
Case Else
'Use default sorting to sort the items in the list
objListView.SortKey = mlngSortKey
objListView.SortOrder = mlngSortOrder
objListView.Sorted = True
End Select
objListView.SelectedItem.EnsureVisible
End Sub
-Adam T. Courtney
Stratagem, Inc.
MichaelRed
Programmer
Adam,
Are you SURE this is "THE" way to go?
Wouldn't it be easier to add a (REAL date)column (even if it is "hidden" and -when the date col is selected for sorting - just switch to the "REAL Date" col fro the dorting and back to the string date col when done?
MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
Are you SURE this is "THE" way to go?
Wouldn't it be easier to add a (REAL date)column (even if it is "hidden"
and -when the date col is selected for sorting - just switch to the "REAL Date" col fro the dorting and back to the string date col when done?MichaelRed
m.red@att.net
There is never time to do it right but there is always time to do it over
I used to do that, but the only way to 'hide' the column is to set the width to zero, then the user can accidentally resize the column and see date formatted funny. It works, but it depends on the pickyness of your users or testing group (or managers of course).
-Adam T. Courtney
Stratagem, Inc.
-Adam T. Courtney
Stratagem, Inc.
- Status
