Wrox Home  
Search P2P Archive for: Go

  Return to Index  

pro_vb thread: How to sort Date column in ListView


Message #1 by "Ned" <nedashraf@h...> on Thu, 21 Nov 2002 05:14:26
Try this,

' This is the form
Option Explicit

Private Sub Form_Load()
    Dim clmAdd As ColumnHeader
    Dim itmAdd As ListItem
    
    'Add two Column Headers to the ListView control
    Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Name")
    Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Date")
    Set clmAdd = ListView1.ColumnHeaders.Add(Text:="Age")
    
    'Set the view property of the Listview control to Report view
    ListView1.View = lvwReport
    
    'Add data to the ListView control
    Set itmAdd = ListView1.ListItems.Add(Text:="Joe")
    itmAdd.SubItems(1) = "5-Jul-97"
    itmAdd.SubItems(2) = 24
    
    Set itmAdd = ListView1.ListItems.Add(Text:="Sally")
    itmAdd.SubItems(1) = "4-Aug-97"
    itmAdd.SubItems(2) = 9
    
    Set itmAdd = ListView1.ListItems.Add(Text:="Bill")
    itmAdd.SubItems(1) = "29-May-97"
    itmAdd.SubItems(2) = 17
    
    Set itmAdd = ListView1.ListItems.Add(Text:="Fred")
    itmAdd.SubItems(1) = "17-May-97"
    itmAdd.SubItems(2) = 31
    
    Set itmAdd = ListView1.ListItems.Add(Text:="Anne")
    itmAdd.SubItems(1) = "1-Jan-97"
    itmAdd.SubItems(2) = 8

End Sub


Private Sub ListView1_ColumnClick(ByVal ColumnHeader As
MSComctlLib.ColumnHeader)
    Static bSortOrder As Boolean
    Dim iSortOrder As Integer
    
    Dim strName As String
    Dim lngItem As Long
    Dim v As Variant
    
    'Handle User click on column header
    If ColumnHeader.Text = "Name" Then  'User clicked on Name header
        iSortOrder = IIf(bSortOrder, lvwAscending, lvwDescending)
        bSortOrder = Not bSortOrder
        
        ListView1.SortKey = 0          'items in the list
        ListView1.SortOrder = iSortOrder
    
        ListView1.Sorted = True        'Use default sorting to sort the
        
    ElseIf (ColumnHeader.Text = "Date") Then
        gbSortOrder = Not gbSortOrder
        ListView1.Sorted = False       'User clicked on the Date header
                                       'Use our sort routine to sort
                                       'by date
        giDataType = SORT_BY_DATE
        gnSubItemIndex = ColumnHeader.Index - 1
        SendMessage ListView1.hWnd, _
                    LVM_SORTITEMS, _
                    ListView1.hWnd, _
                    AddressOf CompareData
    
        'Refresh the ListView before writing the data
        ListView1.Refresh
        
        'Loop through the items in the List to print them out in
        'sorted order.
        'NOTE: You are looping through the ListView control because when _
        'sorting by date the ListItems collection won't be sorted.
        
        For lngItem = 0 To ListView1.ListItems.Count - 1
            ListView_GetListItem lngItem, ListView1.hWnd, strName, v
        Next
    ElseIf (ColumnHeader.Text = "Age") Then
        gbSortOrder = Not gbSortOrder
        
        ListView1.Sorted = False       'User clicked on the Date header
                                       'Use our sort routine to sort
                                       'by date
        SendMessage ListView1.hWnd, _
                    LVM_SORTITEMS, _
                    ListView1.hWnd, _
                    AddressOf CompareData
    
        giDataType = SORT_BY_INTEGER
        gnSubItemIndex = ColumnHeader.Index - 1
        
        'Refresh the ListView before writing the data
        ListView1.Refresh
        
        'Loop through the items in the List to print them out in
        'sorted order.
        'NOTE: You are looping through the ListView control because when _
        'sorting by date the ListItems collection won't be sorted.
        
        For lngItem = 0 To ListView1.ListItems.Count - 1
            ListView_GetListItem lngItem, ListView1.hWnd, strName, v
        Next
    
    End If
    
    
End Sub


' this is the module
Option Explicit

'Structures

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

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 gbSortOrder As Boolean
Public giDataType As Integer
Public gnSubItemIndex As Integer

' 1-integer, 2-long, 3-double, 4-currency, 5-date
Public Const SORT_BY_INTEGER  As Integer = 1
Public Const SORT_BY_LONG  As Integer = 2
Public Const SORT_BY_DOUBLE  As Integer = 3
Public Const SORT_BY_CURRENCY  As Integer = 4
Public Const SORT_BY_DATE  As Integer = 5

'Module Functions and Procedures

'CompareData: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.

Public Function CompareData(ByVal lngParam1 As Long, _
                           ByVal lngParam2 As Long, _
                           ByVal hWnd As Long) As Long

    Dim strName1 As String
    Dim strName2 As String
    Dim v1 As Variant
    Dim v2 As Variant
    
    'Obtain the item names and dates corresponding to the
    'input parameters
    
    ListView_GetItemData lngParam1, hWnd, strName1, v1
    ListView_GetItemData lngParam2, hWnd, strName2, v2
    
    'Compare the dates
    'Return 0 ==> Less Than
    '       1 ==> Equal
    '       2 ==> Greater Than
    Select Case giDataType
        Case SORT_BY_INTEGER:             ' integer
            CompareData = CompareIntegers(v1, v2)
        Case SORT_BY_LONG:             ' long
            CompareData = CompareLongs(v1, v2)
        Case SORT_BY_DOUBLE:             ' double
            CompareData = CompareDoubles(v1, v2)
        Case SORT_BY_CURRENCY:             ' currency
            CompareData = CompareCurrencys(v1, v2)
        Case SORT_BY_DATE:             ' date
            CompareData = CompareDates(v1, v2)
    End Select
