vb.net - ListView:鼠标拖动多选项目

Question

在 ListView 中，我可以按 Ctrl + Shift 并单击要选择的项目。但是，我想拖动鼠标来选择项目(如 DataGridView)。我尝试了这段代码(如下)，但遇到了这样的问题:



我的代码:

Private mouseDownLV As Boolean

Private Sub ListView1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseDown
    mouseDownLV = True
End Sub

Private Sub ListView1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseMove
    If mouseDownLV Then
        Try
            Dim i = ListView1.HitTest(e.Location).Item.Index
            ListView1.Items(i).Selected = True
        Catch ' ex As Exception
        End Try
    End If
End Sub

Private Sub ListView1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ListView1.MouseUp
    mouseDownLV = False
End Sub

Answer 1

实际上你需要遍历当前显示的 ListViewItem对象并切换 Selected与鼠标移动相交的项目的属性。这是实现这一目标的方法:

声明一个名为 startPoint 的类成员:

Private startPoint As Point

处理 MouseDown设置起始位置的事件:

Private Sub ListView1_MouseDown(sender As Object, e As MouseEventArgs) Handles ListView1.MouseDown
    Dim s = DirectCast(sender, ListView)

    If e.Button = MouseButtons.Left AndAlso
        s.Items.Count > 1 Then
        startPoint = e.Location
    End If
End Sub

处理 MouseMove事件切换 Selected属性(property):

Private Sub ListView1_MouseMove(sender As Object, e As MouseEventArgs) Handles ListView1.MouseMove
    Dim s = DirectCast(sender, ListView)

    If e.Button = MouseButtons.Left AndAlso s.Items.Count > 1 Then
        Dim selRect As New Rectangle(Math.Min(startPoint.X, e.Location.X),
                                    Math.Min(startPoint.Y, e.Location.Y),
                                    Math.Abs(e.Location.X - startPoint.X),
                                    Math.Abs(e.Location.Y - startPoint.Y))

        Dim cr = s.ClientRectangle

        'Toggle selection...
        For Each item In s.Items.Cast(Of ListViewItem).
            Where(Function(x) x.Bounds.IntersectsWith(cr))
            item.Selected = selRect.IntersectsWith(item.Bounds)
        Next
    End If
End Sub

一个快速演示来检查:



但是，如果您有许多项目，其中客户区的大小不足以显示所有项目，因此垂直滚动条可见，该怎么办？你会得到这样的东西:



如您所见，垂直滚动条不会移动，您将无法继续选择/取消选择隐藏项目。为了解决这个问题，我们需要更多的代码:

导入 GetScrollPos 的签名在你类(class)的某个地方发挥作用:

Imports System.Runtime.InteropServices
'...

<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Shared Function GetScrollPos(hWnd As IntPtr,
                                    nBar As Orientation) As Integer
End Function

注:传递一个 System.Windows.Forms.Orientation值而不是 Interger .

更改 MouseDown事件:

Private Sub ListView1_MouseDown(sender As Object, e As MouseEventArgs) Handles ListView1.MouseDown
    Dim s = DirectCast(sender, ListView)

    If e.Button = MouseButtons.Left AndAlso
    s.Items.Count > 1 Then
        Dim vsp = GetScrollPos(s.Handle, Orientation.Vertical)
        Dim yOffset = s.Font.Height * vsp

        startPoint = New Point(e.X, e.Y + yOffset)
    End If
End Sub

和 MouseMove事件:

Private Sub ListView1_MouseMove(sender As Object, e As MouseEventArgs) Handles ListView1.MouseMove
    Dim s = DirectCast(sender, ListView)

    If e.Button = MouseButtons.Left AndAlso s.Items.Count > 1 Then
        Dim vsp = GetScrollPos(s.Handle, Orientation.Vertical)
        Dim yOffset = s.Font.Height * vsp

        Dim selRect As New Rectangle(Math.Min(startPoint.X, e.Location.X),
                                    Math.Min(startPoint.Y - yOffset, e.Location.Y),
                                    Math.Abs(e.Location.X - startPoint.X),
                                    Math.Abs(e.Location.Y - startPoint.Y + yOffset))

        Dim cr = s.ClientRectangle

        'Toggle selection...
        For Each item In s.Items.Cast(Of ListViewItem).
            Where(Function(x) x.Bounds.IntersectsWith(cr))
            item.Selected = selRect.IntersectsWith(item.Bounds)
        Next

        'Scroll if needed...
        Dim p = s.PointToClient(Cursor.Position)
        Dim lvi = s.GetItemAt(p.X, p.Y)

        If lvi Is Nothing Then Return

        Dim fh = s.Font.Height

        If lvi.Index > 0 AndAlso (p.Y - lvi.Bounds.Height * 1.5) <= fh Then
            s.Items(lvi.Index - 1).EnsureVisible()
        ElseIf lvi.Index < s.Items.Count - 1 AndAlso
            (p.Y + lvi.Bounds.Height * 1.5) > (s.Height - fh) Then
            s.Items(lvi.Index + 1).EnsureVisible()
        End If
    End If
End Sub

结果是:



Here是针对这个问题的VB.NET自定义ListView控件， another在 C# 中。