Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Public Enum eSortType
eByDate = 1
eByNumber = 2
eByString = 3
End Enum
Public Sub SortListView(pListView As ListView, pSortType As eSortType, pColumnHeaderIndex As Integer)
Dim l As Long
Dim strFormat As String
Dim strData() As String
Dim lngCursor As Long
Dim lngIndex As Long
On Error Resume Next
With pListView
' Display the hourglass cursor whilst sorting
lngCursor = .MousePointer
.MousePointer = vbHourglass
' Prevent the ListView control from updating on screen -
' this is to hide the changes being made to the listitems
' and also to speed up the sort
LockWindowUpdate .hWnd
lngIndex = pColumnHeaderIndex - 1
Select Case pSortType
Case eByDate
' Sort by date.
strFormat = "YYYYMMDDHhNnSs"
With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .Item(l).ListSubItems(lngIndex)
.Tag = .Text & vbNullChar & .Tag
If IsDate(.Text) Then
.Text = Format(CDate(.Text), _
strFormat)
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
With .Item(l)
.Tag = .Text & vbNullChar & .Tag
If IsDate(.Text) Then
.Text = Format(CDate(.Text), _
strFormat)
Else
.Text = ""
End If
End With
Next l
End If
End With
With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .Item(l).ListSubItems(lngIndex)
strData = Split(.Tag, vbNullChar)
.Text = strData(0)
.Tag = strData(1)
End With
Next l
Else
For l = 1 To .Count
With .Item(l)
strData = Split(.Tag, vbNullChar)
.Text = strData(0)
.Tag = strData(1)
End With
Next l
End If
End With
Case eByNumber
' Sort Numerically
strFormat = String(30, "0") & "." & String(30, "0")
With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .Item(l).ListSubItems(lngIndex)
.Tag = .Text & vbNullChar & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), _
strFormat)
Else
.Text = "&" & InvertNumber( _
Format(0 - CDbl(.Text), _
strFormat))
End If
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .Count
With .Item(l)
.Tag = .Text & vbNullChar & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), _
strFormat)
Else
.Text = "&" & InvertNumber( _
Format(0 - CDbl(.Text), _
strFormat))
End If
Else
.Text = ""
End If
End With
Next l
End If
End With
With .ListItems
If (lngIndex > 0) Then
For l = 1 To .Count
With .Item(l).ListSubItems(lngIndex)
strData = Split(.Tag, vbNullChar)
.Text = strData(0)
.Tag = strData(1)
End With
Next l
Else
For l = 1 To .Count
With .Item(l)
strData = Split(.Tag, vbNullChar)
.Text = strData(0)
.Tag = strData(1)
End With
Next l
End If
End With
Case Else
End Select
.SortOrder = (.SortOrder + 1) Mod 2
.SortKey = pColumnHeaderIndex - 1
.Sorted = True
' Unlock the list window so that the OCX can update it
LockWindowUpdate 0&
' Restore the previous cursor
.MousePointer = lngCursor
End With
End Sub
Private Function InvertNumber(ByVal pNumber As String) As String
Static i As Integer
For i = 1 To Len(pNumber)
Select Case Mid$(pNumber, i, 1)
Case "-": Mid$(pNumber, i, 1) = " "
Case "0": Mid$(pNumber, i, 1) = "9"
Case "1": Mid$(pNumber, i, 1) = "8"
Case "2": Mid$(pNumber, i, 1) = "7"
Case "3": Mid$(pNumber, i, 1) = "6"
Case "4": Mid$(pNumber, i, 1) = "5"
Case "5": Mid$(pNumber, i, 1) = "4"
Case "6": Mid$(pNumber, i, 1) = "3"
Case "7": Mid$(pNumber, i, 1) = "2"
Case "8": Mid$(pNumber, i, 1) = "1"
Case "9": Mid$(pNumber, i, 1) = "0"
End Select
Next
InvertNumber = pNumber
End Function