I have added drag-drop functionality to an image control that is nested inside a Frame Control in my Excel userform.
I am trying to prevent the nested image control from being moved outside of the parent control.
I was thinking of using an IF statement in a BeforeDropOrPaste event to exit all running macros (so the mousemove event) if the position is outside the range of the parent control.
How do I compare the drop location of the control to the range of the parent control?
What I think the code would look like.
Private x_offset%, y_offset%
Private Sub Image1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
Dim X as Range
Dim Y as Range
Set x = parent control range
Set y = the drop location of the control this code is in
'If Y is outside or intersects X then
End
Else
End Sub
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = XlMouseButton.xlPrimaryButton Then
x_offset = X
y_offset = Y
End If
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
If Button = XlMouseButton.xlPrimaryButton Then
Image1.Left = Image1.Left + X - x_offset
Image1.Top = Image1.Top + Y - y_offset
End If
End Sub
If the location of the nested control is outside of or intersects the parent control range then return the nested control to the location it was at before the MouseMove event.
Edit - I found this code that uses a function to return a true value if the control objects overlap. http://www.vbaexpress.com/forum/showthread.php?33829-Solved-finding-if-two-controls-overlap
Function Overlap(aCtrl As Object, bCtrl As Object) As Boolean
Dim hOverlap As Boolean, vOverlap As Boolean
hOverlap = (bCtrl.Left - aCtrl.Width < aCtrl.Left) And (aCtrl.Left < bCtrl.Left + bCtrl.Width)
vOverlap = (bCtrl.Top - aCtrl.Height < aCtrl.Top) And (aCtrl.Top < bCtrl.Top + bCtrl.Height)
Overlap = hOverlap And vOverlap
End Function
How could this work for example where the Frame control is called "Frame1" and the Image control is called "Image1"?
You need to determine it the Image control border intersects its parent border. Here is the way that I would do it:
Private Type Coords
Left As Single
Top As Single
X As Single
Y As Single
MaxLeft As Single
MaxTop As Single
End Type
Private Image1Coords As Coords
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = XlMouseButton.xlPrimaryButton Then
Image1Coords.X = X
Image1Coords.Y = Y
End If
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Const PaddingRight As Long = 4, PaddingBottom As Long = 8
Dim newPoint As Point
If Button = XlMouseButton.xlPrimaryButton Then
Image1Coords.Left = Image1.Left + X - Image1Coords.X
Image1Coords.Top = Image1.Top + Y - Image1Coords.Y
Image1Coords.MaxLeft = Image1.parent.Width - Image1.Width - PaddingRight
Image1Coords.MaxTop = Image1.parent.Height - Image1.Height - PaddingBottom
If Image1Coords.Left < 0 Then Image1Coords.Left = 0
If Image1Coords.Left < Image1Coords.MaxLeft Then
Image1.Left = Image1Coords.Left
Else
Image1.Left = Image1Coords.MaxLeft
End If
If Image1Coords.Top < 0 Then Image1Coords.Top = 0
If Image1Coords.Top < Image1Coords.MaxTop Then
Image1.Top = Image1Coords.Top
Else
Image1.Top = Image1Coords.MaxTop
End If
End If
End Sub
Taking it a step further we can encapsulate the code using a class.
Option Explicit
Private Type Coords
Left As Single
Top As Single
x As Single
Y As Single
MaxLeft As Single
MaxTop As Single
End Type
Private Image1Coords As Coords
Public WithEvents Image1 As MSForms.Image
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
If Button = XlMouseButton.xlPrimaryButton Then
Image1Coords.x = x
Image1Coords.Y = Y
End If
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Const PaddingRight As Long = 4, PaddingBottom As Long = 8
Dim newPoint As Point
If Button = XlMouseButton.xlPrimaryButton Then
Image1Coords.Left = Image1.Left + x - Image1Coords.x
Image1Coords.Top = Image1.Top + Y - Image1Coords.Y
Image1Coords.MaxLeft = Image1.Parent.Width - Image1.Width - PaddingRight
Image1Coords.MaxTop = Image1.Parent.Height - Image1.Height - PaddingBottom
If Image1Coords.Left < 0 Then Image1Coords.Left = 0
If Image1Coords.Left < Image1Coords.MaxLeft Then
Image1.Left = Image1Coords.Left
Else
Image1.Left = Image1Coords.MaxLeft
End If
If Image1Coords.Top < 0 Then Image1Coords.Top = 0
If Image1Coords.Top < Image1Coords.MaxTop Then
Image1.Top = Image1Coords.Top
Else
Image1.Top = Image1Coords.MaxTop
End If
End If
End Sub
Option Explicit
Private MovableImages(1 To 3) As New MoveableImage
Private Sub UserForm_Initialize()
Set MovableImages(1).Image1 = Image1
Set MovableImages(2).Image1 = Image2
Set MovableImages(3).Image1 = Image3
End Sub