Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
Public sOrder As Boolean
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINTAPI
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 String
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
Public Const LVFI_PARAM As Long = &H1
Public Const LVIF_TEXT As Long = &H1
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Public Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Public Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
'API declarations
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Function CompareDates(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
Dim dDate1 As Date
Dim dDate2 As Date
dDate1 = ListView_GetItemDate(hWnd, lParam1)
dDate2 = ListView_GetItemDate(hWnd, lParam2)
Select Case sOrder
Case True: 'sort descending
If dDate1 < dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else: CompareDates = 2
End If
Case Else: 'sort ascending
If dDate1 > dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else: CompareDates = 2
End If
End Select
End Function
Public Function CompareValues(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
Dim val1 As Long
Dim val2 As Long
val1 = ListView_GetItemValueStr(hWnd, lParam1)
val2 = ListView_GetItemValueStr(hWnd, lParam2)
Select Case sOrder
Case True: 'sort descending
If val1 < val2 Then
CompareValues = 0
ElseIf val1 = val2 Then
CompareValues = 1
Else: CompareValues = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
CompareValues = 0
ElseIf val1 = val2 Then
CompareValues = 1
Else: CompareValues = 2
End If
End Select
End Function
Public Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
Dim hIndex As Long
Dim r As Long
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
objItem.mask = LVIF_TEXT
objItem.iSubItem = 1
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
If r > 0 Then
ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
End If
End Function
Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long
Dim hIndex As Long
Dim r As Long
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
objItem.mask = LVIF_TEXT
objItem.iSubItem = 2
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
If r > 0 Then
ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
End If
End Function
Public Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
我的问题是,第1,2,3栏排序都没有问题,为什么第四栏排序它却总是按第3栏来排?
Public objItem As LV_ITEM
Public sOrder As Boolean
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type LV_FINDINFO
flags As Long
psz As String
lParam As Long
pt As POINTAPI
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 String
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
Public Const LVFI_PARAM As Long = &H1
Public Const LVIF_TEXT As Long = &H1
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Public Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Public Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
'API declarations
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Function CompareDates(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
Dim dDate1 As Date
Dim dDate2 As Date
dDate1 = ListView_GetItemDate(hWnd, lParam1)
dDate2 = ListView_GetItemDate(hWnd, lParam2)
Select Case sOrder
Case True: 'sort descending
If dDate1 < dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else: CompareDates = 2
End If
Case Else: 'sort ascending
If dDate1 > dDate2 Then
CompareDates = 0
ElseIf dDate1 = dDate2 Then
CompareDates = 1
Else: CompareDates = 2
End If
End Select
End Function
Public Function CompareValues(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal hWnd As Long) As Long
Dim val1 As Long
Dim val2 As Long
val1 = ListView_GetItemValueStr(hWnd, lParam1)
val2 = ListView_GetItemValueStr(hWnd, lParam2)
Select Case sOrder
Case True: 'sort descending
If val1 < val2 Then
CompareValues = 0
ElseIf val1 = val2 Then
CompareValues = 1
Else: CompareValues = 2
End If
Case Else: 'sort ascending
If val1 > val2 Then
CompareValues = 0
ElseIf val1 = val2 Then
CompareValues = 1
Else: CompareValues = 2
End If
End Select
End Function
Public Function ListView_GetItemDate(hWnd As Long, lParam As Long) As Date
Dim hIndex As Long
Dim r As Long
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
objItem.mask = LVIF_TEXT
objItem.iSubItem = 1
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
If r > 0 Then
ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
End If
End Function
Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long
Dim hIndex As Long
Dim r As Long
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
objItem.mask = LVIF_TEXT
objItem.iSubItem = 2
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
If r > 0 Then
ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
End If
End Function
Public Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
我的问题是,第1,2,3栏排序都没有问题,为什么第四栏排序它却总是按第3栏来排?
解决方案 »
- 【VB】如何自动登录SkyDrive网盘,微软的网盘怎么自动登录?????
- 一个关于RICHTEXTBOX的问题
- 请问各位从哪里能找到VB高手?或是WINDOWS编程高手?或API高手?
- fsdaffsdaf
- 我的程序为什么会这样呢
- 两个问题 。1个关于treeview 另外一个和控件位置有关
- 怎么会出现乱码的?
- 关于VB全盘搜索指定EXE文件并打开的问题。请能人解决!谢谢。
- 想把tab控件的变成enable,在哪设它的属性,我选了enable那个框,可是其他的几个tab都用不成了!!!!111
- 一般情况下(典型地如开发一个百兆局域网下运行的系统),建立ADO的connect、command及recordset对象
- 怎么样获取临时文件夹的图标?
- VB中文件拷贝的问题
'================================================================
'中窗体中调用
Private Sub Form_Load()
Dim itmX As ListItem
Dim itmH As ColumnHeader 'Add three Column Headers to the control
Set itmH = ListView1.ColumnHeaders.Add(Text:="Name")
Set itmH = ListView1.ColumnHeaders.Add(Text:="Date")
Set itmH = ListView1.ColumnHeaders.Add(Text:="Value1")
Set itmH = ListView1.ColumnHeaders.Add(Text:="Value2") 'Set the ListView to Report view
ListView1.View = lvwReport 'Add some data to the ListView control
Set itmX = ListView1.ListItems.Add(Text:="Joe")
itmX.SubItems(1) = "05/07/97"
itmX.SubItems(2) = "44"
itmX.SubItems(3) = "-5" Set itmX = ListView1.ListItems.Add(Text:="Sally")
itmX.SubItems(1) = "04/08/93"
itmX.SubItems(2) = "16"
itmX.SubItems(3) = "11" Set itmX = ListView1.ListItems.Add(Text:="Bill")
itmX.SubItems(1) = "05/29/94"
itmX.SubItems(2) = "1"
itmX.SubItems(3) = "8" Set itmX = ListView1.ListItems.Add(Text:="Fred")
itmX.SubItems(1) = "03/17/95"
itmX.SubItems(2) = "215"
itmX.SubItems(3) = "2" Set itmX = ListView1.ListItems.Add(Text:="Anne")
itmX.SubItems(1) = "07/01/97"
itmX.SubItems(2) = "20"
itmX.SubItems(3) = "18" Set itmX = ListView1.ListItems.Add(Text:="Bob")
itmX.SubItems(1) = "04/01/91"
itmX.SubItems(2) = "21"
itmX.SubItems(3) = "7" Set itmX = ListView1.ListItems.Add(Text:="John")
itmX.SubItems(1) = "12/25/92"
itmX.SubItems(2) = "176"
itmX.SubItems(3) = "-19" Set itmX = ListView1.ListItems.Add(Text:="Paul")
itmX.SubItems(1) = "11/23/95"
itmX.SubItems(2) = "113"
itmX.SubItems(3) = "15" Set itmX = ListView1.ListItems.Add(Text:="Maria")
itmX.SubItems(1) = "02/01/96"
itmX.SubItems(2) = "567"
itmX.SubItems(3) = "-9" Set itmX = Nothing
Set itmH = Nothing End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'toggle the sort order for use in the CompareXX routines
sOrder = Not sOrder ListView1.SortKey = ColumnHeader.Index - 1 Select Case ColumnHeader.Index - 1
Case 0:
'Use default sorting to sort the items in the list
ListView1.SortKey = 0
ListView1.SortOrder = Abs(sOrder) '=Abs(Not ListView1.SortOrder = 1)
ListView1.Sorted = True Case 1:
'Use sort routine to sort by date
ListView1.Sorted = False
SendMessage ListView1.hWnd, _
LVM_SORTITEMS, _
ListView1.hWnd, _
ByVal FARPROC(AddressOf CompareDates) Case 2:
'Use sort routine to sort by value
ListView1.Sorted = False
SendMessage ListView1.hWnd, _
LVM_SORTITEMS, _
ListView1.hWnd, _
ByVal FARPROC(AddressOf CompareValues)
Case 3:
'Use sort routine to sort by value
ListView1.Sorted = False
SendMessage ListView1.hWnd, _
LVM_SORTITEMS, _
ListView1.hWnd, _
ByVal FARPROC(AddressOf CompareValues) End Select
End Sub
点击第1,2,3栏标题排序都没有问题,为什么第四栏排序它却总是按第3栏来排?
为何只可以排列1-3?原因是:
- 第一个是VB Listview的排序功能,所以没有问题。
- 第二个是日期,所以你直接套用那组代码,永远只会在按第2个的时候,排序日期。
- 第三个是数字,跟上同样。我已经修改出自己要的东西了,你参考下~~
Public Function ListView_GetItemValueStr(hWnd As Long, lParam As Long) As Long
Dim hIndex As Long
Dim r As Long
objFind.flags = LVFI_PARAM
objFind.lParam = lParam
hIndex = SendMessage(hWnd, LVM_FINDITEM, -1, objFind)
objItem.mask = LVIF_TEXT
objItem.iSubItem = 2 ---〉根据这个代码,永远只排列第2个。你按照这个修改去 4 就可以了。
objItem.pszText = Space$(32)
objItem.cchTextMax = Len(objItem.pszText)
r = SendMessage(hWnd, LVM_GETITEMTEXT, hIndex, objItem)
If r > 0 Then
ListView_GetItemValueStr = CLng(Left$(objItem.pszText, r))
End If
End Function