End Function

'GetItemData - Given Retrieves

Public Sub ListView_GetItemData(lngParam As Long, _
                              hWnd As Long, _
                              strName As String, _
                              v As Variant)
    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))
    
    '
    ' Obtain the name of the specified list view item
    '
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = 0
    objItem.pszText = VarPtr(baBuffer(0))
    objItem.cchTextMax = UBound(baBuffer)
    lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
                            VarPtr(objItem))
    strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)
    
    '
    ' Obtain the modification date of the specified list view item
    '
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = gnSubItemIndex
    objItem.pszText = VarPtr(baBuffer(0))
    objItem.cchTextMax = UBound(baBuffer)
    lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
                            VarPtr(objItem))
    If lngLength > 0 Then
'        dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
        v = Left$(StrConv(baBuffer, vbUnicode), lngLength)
    End If
    
End Sub

'GetListItem - This is a modified version of ListView_GetItemData
' It takes an index into the list as a parameter and returns
' the appropriate values in the strName and dDate parameters.

Public Sub ListView_GetListItem(lngIndex As Long, _
                                hWnd As Long, _
                                strName As String, _
                                v As Variant)
    Dim objItem As LV_ITEM
    Dim baBuffer(32) As Byte
    Dim lngLength As Long
    
    '
    ' Obtain the name of the specified list view item
    '
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = 0
    objItem.pszText = VarPtr(baBuffer(0))
    objItem.cchTextMax = UBound(baBuffer)
    lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
                            VarPtr(objItem))
    strName = Left$(StrConv(baBuffer, vbUnicode), lngLength)
    
    '
    ' Obtain the modification date of the specified list view item
    '
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = 1
    objItem.pszText = VarPtr(baBuffer(0))
    objItem.cchTextMax = UBound(baBuffer)
    lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, _
                            VarPtr(objItem))
    If lngLength > 0 Then
        ' dDate = CDate(Left$(StrConv(baBuffer, vbUnicode), lngLength))
        v = Left$(StrConv(baBuffer, vbUnicode), lngLength)
    End If

End Sub

Private Function CompareIntegers(v1, v2) As Long
    Dim i1 As Integer
    Dim i2 As Integer
    
    i1 = CInt(v1)
    i2 = CInt(v2)
    
    If i1 < i2 Then
        CompareIntegers = IIf(gbSortOrder, 2, 0)
    ElseIf i1 = i2 Then
        CompareIntegers = 1
    Else
        CompareIntegers = IIf(gbSortOrder, 0, 2)
    End If

End Function

Private Function CompareLongs(v1, v2) As Long
    Dim i1 As Long
    Dim i2 As Long
    
    i1 = CLng(v1)
    i2 = CLng(v2)
    
    If i1 < i2 Then
        CompareLongs = IIf(gbSortOrder, 2, 0)
    ElseIf i1 = i2 Then
        CompareLongs = 1
    Else
        CompareLongs = IIf(gbSortOrder, 0, 2)
    End If

End Function

Private Function CompareDoubles(v1, v2) As Long
    Dim i1 As Double
    Dim i2 As Double
    
    i1 = CDbl(v1)
    i2 = CDbl(v2)
    
    If i1 < i2 Then
        CompareDoubles = IIf(gbSortOrder, 2, 0)
    ElseIf i1 = i2 Then
        CompareDoubles = 1
    Else
        CompareDoubles = IIf(gbSortOrder, 0, 2)
    End If

End Function

Private Function CompareCurrencys(v1, v2) As Long
    Dim i1 As Currency
    Dim i2 As Currency
    
    i1 = CCur(v1)
    i2 = CCur(v2)
    
    If i1 < i2 Then
        CompareCurrencys = IIf(gbSortOrder, 2, 0)
    ElseIf i1 = i2 Then
        CompareCurrencys = 1
    Else
        CompareCurrencys = IIf(gbSortOrder, 0, 2)
    End If

End Function


Private Function CompareDates(v1, v2) As Long
    Dim i1 As Date
    Dim i2 As Date
    
    i1 = CDate(v1)
    i2 = CDate(v2)
    
    If i1 < i2 Then
        CompareDates = IIf(gbSortOrder, 2, 0)
    ElseIf i1 = i2 Then
        CompareDates = 1
    Else
        CompareDates = IIf(gbSortOrder, 0, 2)
    End If
End Function






-----Original Message-----
From: Ned [mailto:nedashraf@h...] 
Sent: Thursday, November 21, 2002 12:14 AM
To: professional vb
Subject: [pro_vb] How to sort Date column in ListView

Hi everyone,

As you all know in ListView every columns are in string format. I want to 
sort the records if someone click on the date column header. Somehow its 
build in function does not work. Any help is appreciated.

Ned

Soundex example worked beautiful thanx

  Return to Index