Article ID: 137650
Article Last Modified on 1/19/2007
Syntax:
Sub DragStart (DragFrm As Form)
Sub DragStop ()
DragFrm: The form containing the control being dragged.
Example:
Private Sub MyControl_MouseDown (Button As Integer, Shift As ...
DragStart Me
End Sub
Private Sub MyControl_MouseDown (Button As Integer, Shift As ...
DragStop
End Sub
Syntax:
Sub DropDetect (DropFrm As Form, DropCtrl As Control,
Button As Integer, Shift As Integer,
X As Single, Y As Single)
DropFrm: The form containing the control being dropped on.
DropCtrl: The control being dropped on.
Button, Shift, X, Y: The parameters from the MouseMove event.
Example:
Private Sub MyControl_MouseMove (Button As Integer, Shift As ...
DropDetect Me, Me![Employee ID], Button, Shift, X, Y
End Sub
Syntax:
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)
DragFrm: The form containing the control being dragged.
DragCtrl: The control being dragged.
DropFrm: The form containing the control being dropped on.
DropCtrl: The control being dropped on.
Button: The state of the mouse buttons when the drop occurred.
Shift: The state of the SHIFT, CTRL, ALT keys when the drop occurred.
X, Y: The x and y coordinates of the mouse where the drop occurred.
NOTE: For more information on Button, Shift, X, Y arguments, search
Help for the MouseMove event.
Sub DragDrop (DragFrm As Form, DragCtrl As Control, ...
On Error Resume Next
DropCtrl = DragCtrl
If Err Then MsgBox Error$
End Sub
Option Explicit
Dim DragFrm As Form
Dim DragCtrl As Control
Dim DropTime
Const MAX_DROP_TIME = .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)
On Error Resume Next
DropCtrl = DragCtrl
If Err Then MsgBox Error$
End Sub
Sub EmployeeID_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DropDetect Me, Me![EmployeeID], Button, Shift, X, Y
End Sub
NOTE: This control will only be a drop target.
Sub EmployeeID_MouseDown (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStart Me
End Sub
NOTE: This control will only be a drag target.
Sub EmployeeID_MouseUp (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStop
End Sub
Field Name: Selected
Data Type : Yes/No
RecordSelectors: No
NavigationButtons: No
ScrollBars: Neither
Name: List1
RowSourceType: Table/Query
RowSource: SELECT CustomerID, CompanyName FROM Customers WHERE
Selected=False ORDER BY CompanyName;
ColumnCount: 2
ColumnWidths: 0
Width: 1.5"
Height: 1.5"
Name: List2
RowSourceType: Table/Query
RowSource: SELECT CustomerID, CompanyName FROM Customers WHERE
Selected=True ORDER BY CompanyName;
ColumnCount: 2
ColumnWidths: 0
Width: 1.5"
Height: 1.5"
Private Sub List1_MouseDown (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStart Me
End Sub
Private Sub List1_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DropDetect Me, Me![List1], Button, Shift, X, Y
End Sub
Private Sub List1_MouseUp (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStop
End Sub
Private Sub List2_MouseDown (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStart Me
End Sub
Private Sub List2_MouseMove (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DropDetect Me, Me![List2], Button, Shift, X, Y
End Sub
Private Sub List2_MouseUp (Button As Integer, Shift As Integer, _
X As Single, Y As Single)
DragStop
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 "List Box Example"
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 Customers 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 [CustomerID]='" & DragCtrl & "'"
End If
' Run update query to toggle Selected field of Customer record(s).
DB.Execute SQL
' Requery the list box controls to show update lists.
DragCtrl.Requery
DropCtrl.Requery
End Sub
Keywords: kbhowto kbusage KB137650