ListView: MultiSelect items with mouse drag - vb.net

Question

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

Answer 1

Actually you need to iterate through the currently displayed ListViewItem objects and toggle the Selected property of the items that intersect with the mouse movement. Here's a way to achieve that:
Declare a class member named startPoint:
Private startPoint As Point
Handle the MouseDown event to set the starting position:
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
Handle the MouseMove event to toggle the 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
A quick demo to check that:
But what if you have many items where the size of the client area is not large enough to display them all and thus the vertical scrollbar is visible? You will get something like this:
As you can see, the vertical scrollbar does not move and you won't be able to continue selecting/deselecting the hidden items. To fix that, we need some more code:
Import the signature of the GetScrollPos function somewhere in your 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
Note: Passing a System.Windows.Forms.Orientation value instead of an Interger.
Change the MouseDown event to:
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 event to:
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
The outcome is:
Here is VB.NET custom ListView control for this problem, and another in C#.