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栏来排?      
    
   

解决方案 »

  1.   

    因为超过字符限制,所以调用在下面
     '================================================================
      '中窗体中调用
      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栏来排? 
      

  2.   

    你的代码是在 外国vb某个著名网站下载的。之前我也用过。
    为何只可以排列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