Option Compare Database
Option Explicit
Private WithEvents mDragTextBox As Access.TextBox
Private WithEvents mDragcommandbutton As Access.CommandButton
Dim MoveMe As Boolean
Dim InitX As Long
Dim InitY As Long
Dim DragX As Long
Dim DragY As Long
Private Sub mDragTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
Dim x As Long
Dim y As Long
Dim shiftSpeed As Integer
x = Me.DragTextBox.Left
y = Me.DragTextBox.Top
If Shift = acShiftMask Then
shiftSpeed = 100
Else
shiftSpeed = 10
End If
Select Case KeyCode
Case vbKeyUp
Me.DragTextBox.Top = y - shiftSpeed
Case vbKeyDown
Me.DragTextBox.Top = y + shiftSpeed
Case vbKeyRight
Me.DragTextBox.Left = x + shiftSpeed
Case vbKeyLeft
Me.DragTextBox.Left = x - shiftSpeed
End Select
End Sub
Private Sub mDragTextBox_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = acLeftButton And Shift = acCtrlMask Then
MoveMe = True
InitX = x
InitY = y
Else
MoveMe = False
End If
End Sub
Private Sub mDragTextBox_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If MoveMe = True Then
DragX = x
DragY = y
End If
End Sub
Private Sub mDragTextBox_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If MoveMe = True Then
With DragTextBox
.Left = .Left + DragX - InitX
.Top = .Top + DragY - InitY
End With
MoveMe = False
End If
End Sub
'------------------------------------------ Duplicate code
Private Sub mDragcommandbutton_KeyDown(KeyCode As Integer, Shift As Integer)
Dim x As Long
Dim y As Long
Dim shiftSpeed As Integer
x = Me.Dragcommandbutton.Left
y = Me.Dragcommandbutton.Top
If Shift = acShiftMask Then
shiftSpeed = 100
Else
shiftSpeed = 10
End If
Select Case KeyCode
Case vbKeyUp
Me.Dragcommandbutton.Top = y - shiftSpeed
Case vbKeyDown
Me.Dragcommandbutton.Top = y + shiftSpeed
Case vbKeyRight
Me.Dragcommandbutton.Left = x + shiftSpeed
Case vbKeyLeft
Me.Dragcommandbutton.Left = x - shiftSpeed
End Select
End Sub
Private Sub mDragcommandbutton_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = acLeftButton And Shift = acCtrlMask Then
MoveMe = True
InitX = x
InitY = y
Else
MoveMe = False
End If
End Sub
Private Sub mDragcommandbutton_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If MoveMe = True Then
DragX = x
DragY = y
End If
End Sub
Private Sub mDragcommandbutton_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If MoveMe = True Then
With Dragcommandbutton
.Left = .Left + DragX - InitX
.Top = .Top + DragY - InitY
End With
MoveMe = False
End If
End Sub
'--------------------------------------------------------------------------------------
Public Sub Initialize(TheControl As Access.Control)
TheControl.OnMouseDown = "[Event Procedure]"
TheControl.OnMouseMove = "[Event Procedure]"
TheControl.OnMouseUp = "[Event Procedure]"
TheControl.OnKeyDown = "[Event Procedure]"
Select Case TheControl.ControlType
Case acTextBox
Set Me.DragTextBox = TheControl
Case acCommandButton
Set Me.Dragcommandbutton = TheControl
End Select
End Sub
Public Property Get DragTextBox() As Access.TextBox
Set DragTextBox = mDragTextBox
End Property
Public Property Set DragTextBox(ByVal objNewValue As Access.TextBox)
Set mDragTextBox = objNewValue
End Property
Public Property Get Dragcommandbutton() As Access.CommandButton
Set Dragcommandbutton = mDragcommandbutton
End Property
Public Property Set Dragcommandbutton(ByVal objNewValue As Access.CommandButton)
Set mDragcommandbutton = objNewValue
End Property