用循环太慢了
用api如何实现,我以前实现过,不过现在忘了。

解决方案 »

  1.   

    LVM_GETSELECTEDCOUNT
    To send this message, call the SendMessage function as follows. 
    lResult = SendMessage(      // returns LRESULT in lResult     (HWND) hWndControl,      // handle to destination control     (UINT) LVM_GETSELECTEDCOUNT,      // message ID     (WPARAM) wParam,      // = 0; not used, must be zero    (LPARAM) lParam      // = 0; not used, must be zero );   
    ParameterswParam
    Must be zero.
    lParam
    Must be zero.
    Return ValueReturns the number of selected items. 
      

  2.   

    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 Const LVM_FIRST As Long = &H1000
    Private Const LVM_GETSELECTEDCOUNT As Long = (LVM_FIRST + 50)Private Sub Command1_Click()
        MsgBox ListView_GetSelectedCount(ListView1.hwnd)
    End SubPrivate Sub Form_Load()
       Dim itmx As ListItem
       Dim cnt As Long
       Dim tmp As Long
       
       Randomize Timer
       
       With ListView1
          .MultiSelect = True
          .ColumnHeaders.Add , , "Name"
          .ColumnHeaders.Add , , "Size"
          .ColumnHeaders.Add , , "Type"
          .ColumnHeaders.Add , , "Created"
          .View = lvwReport
       
          For cnt = 1 To 100
          
            'create a few random entries
            'to simulate real data
             tmp = Int(Rnd(20) * 20) + 1
         
             Set itmx = .ListItems.Add(, , String(tmp, Chr$(123 - tmp)))
             itmx.SubItems(1) = tmp & " kb"
             itmx.SubItems(2) = "winzip file"
             itmx.SubItems(3) = DateAdd("d", -Int(Rnd(365) * 365), Date)
          
          Next
       
       End With
    End SubPrivate Function ListView_GetSelectedCount(hwnd As Long) As Long   ListView_GetSelectedCount = SendMessage(hwnd, _
                                               LVM_GETSELECTEDCOUNT, _
                                               0&, _
                                               ByVal 0&)End Function
      

  3.   

    '-----------------------------------------------------------------------------------------
    ' Copyright ©1996-2004 VBnet, Randy Birch. All Rights Reserved Worldwide.
    '        Terms of use http://vbnet.mvps.org/terms/pages/terms.htm
    '-----------------------------------------------------------------------------------------Private Const LVM_FIRST As Long = &H1000
    Private Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
    Private Const LVM_HITTEST As Long = (LVM_FIRST + 18)Private Const LVM_GETNEXTITEM  As Long = (LVM_FIRST + 12)
    Private Const LVM_GETSELECTEDCOUNT As Long = (LVM_FIRST + 50)Private Const LVHT_ABOVE = &H8
    Private Const LVHT_BELOW = &H10
    Private Const LVHT_TORIGHT = &H20
    Private Const LVHT_TOLEFT = &H40
    Private Const LVHT_NOWHERE As Long = &H1
    Private Const LVHT_ONITEMICON As Long = &H2
    Private Const LVHT_ONITEMLABEL As Long = &H4
    Private Const LVHT_ONITEMSTATEICON As Long = &H8
    Private Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or _
                                        LVHT_ONITEMLABEL Or _
                                        LVHT_ONITEMSTATEICON)Private Type POINTAPI
       x As Long
       y As Long
    End TypePrivate Type HITTESTINFO
       pt As POINTAPI
       flags As Long
       iItem As Long
       iSubItem  As Long
    End TypePrivate Declare Function SendMessage Lib "user32" _
       Alias "SendMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       lParam As Any) As LongPrivate Sub Form_Load()   Dim itmx As ListItem
       Dim cnt As Long
       Dim tmp As Long
       
       Randomize Timer
       
       With ListView1
       
          .ColumnHeaders.Add , , "Name"
          .ColumnHeaders.Add , , "Size"
          .ColumnHeaders.Add , , "Type"
          .ColumnHeaders.Add , , "Created"
          .View = lvwReport
       
          For cnt = 1 To 100
          
            'create a few random entries
            'to simulate real data
             tmp = Int(Rnd(20) * 20) + 1
         
             Set itmx = .ListItems.Add(, , String(tmp, Chr$(123 - tmp)))       
             itmx.SubItems(1) = tmp & " kb"
             itmx.SubItems(2) = "winzip file"
             itmx.SubItems(3) = DateAdd("d", -Int(Rnd(365) * 365), Date)
          
          Next
       
       End With
       
       With Check1
          .Caption = "Toggle FullRowSelect"
          .Value = vbChecked
       End WithEnd Sub
    Private Sub Command1_Click()   Const LVNI_SELECTED = &H2
       Dim nSelected() As Long
       Dim index As Long
       Dim numSelected As Long
       Dim cnt As Long
       
       List1.Clear   numSelected = ListView_GetSelectedCount(ListView1.hwnd)   If numSelected <> 0 Then
       
          ReDim nSelected(0 To numSelected - 1)
          
          Do
          
             index = ListView_GetNextItem(ListView1.hwnd, index, LVNI_SELECTED)
             
             If index > -1 Then          
                nSelected(cnt) = index
               cnt = cnt + 1
             End If
          
          Loop Until index = -1
       
         'debug only: print results to the list
          For cnt = 0 To numSelected - 1
             List1.AddItem nSelected(cnt)
          Next
          
       End IfEnd Sub
    Private Sub ListView1_MouseDown(Button As Integer, _
                                    Shift As Integer, _
                                    x As Single, _
                                    y As Single)   Dim hti As HITTESTINFO
       Dim itemIndex As Long
          
      'Fill a HITTESTINFO structure with
      'information about the point in the
      'listview where the mouse was clicked.
       With hti
          .pt.x = (x / Screen.TwipsPerPixelX)
          .pt.y = (y / Screen.TwipsPerPixelY)
          .flags = LVHT_ABOVE Or LVHT_BELOW Or _
                   LVHT_TOLEFT Or LVHT_TORIGHT Or _
                   LVHT_ONITEMICON Or _
                   LVHT_ONITEMLABEL Or _
                   LVHT_NOWHERE
       End With
          
       itemIndex = SendMessage(ListView1.hwnd, LVM_SUBITEMHITTEST, 0, hti)
       
       If itemIndex = -1 And _
          (hti.iSubItem = -1 Or _
           hti.iSubItem = 0) Then
       
          Set ListView1.SelectedItem = Nothing
       
       End If
          
    End Sub
    Private Sub ListView1_MouseUp(Button As Integer, _
                                  Shift As Integer, _
                                  x As Single, _
                                  y As Single)
     'update label
       If Not ListView1.SelectedItem Is Nothing Then
          Label1.Caption = ListView1.SelectedItem.Text
       Else
          Label1.Caption = "(no selected index)"
       End If
       
    End Sub
    Private Function ListView_GetNextItem(hwnd As Long, _
                                          index As Long, _
                                          flags As Long) As Long   ListView_GetNextItem = SendMessage(hwnd, _
                                          LVM_GETNEXTITEM, _
                                          index, _
                                          ByVal flags)End Function
    Private Function ListView_GetSelectedCount(hwnd As Long) As Long   ListView_GetSelectedCount = SendMessage(hwnd, _
                                               LVM_GETSELECTEDCOUNT, _
                                               0&, _
                                               ByVal 0&)End Function