Option Compare Database
Option Explicit
Dim DragFrm As Form
Dim DragCtrl As Control
Dim DropTime
Const MAX_DROP_TIME = 0.1
Dim CurrentMode As Integer
Const NO_MODE = 0
Const DROP_MODE = 1
Const DRAG_MODE = 2
Sub DragStart(SourceFrm As Form)
' NOTE: You should not use Screen.ActiveForm in place of
' SourceFrm because you may be dragging from a subform.
Set DragFrm = SourceFrm
Set DragCtrl = Screen.ActiveControl
CurrentMode = DRAG_MODE
End Sub
Sub DragStop()
CurrentMode = DROP_MODE
DropTime = Timer
End Sub
Sub DropDetect(DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
' If a drop hasn't happened, then exit.
If CurrentMode <> DROP_MODE Then Exit Sub
CurrentMode = NO_MODE
' The timer interval is permitted between the MouseUp event and
' the MouseMove event. This ensures that the MouseMove event does
' not invoke the Drop procedure unless it is the MouseMove event
' that Microsoft Access automatically fires for the Drop control
' following the MouseUp event of a drag control. Subsequent
' MouseMove events will fail the timer test and be ignored.
If Timer - DropTime > MAX_DROP_TIME Then Exit Sub
' Did we drag/drop onto ourselves?
If (DragCtrl.Name <> DropCtrl.Name) Or _
(DragFrm.hwnd <> DropFrm.hwnd) Then
' If not, then a successful drag/drop occurred.
DragDrop DragFrm, DragCtrl, DropFrm, DropCtrl, Button, Shift, X, Y
End If
End Sub
Sub DragDrop(DragFrm As Form, DragCtrl As Control, DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
' Which form was dropped on?
' It is a good idea to use the DragDrop procedure to
' determine which drag-and-drop operation occurred; then call
' appropriate code to handle the special cases.
Select Case DropFrm.Name
Case "frmDragDropListBoxes"
ListBoxExample DragFrm, DragCtrl, DropFrm, DropCtrl, _
Button, Shift, X, Y
Case Else
' For all other cases, copy contents of Drag to Drop
' control.
On Error Resume Next
DropCtrl = DragCtrl
If err Then MsgBox Error$
End Select
End Sub
Sub ListBoxExample(DragFrm As Form, DragCtrl As Control, DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DB As Database
Dim SQL As String
Set DB = CurrentDb()
' Create SQL statement to update Selected field of
' .. drag/dropped list box item.
SQL = "UPDATE [COLOR=red]tblWeeds[/COLOR] SET Selected="
' Drag from List1 toggle Selected=True, List2 toggles False.
SQL = IIf(DragCtrl.Name = "List1", SQL & "True", SQL & "False")
' If CTRL key not used, alter dragged value only.
If (Shift And CTRL_MASK) = 0 Then
SQL = SQL & " WHERE [[COLOR=red]WeedID[/COLOR]]='" & DragCtrl & "'"
End If
' Run update query to toggle Selected field of Weed record(s).
DB.Execute SQL
' Requery the list box controls to show update lists.
DragCtrl.Requery
DropCtrl.Requery
End Sub
