不知道各位有沒有發現，ListBox   及   ComboBox   的   Sorted   屬性在遇到數字後有點怪怪的，是有排序沒錯，但是它似乎將數字當作文字排序了！所以排出來的效果和我們真正想要的並不完全相同。其實這情形不只發生在   ListBox   及   ComboBox   而已，檔案總管的檔案排也有同樣的情形，讓我們來看看：

ListBox   及   ComboBox   的   Sorted   屬性設為   True                        
  1   12   2  
我們真正想要的結果
1   2   12

'以下這個模組就是用來排序數字用的，得到的結果，就如同上方右邊的結果！

Sub   ReSort(L   As   Control)
        Dim   P%,   PP%,   C%,   Pre$,   S$,   V&,   NewPos%,   CheckIt%
        Dim   TempL$,   TempItemData&,   S1$
        For   P   =   0   To   L.ListCount   -   1
                S   =   L.List(P)
                For   C   =   1   To   Len(S)
                        V   =   Val(Mid$(S,   C))
                        If   V   >   0   Then   Exit   For
                Next
                If   V   >   0   Then
                        If   C   >   1   Then   Pre   =   Left$(S,   C   -   1)
                        NewPos   =   -1
                        For   PP   =   P   +   1   To   L.ListCount   -   1
                                CheckIt   =   False
                                S1   =   L.List(PP)
                                If   Pre   <>   " "   Then
                                        If   InStr(S1,   Pre)   =   1   Then   CheckIt   =   True
                                Else
                                        If   Val(S1)   >   0   Then   CheckIt   =   True
                                End   If
                                If   CheckIt   Then
                                        If   Val(Mid$(S1,   C))   <   V   Then   NewPos   =   PP
                                Else
                                        Exit   For
                                End   If
                        Next
                        If   NewPos   >   -1   Then
                                TempL   =   L.List(P)
                                TempItemData   =   L.ItemData(P)
                                L.RemoveItem   (P)
                                L.AddItem   TempL,   NewPos
                                L.ItemData(L.NewIndex)   =   TempItemData
                                P   =   P   -   1
                        End   If
                End   If
        Next
End   Sub
'實際使用時，需傳入控制項的名稱，例如：

Private   Sub   Command1_Click()
        Call   ReSort(List1)
End   Sub

>>>>>>>>>>>>>>>>>>>>>>>>>

找到一段api搞定的,有些聲明是多余的,自己整理吧..
三種排序方法已經封裝成函數
Public   Enum   LVStylesEx
      CheckBoxes   =   LVS_EX_CHECKBOXES
      FullRowSelect   =   LVS_EX_FULLROWSELECT
      GridLines   =   LVS_EX_GRIDLINES
      HeaderDragDrop   =   LVS_EX_HEADERDRAGDROP
      SubItemImages   =   LVS_EX_SUBITEMIMAGES
      TrackSelect   =   LVS_EX_TRACKSELECT
End   Enum

'---   Sorting   Variables   --- '
Public   Enum   LVItemTypes
      lvDate   =   0
      lvNumber   =   1
      lvBinary   =   2
      lvAlphabetic   =   3
End   Enum
Public   Enum   LVSortTypes
      lvAscending   =   0
      lvDescending   =   1
End   Enum

Public   BuildLookup   As   Long
Public   PerformSort   As   Long

'   *********************************************************
'     Knowledge   Base-based   Sorting   Routines
'   *********************************************************
Public   Function   LVSortK(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
     
      '   turn   off   the   default   sorting   of   the   control
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With

      '   store   some   values   used   during   the   sort
      m_lvSortColumn   =   Index
      m_lvSortType   =   ItemType
      m_lvHWnd   =   lv.hWnd
      BuildLookup   =   0
     
      '   start   sorting   to   type-specific   callback   routines
      tmr.Reset
      Select   Case   ItemType
            Case   lvDate
                  Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareDates)
            Case   lvNumber
                  Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareNumbers)
      End   Select
      PerformSort   =   tmr.Elapsed
End   Function

