ListView：通过鼠标拖动多选项目

In ListView, I can press Ctrl + Shift and click on the item to select. But, I want to drag the mouse to select the items (like DataGridView). I tried this code (below) and I had a problem like this:

My code:

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

实际上你需要遍历当前显示的ListViewItem物体和toggle the 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事件至toggle the Selected财产：

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

一个快速演示来检查：

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

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

导入签名获取滚动位置 https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getscrollpos在你的班级中的某个地方运行：

Imports System.Runtime.InteropServices
'...

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

^{Note: Passing a System.Windows.Forms.Orientation value instead of an 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

And the 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 https://pastebin.com/vwnTUwByVB.NET 自定义 ListView 控件解决了这个问题，并且another https://pastebin.com/9TzmmfEJ in C#.