ACC2000: How to Simulate Drag-And-Drop CapabilitiesID: Q233274
|
Microsoft Access does not have a built-in DragDrop event for controls as
does Visual Basic. This article describes how to create a DragDrop
procedure that will run in response to a Microsoft Access control being
dragged to another control.
This article provides two examples that demonstrate the use of the DragDrop
procedure. The first example demonstrates how to drag the value in a
control on one form to a control on a second form. The second example
demonstrates how to move items from one list box to a second list box using
a drag-and-drop procedure. If you perform a drag-and-drop procedure with
the CTRL key held down, all items from one list will be moved to the second
list.
The following four procedures, DragStart, DragStop, DropDetect, and DragDrop, are required to implement drag-and-drop capabilities between controls in Microsoft Access.
Sub DragStart(DragFrm As Form)
where DragFrm: is the form containing the control being dragged.
Sub DragStop()
Private Sub MyControl_MouseDown(Button As Integer, Shift As Integer, ...
DragStart Me
End Sub
Private Sub MyControl_MouseDown(Button As Integer, Shift As Integer, ...
DragStop
End Sub
Sub DropDetect(DropFrm As Form, DropCtrl As Control, _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
where:
Private Sub MyControl_MouseMove(Button As Integer, Shift As ...
DropDetect Me, Me![Employee ID], Button, Shift, X, Y
End Sub
NOTE: A control can be dragged and be a drop target by calling DragStart, DragStop, and DropDetect from the MouseDown, MouseUp, and MouseMove events respectively.
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)
where:
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
Private 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.
Private 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.
Private 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
Form: List Box Example
----------------------
Caption: ListBoxes
RecordSelectors: No
NavigationButtons: No
ScrollBars: Neither
List box
--------------------------------------------------------------
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"
List box
--------------------------------------------------------------
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 DAO.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
Additional query words:
Keywords : kbdta FmsHowto
Version : WINDOWS:2000
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: June 10, 1999