Private   Function   LVCompareDates(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   dat1   As   Date
      Static   dat2   As   Date
     
      '   lookup   text   in   listview   based   on   index,   and   convert   to   date
      On   Error   Resume   Next
      dat1   =   CDate(LVGetItemText(lParam1,   m_lvHWnd))
      dat2   =   CDate(LVGetItemText(lParam2,   m_lvHWnd))
      On   Error   GoTo   0

      '---   this   sorts   ascending
      LVCompareDates   =   Sgn(dat1   -   dat2)
     
      '---   this   sorts   descending
      If   SortOrder   =   lvDescending   Then
            LVCompareDates   =   -LVCompareDates
      End   If
End   Function

Private   Function   LVCompareNumbers(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   dat1   As   Double
      Static   dat2   As   Double
     
      '   lookup   text   in   listview   based   on   index,   and   convert   to   double
      On   Error   Resume   Next
      dat1   =   CDbl(LVGetItemText(lParam1,   m_lvHWnd))
      dat2   =   CDbl(LVGetItemText(lParam2,   m_lvHWnd))
      On   Error   GoTo   0
     
      '---   this   sorts   ascending
      LVCompareNumbers   =   Sgn(dat1   -   dat2)
     
      '---   this   sorts   descending
      If   SortOrder   =   lvDescending   Then
            LVCompareNumbers   =   -LVCompareNumbers
      End   If
End   Function

Public   Function   LVGetItemText(lParam   As   Long,   hWnd   As   Long)   As   String
      Dim   objFind   As   LV_FINDINFO
      Dim   Index   As   Long
      Dim   objItem   As   LV_ITEM
      Dim   nRet   As   Long
     
      '   Convert   the   input   parameter   to   an   index   in   the   list   view
      With   objFind
            .Flags   =   LVFI_PARAM
            .lParam   =   lParam
      End   With
      Index   =   SendMessage(hWnd,   LVM_FINDITEM,   -1,   objFind)
     
      '   Obtain   the   name   of   the   specified   list   view   item
      With   objItem
            .Mask   =   LVIF_TEXT
            .SubItem   =   m_lvSortColumn
            .Text   =   Space(32)
            .TextMax   =   Len(.Text)
      End   With
     
      '   Grab   the   text
      nRet   =   SendMessage(hWnd,   LVM_GETITEMTEXT,   Index,   objItem)
      If   nRet   Then
            LVGetItemText   =   Left$(objItem.Text,   nRet)
      End   If
End   Function

'   *********************************************************
'     Collection-based   Sorting   Routines
'   *********************************************************
Public   Function   LVSortC(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
     
      '   turn   off   the   default   sorting   of   the   control
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With

      '   prepare   collection   of   data   for   quicker   lookups   during   callbacks
      tmr.Reset
      Call   LVPrepareSortCollection(lv,   Index,   ItemType)
      BuildLookup   =   tmr.Elapsed
     
      '   initiate   sort   then   delete   collection
      tmr.Reset
      Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompare)
      PerformSort   =   tmr.Elapsed
     
      '   delete   collection   of   sort   data
      Set   m_lvSortColl   =   Nothing
End   Function

Private   Function   LVCompare(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      '---   this   sorts   ascending
      With   m_lvSortColl
            LVCompare   =   Sgn(.Item( "k "   &   lParam1)   -   .Item( "k "   &   lParam2))
      End   With
           
      '---   this   sorts   descending
      If   SortOrder   =   lvDescending   Then
            LVCompare   =   -LVCompare
      End   If
End   Function

Private   Function   LVPrepareSortCollection(lv   As   ListView,   ByVal   SubItemIndex   As   Long,   ByVal   ItemType   As   LVItemTypes)   As   Boolean
      Dim   i   As   Long,   n   As   Long
      Dim   lvi   As   LV_ITEM
      Dim   dat   As   Date
     
      '   initialize   collection
      Set   m_lvSortColl   =   New   Collection
     
      '   obtain   the   ItemData   value   and   string   for   each   item   in   the   list
      With   lvi
            .Mask   =   LVIF_TEXT   Or   LVIF_PARAM
            .SubItem   =   SubItemIndex
            .TextMax   =   256
            .Text   =   Space(256)
            If   ItemType   =   lvDate   Then
                  For   i   =   1   To   lv.ListItems.Count
                        .Index   =   i   -   1
                        Call   SendMessage(lv.hWnd,   LVM_GETITEM,   0&,   lvi)
                        n   =   InStr(.Text,   vbNullChar)
                        If   n   >   1   Then
                              On   Error   Resume   Next
                                    dat   =   CDate(Left$(.Text,   n   -   1))
                              On   Error   GoTo   0
                              m_lvSortColl.Add   dat,   "k "   &   .Param
                        Else
                              m_lvSortColl.Add   0,   "k "   &   .Param
                        End   If
                  Next   i
            ElseIf   ItemType   =   lvNumber   Then
                  For   i   =   1   To   lv.ListItems.Count
                        .Index   =   i   -   1
                        Call   SendMessage(lv.hWnd,   LVM_GETITEM,   0&,   lvi)
                        n   =   InStr(.Text,   vbNullChar)
                        If   n   >   1   Then
                              m_lvSortColl.Add   CDbl(Left$(.Text,   n   -   1)),   "k "   &   .Param
                        Else
                              m_lvSortColl.Add   0,   "k "   &   .Param
                        End   If
                  Next   i
            End   If
      End   With
End   Function

'   *********************************************************
'     IListItem-based   Sorting   Routines
'   *********************************************************
Public   Function   LVSortI(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
     
      '   turn   off   the   default   sorting   of   the   control
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With

      '   no   lookups   used   by   this   method
      BuildLookup   =   0
     
      '   need   to   use   module   variables   to   let   compare   routine   know
      '   which   column   and   method   to   use
      m_lvSortColumn   =   Index
      m_lvSortType   =   ItemType
     
      '   fire   off   sorting
      tmr.Reset
      Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareI)
      PerformSort   =   tmr.Elapsed
     
      '   delete   collection   of   sort   data
      Set   m_lvSortColl   =   Nothing
End   Function

Private   Function   LVCompareI(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   ListItem1   As   ListItem
      Static   ListItem2   As   ListItem
      Static   sItem1   As   String
      Static   sItem2   As   String
     
      '   WARNING:   This   method   *will*   likely   break   in   the   future!
      '   Glom   references   to   internal   ListItem   class   using   magic   number
      CopyMem   ListItem1,   lParam1   +   84,   4
      CopyMem   ListItem2,   lParam2   +   84,   4
     
      '   Grab   text   items   of   interest
      If   m_lvSortColumn   =   0   Then
            sItem1   =   ListItem1.Text
            sItem2   =   ListItem2.Text
      Else
            sItem1   =   ListItem1.SubItems(m_lvSortColumn)
            sItem2   =   ListItem2.SubItems(m_lvSortColumn)
      End   If
     
      '   Clean   up   hacked   reference
      CopyMem   ListItem1,   Nothing,   4
      CopyMem   ListItem2,   Nothing,   4
     
      '   Perform   ascending   comparison
      On   Error   GoTo   Failure
            Select   Case   m_lvSortType
                  Case   lvDate
                        LVCompareI   =   Sgn(CDate(sItem1)   -   CDate(sItem2))
                  Case   lvNumber
                        LVCompareI   =   Sgn(CDbl(sItem1)   -   CDbl(sItem2))
                  Case   lvBinary
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbBinaryCompare)
                  Case   lvAlphabetic
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbTextCompare)
                  Case   Else   '   default   ascending   text
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbTextCompare)
            End   Select
      On   Error   GoTo   0
     
      '   Negate   if   descending
      If   SortOrder   =   lvDescending   Then
            LVCompareI   =   -LVCompareI
      End   If
      Exit   Function
     
Failure:
      '   Bail   with   0   for   failed   comparison,   because   it 's   "just   a   visual   sort "   <g>
      '   Might   want   to   return   failure   code   in   real   app   by   setting   flag   here.
      Exit   Function
End   Function

>>>>>>>>>>>>>>>>>>>>>>>>>>

現將LISTVIEW的排序方法整理出來共大家參考
排序控制加在ListView1_ColumnClick事件中,可以有3種排序方法,支持lvDate   ,       lvNumber   ,       lvBinary   ,lvAlphabetic   四種類型
Private   Sub   ListView1_ColumnClick(ByVal   ColumnHeader   As   ComctlLib.ColumnHeader)
  With   ListView1
            .SortKey   =   ColumnHeader.Index   -   1
            .SortOrder   =   Abs(Not   .SortOrder   =   1)
            '**********//KB   method********
                        LVSortK   ListView1,   .SortKey,   lvDate,   .SortOrder
            '**********// 'collection   method*************
                        LVSortC   ListView1,   .SortKey,   lvDate,   .SortOrder
            '**************//IListView   hack   method*********************
                        LVSortI   ListView1,   .SortKey,   lvDate,   .SortOrder
            End   If
      End   With
END   SUB

調整列寬..       Call   LVSetAllColWidths(ListView1,   LVSCW_AUTOSIZE_USEHEADER)   '可在模塊中修改參數

'LISTVIEWK控制模塊,放在標准模塊中

Option   Explicit

Private   Declare   Function   GetClientRect   Lib   "user32 "   (ByVal   hWnd   As   Long,   lpRect   As   RECT)   As   Long
Private   Declare   Function   GetWindowRect   Lib   "user32 "   (ByVal   hWnd   As   Long,   lpRect   As   RECT)   As   Long
Private   Declare   Function   InvalidateRect   Lib   "user32 "   (ByVal   hWnd   As   Long,   lpRect   As   RECT,   ByVal   bErase   As   Long)   As   Long
Private   Declare   Function   SendMessage   Lib   "user32 "   Alias   "SendMessageA "   (ByVal   hWnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long
Private   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
Private   Declare   Sub   CopyMem   Lib   "kernel32 "   Alias   "RtlMoveMemory "   (Destination   As   Any,   Source   As   Any,   ByVal   Length   As   Long)

Private   Type   POINT
      X   As   Long
      Y   As   Long
End   Type

Private   Type   RECT
      Left   As   Long
      Top   As   Long
      Right   As   Long
      Bottom   As   Long
End   Type

Private   Const   LVM_FIRST   As   Long   =   &H1000
Private   Const   LVM_GETITEM   As   Long   =   LVM_FIRST   +   5
Private   Const   LVM_FINDITEM   As   Long   =   LVM_FIRST   +   13
Private   Const   LVM_ENSUREVISIBLE   =   LVM_FIRST   +   19
Private   Const   LVM_SETCOLUMNWIDTH   As   Long   =   LVM_FIRST   +   30
Private   Const   LVM_GETTOPINDEX   =   LVM_FIRST   +   39
Private   Const   LVM_SETITEMSTATE   As   Long   =   LVM_FIRST   +   43
Private   Const   LVM_GETITEMSTATE   As   Long   =   LVM_FIRST   +   44
Private   Const   LVM_GETITEMTEXT   As   Long   =   LVM_FIRST   +   45
Private   Const   LVM_SORTITEMS   As   Long   =   LVM_FIRST   +   48
Private   Const   LVM_SETEXTENDEDLISTVIEWSTYLE   As   Long   =   LVM_FIRST   +   54
Private   Const   LVM_GETEXTENDEDLISTVIEWSTYLE   As   Long   =   LVM_FIRST   +   55
Private   Const   LVM_SETCOLUMNORDERARRAY   =   LVM_FIRST   +   58
Private   Const   LVM_GETCOLUMNORDERARRAY   =   LVM_FIRST   +   59

Private   Const   LVS_EX_GRIDLINES   As   Long   =   &H1
Private   Const   LVS_EX_SUBITEMIMAGES   As   Long   =   &H2
Private   Const   LVS_EX_CHECKBOXES   As   Long   =   &H4
Private   Const   LVS_EX_TRACKSELECT   As   Long   =   &H8
Private   Const   LVS_EX_HEADERDRAGDROP   As   Long   =   &H10
Private   Const   LVS_EX_FULLROWSELECT   As   Long   =   &H20

Private   Const   LVFI_PARAM   As   Long   =   1

Private   Const   LVIF_TEXT   As   Long   =   1
Private   Const   LVIF_IMAGE   As   Long   =   2
Private   Const   LVIF_PARAM   As   Long   =   4
Private   Const   LVIF_STATE   As   Long   =   8
Private   Const   LVIF_INDENT   As   Long   =   &H10
Private   Const   LVIF_NORECOMPUTE   As   Long   =   &H800
Private   Const   LVIS_STATEIMAGEMASK   As   Long   =   &HF000&

Private   Type   LV_ITEM
      Mask   As   Long
      Index   As   Long
      SubItem   As   Long
      State   As   Long
      StateMask   As   Long
      Text   As   String
      TextMax   As   Long
      Icon   As   Long
      Param   As   Long
      Indent   As   Long
End   Type

Private   Type   LV_FINDINFO
      Flags   As   Long
      pSz   As   String
      lParam   As   Long
      pt   As   POINT
      vkDirection   As   Long
End   Type


'---   Array   used   to   speed   custom   sorts   --- '
Private   m_lvSortData()   As   LV_ITEM
Private   m_lvSortColl   As   Collection
Private   m_lvSortColumn   As   Long
Private   m_lvHWnd   As   Long
Private   m_lvSortType   As   LVItemTypes

Public   Enum   LVSCW_Styles
      LVSCW_AUTOSIZE   =   -1
      LVSCW_AUTOSIZE_USEHEADER   =   -2
End   Enum

Public   Enum   LVStylesEx
      CheckBoxes   =   LVS_EX_CHECKBOXES
      FullRowSelect   =   LVS_EX_FULLROWSELECT
      GridLines   =   LVS_EX_GRIDLINES
      HeaderDragDrop   =   LVS_EX_HEADERDRAGDROP
      SubItemImages   =   LVS_EX_SUBITEMIMAGES
      TrackSelect   =   LVS_EX_TRACKSELECT
End   Enum

Public   Enum   LVItemTypes
      lvDate   =   0
      lvNumber   =   1
      lvBinary   =   2
      lvAlphabetic   =   3
End   Enum
Public   Enum   LVSortTypes
      lvAscending   =   0
      lvDescending   =   1
End   Enum

Public   BuildLookup   As   Long
Public   PerformSort   As   Long

Public   Function   LVSetStyleEx(lv   As   ListView,   ByVal   NewStyle   As   LVStylesEx,   ByVal   NewVal   As   Boolean)   As   Boolean
      Dim   nStyle   As   Long
     
      nStyle   =   SendMessage(lv.hWnd,   LVM_GETEXTENDEDLISTVIEWSTYLE,   0&,   ByVal   0&)
     
      If   NewVal   Then
            nStyle   =   nStyle   Or   NewStyle
      Else
            nStyle   =   nStyle   Xor   NewStyle
      End   If

      LVSetStyleEx   =   CBool(SendMessage(lv.hWnd,   LVM_SETEXTENDEDLISTVIEWSTYLE,   0&,   ByVal   nStyle))
End   Function

Public   Function   LVGetColOrder(lv   As   ListView)   As   Variant
      Dim   cols()   As   Long
      Dim   nRet   As   Long
      With   lv
            ReDim   cols(0   To   .ColumnHeaders.Count   -   1)   As   Long
            nRet   =   SendMessage(.hWnd,   LVM_GETCOLUMNORDERARRAY,   .ColumnHeaders.Count,   cols(0))
            If   nRet   Then
                  LVGetColOrder   =   cols
            End   If
      End   With
End   Function

Public   Function   LVSetColOrder(lv   As   ListView,   cols()   As   Long)   As   Boolean
      Dim   nRet   As   Long
      Dim   rClient   As   RECT
      With   lv
            If   (UBound(cols)   +   1)   =   .ColumnHeaders.Count   Then
                  nRet   =   SendMessage(.hWnd,   LVM_SETCOLUMNORDERARRAY,   .ColumnHeaders.Count,   cols(0))
                  LVSetColOrder   =   CBool(nRet)
                  Call   GetClientRect(.hWnd,   rClient)
                  Call   InvalidateRect(.hWnd,   rClient,   True)
            End   If
      End   With
End   Function

Public   Sub   LVSetColWidth(lv   As   ListView,   ByVal   ColumnIndex   As   Long,   ByVal   Style   As   LVSCW_Styles)
      With   lv
            If   .View   =   lvwReport   Then
                  If   ColumnIndex   > =   1   And   ColumnIndex   <=   .ColumnHeaders.Count   Then
                        Call   SendMessage(.hWnd,   LVM_SETCOLUMNWIDTH,   ColumnIndex   -   1,   ByVal   Style)
                  End   If
            End   If
      End   With
End   Sub

Public   Sub   LVSetAllColWidths(lv   As   ListView,   ByVal   Style   As   LVSCW_Styles)
      Dim   ColumnIndex   As   Long
      With   lv
            For   ColumnIndex   =   1   To   .ColumnHeaders.Count
                  LVSetColWidth   lv,   ColumnIndex,   Style
            Next   ColumnIndex
      End   With
End   Sub

Public   Function   LVItemChecked(lv   As   ListView,   ByVal   Index   As   Long)   As   Boolean
      Dim   nRet   As   Long
      Const   MaskBit   As   Long   =   &H1000       '(2   ^   12)
      nRet   =   SendMessage(lv.hWnd,   LVM_GETITEMSTATE,   Index   -   1,   ByVal   LVIS_STATEIMAGEMASK)
      LVItemChecked   =   (((nRet   \   MaskBit)   -   1)   <>   0)
End   Function

Public   Function   LVSetItemCheck(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   Value   As   Boolean)   As   Boolean
      Dim   lvi   As   LV_ITEM
      Index   =   Index   -   1
      lvi.Index   =   Index
      lvi.Mask   =   LVIF_STATE
      lvi.StateMask   =   LVIS_STATEIMAGEMASK
      Call   SendMessage(lv.hWnd,   LVM_GETITEM,   0&,   lvi)
      If   Value   Then
            lvi.State   =   (lvi.State   And   (Not   LVIS_STATEIMAGEMASK))   Or   &H2000
      Else
            lvi.State   =   (lvi.State   And   (Not   LVIS_STATEIMAGEMASK))   Or   &H1000
      End   If
      LVSetItemCheck   =   SendMessage(lv.hWnd,   LVM_SETITEMSTATE,   Index,   lvi)
End   Function

Public   Function   LVGetFirstVisible(lv   As   ListView)   As   Long
      LVGetFirstVisible   =   SendMessage(lv.hWnd,   LVM_GETTOPINDEX,   0&,   ByVal   0&)
End   Function

Public   Function   LVEnsureVisible(lv   As   ListView,   ByVal   Index   As   Long)   As   Boolean
      LVEnsureVisible   =   SendMessage(lv.hWnd,   LVM_ENSUREVISIBLE,   Index,   ByVal   0&)
End   Function
Public   Function   LVSortK(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With
      m_lvSortColumn   =   Index
      m_lvSortType   =   ItemType
      m_lvHWnd   =   lv.hWnd
      BuildLookup   =   0
      tmr.Reset
      Select   Case   ItemType
            Case   lvDate
                  Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareDates)
            Case   lvNumber
                  Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareNumbers)
      End   Select
      PerformSort   =   tmr.Elapsed
End   Function

Private   Function   LVCompareDates(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   dat1   As   Date
      Static   dat2   As   Date
      On   Error   Resume   Next
      dat1   =   CDate(LVGetItemText(lParam1,   m_lvHWnd))
      dat2   =   CDate(LVGetItemText(lParam2,   m_lvHWnd))
      On   Error   GoTo   0
      LVCompareDates   =   Sgn(dat1   -   dat2)
      If   SortOrder   =   lvDescending   Then
            LVCompareDates   =   -LVCompareDates
      End   If
End   Function

Private   Function   LVCompareNumbers(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   dat1   As   Double
      Static   dat2   As   Double
      On   Error   Resume   Next
      dat1   =   CDbl(LVGetItemText(lParam1,   m_lvHWnd))
      dat2   =   CDbl(LVGetItemText(lParam2,   m_lvHWnd))
      On   Error   GoTo   0
      LVCompareNumbers   =   Sgn(dat1   -   dat2)
      If   SortOrder   =   lvDescending   Then
            LVCompareNumbers   =   -LVCompareNumbers
      End   If
End   Function

Public   Function   LVGetItemText(lParam   As   Long,   hWnd   As   Long)   As   String
      Dim   objFind   As   LV_FINDINFO
      Dim   Index   As   Long
      Dim   objItem   As   LV_ITEM
      Dim   nRet   As   Long
      With   objFind
            .Flags   =   LVFI_PARAM
            .lParam   =   lParam
      End   With
      Index   =   SendMessage(hWnd,   LVM_FINDITEM,   -1,   objFind)
      With   objItem
            .Mask   =   LVIF_TEXT
            .SubItem   =   m_lvSortColumn
            .Text   =   Space(32)
            .TextMax   =   Len(.Text)
      End   With
      nRet   =   SendMessage(hWnd,   LVM_GETITEMTEXT,   Index,   objItem)
      If   nRet   Then
            LVGetItemText   =   Left$(objItem.Text,   nRet)
      End   If
End   Function
Public   Function   LVSortC(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With
      tmr.Reset
      Call   LVPrepareSortCollection(lv,   Index,   ItemType)
      BuildLookup   =   tmr.Elapsed
      tmr.Reset
      Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompare)
      PerformSort   =   tmr.Elapsed
      Set   m_lvSortColl   =   Nothing
End   Function

Private   Function   LVCompare(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      With   m_lvSortColl
            LVCompare   =   Sgn(.Item( "k "   &   lParam1)   -   .Item( "k "   &   lParam2))
      End   With
      If   SortOrder   =   lvDescending   Then
            LVCompare   =   -LVCompare
      End   If
End   Function

Private   Function   LVPrepareSortCollection(lv   As   ListView,   ByVal   SubItemIndex   As   Long,   ByVal   ItemType   As   LVItemTypes)   As   Boolean
      Dim   i   As   Long,   n   As   Long
      Dim   lvi   As   LV_ITEM
      Dim   dat   As   Date
      Set   m_lvSortColl   =   New   Collection
      With   lvi
            .Mask   =   LVIF_TEXT   Or   LVIF_PARAM
            .SubItem   =   SubItemIndex
            .TextMax   =   256
            .Text   =   Space(256)
            If   ItemType   =   lvDate   Then
                  For   i   =   1   To   lv.ListItems.Count
                        .Index   =   i   -   1
                        Call   SendMessage(lv.hWnd,   LVM_GETITEM,   0&,   lvi)
                        n   =   InStr(.Text,   vbNullChar)
                        If   n   >   1   Then
                              On   Error   Resume   Next
                                    dat   =   CDate(Left$(.Text,   n   -   1))
                              On   Error   GoTo   0
                              m_lvSortColl.Add   dat,   "k "   &   .Param
                        Else
                              m_lvSortColl.Add   0,   "k "   &   .Param
                        End   If
                  Next   i
            ElseIf   ItemType   =   lvNumber   Then
                  For   i   =   1   To   lv.ListItems.Count
                        .Index   =   i   -   1
                        Call   SendMessage(lv.hWnd,   LVM_GETITEM,   0&,   lvi)
                        n   =   InStr(.Text,   vbNullChar)
                        If   n   >   1   Then
                              m_lvSortColl.Add   CDbl(Left$(.Text,   n   -   1)),   "k "   &   .Param
                        Else
                              m_lvSortColl.Add   0,   "k "   &   .Param
                        End   If
                  Next   i
            End   If
      End   With
End   Function
Public   Function   LVSortI(lv   As   ListView,   ByVal   Index   As   Long,   ByVal   ItemType   As   LVItemTypes,   ByVal   SortOrder   As   LVSortTypes)   As   Boolean
      Dim   tmr   As   New   CStopWatch
      With   lv
            .Sorted   =   False
            .SortKey   =   Index
            .SortOrder   =   SortOrder
      End   With
      BuildLookup   =   0
      m_lvSortColumn   =   Index
      m_lvSortType   =   ItemType
      tmr.Reset
      Call   SendMessageLong(lv.hWnd,   LVM_SORTITEMS,   SortOrder,   AddressOf   LVCompareI)
      PerformSort   =   tmr.Elapsed
      Set   m_lvSortColl   =   Nothing
End   Function

Private   Function   LVCompareI(ByVal   lParam1   As   Long,   ByVal   lParam2   As   Long,   ByVal   SortOrder   As   Long)   As   Long
      Static   ListItem1   As   ListItem
      Static   ListItem2   As   ListItem
      Static   sItem1   As   String
      Static   sItem2   As   String
      CopyMem   ListItem1,   lParam1   +   84,   4
      CopyMem   ListItem2,   lParam2   +   84,   4
      If   m_lvSortColumn   =   0   Then
            sItem1   =   ListItem1.Text
            sItem2   =   ListItem2.Text
      Else
            sItem1   =   ListItem1.SubItems(m_lvSortColumn)
            sItem2   =   ListItem2.SubItems(m_lvSortColumn)
      End   If
      CopyMem   ListItem1,   Nothing,   4
      CopyMem   ListItem2,   Nothing,   4
      On   Error   GoTo   Failure
            Select   Case   m_lvSortType
                  Case   lvDate
                        LVCompareI   =   Sgn(CDate(sItem1)   -   CDate(sItem2))
                  Case   lvNumber
                        LVCompareI   =   Sgn(CDbl(sItem1)   -   CDbl(sItem2))
                  Case   lvBinary
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbBinaryCompare)
                  Case   lvAlphabetic
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbTextCompare)
                  Case   Else
                        LVCompareI   =   StrComp(sItem1,   sItem2,   vbTextCompare)
            End   Select
      On   Error   GoTo   0
      If   SortOrder   =   lvDescending   Then
            LVCompareI   =   -LVCompareI
      End   If
      Exit   Function
Failure:
      Exit   Function
End   Function

>>>>>>>>>>>>>>>>>