这种方法最方便,严重推荐
在点击数字列头的事件中,首先将数字变一下格式,将列的内容变为:format(列的内容,"000000000000")，再将listview控件的索引值设为TRUE,最后将列的内容改回来val(列的内容)。
'在form上加listview1控件,view值设为3,加上下面一段程序
Private Sub Form_Load()
ListView1.ColumnHeaders.Add , , "Size"
For i = 1 To 100
ListView1.ListItems.Add , , Int(Rnd * 10000)
Next
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim i As Integer
ListView1.SortKey = ColumnHeader.Index - 1
'以下是按SIZE排序的程序
If ColumnHeader.Text = "Size" Then
For i = 1 To ListView1.ListItems.Count
ListView1.ListItems(i).Text = Format(ListView1.ListItems(i).Text, "000000000000")
Next
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
ListView1.Sorted = True
For i = 1 To ListView1.ListItems.Count
ListView1.ListItems(i).Text = Val(ListView1.ListItems(i).Text)
Next
End If
End Sub
=================================================
現將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
===========================================================
还有一篇MSDN的