Search code examples
excelvbauserform

Check if nested control is outside parent control range


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"?


Solution

  • 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
    

    MoveableImage Class

    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
    

    Userform Code

    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