Sunday, July 14, 2013

VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Option Explicit 

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function
SetCapture Lib "user32.dll" (ByVal hwnd As Long) As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim BeginSelect As Boolean
Dim
CurrentRowY As Long

Private Sub DataGrid1_Click()
BeginSelect = False
ReleaseCapture
End Sub

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub RemoveAllSelected()
Dim h As Integer
Dim i As Integer
h = DataGrid1.SelBookmarks.Count
If h = 0 Then Exit Sub
For i = h - 1 To 0 Step -1
DataGrid1.SelBookmarks.Remove i
Next i
End Sub

Private Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static t As Integer
Dim Direction As Integer
Dim i As Integer
If BeginSelect Then
SetCapture DataGrid1.hwnd
If CurrentRowY > DataGrid1.RowContaining(Y) Then
Direction = 1
Else
Direction = -1
End If
RemoveAllSelected
For i = CurrentRowY To DataGrid1.RowContaining(Y) Step -Direction
If i = -1 Then
Exit For
End If
DataGrid1.SelBookmarks.Add DataGrid1.RowBookmark(i)
Next
End If
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
If BeginSelect = False Then
Debug.Print DataGrid1.Col
CurrentRowY = DataGrid1.Row
End If
BeginSelect = True
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub ReleaseSelect()
BeginSelect = False
ReleaseCapture
End Sub