modlistviewsort.bas

WinBig. A file archive utility written in VB. Compression and decompression routines are LZSS. Full

Attribute VB_Name = "modListviewSort"
Option Explicit

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

'Module Functions and Procedures

'LVSortNums: This is the sorting routine that gets passed to the
'ListView control to provide the comparison test for date values.
Public Function LVSortNums(ByVal lngParam1 As Long, ByVal lngParam2 As Long, ByVal hWnd As Long) As Long
    Dim lone As Long
    Dim ltwo As Long
    
    lone = CLng(ListView_GetItemData(lngParam1, hWnd, fFrmMain.lvList.SortKey))
    ltwo = CLng(ListView_GetItemData(lngParam2, hWnd, fFrmMain.lvList.SortKey))
    
    'Compare the dates
    'Return 0 ==> Less Than
    '       1 ==> Equal
    '       2 ==> Greater Than
    If lone < ltwo Then
        If fFrmMain.lvList.SortOrder = lvwAscending Then
          LVSortNums = 0
        Else
          LVSortNums = 2
        End If
    ElseIf lone > ltwo Then
        If fFrmMain.lvList.SortOrder = lvwAscending Then
          LVSortNums = 2
        Else
          LVSortNums = 0
        End If
    ElseIf lone = ltwo Then
      LVSortNums = 1
    End If

End Function

Public Function ListView_GetItemData(lngParam As Long, hWnd As Long, Item As Integer) 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))
    
    '
    ' Obtain the modification long of the specified list view item
    '
    objItem.mask = LVIF_TEXT
    objItem.iSubItem = Item
    objItem.pszText = VarPtr(baBuffer(0))
    objItem.cchTextMax = UBound(baBuffer)
    lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
    If lngLength > 0 Then
        ListView_GetItemData = Left$(StrConv(baBuffer, vbUnicode), lngLength)
    End If
End Function

Public Function ListView_GetListItem(lngIndex As Long, hWnd As Long, Item As Integer) As String
  Dim objItem As LV_ITEM
  Dim baBuffer(32) As Byte
  Dim lngLength As Long

  '
  ' Obtain the modification date of the specified list view item
  '
  objItem.mask = LVIF_TEXT
  objItem.iSubItem = Item
  objItem.pszText = VarPtr(baBuffer(0))
  objItem.cchTextMax = UBound(baBuffer)
  lngLength = SendMessage(hWnd, LVM_GETITEMTEXT, lngIndex, VarPtr(objItem))
  If lngLength > 0 Then
    ListView_GetListItem = Left$(StrConv(baBuffer, vbUnicode), lngLength)
  End If
End Function