Проверьте, находится ли вложенный элемент управления вне родительского диапазона

Question

Я добавил функцию перетаскивания в элемент управления изображением, который вложен в элемент управления Frame в моей пользовательской форме Excel.

Я пытаюсь предотвратить перемещение вложенного элемента управления изображениями за пределы родительского элемента управления.

Я думал об использовании оператора IF в событии BeforeDropOrPaste для выхода из всех запущенных макросов (например, событие mousemove), если позиция находится за пределами диапазона родительского элемента управления.

Как сравнить местоположение отбрасывания элемента управления с диапазоном родительского элемента управления?

Как я думаю, код будет выглядеть.

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

Если местоположение вложенного элемента управления находится за пределами или пересекает диапазон родительского элемента управления, верните вложенный элемент управления в то место, где он находился до события MouseMove.

Редактировать - я нашел этот код, который использует функцию для возврата истинного значения, если управляющие объекты перекрываются. 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

Как это может работать, например, когда элемент управления Frame называется «Frame1», а элемент управления Image называется «Image1»?

Answer 1

Вам необходимо определить его, граница контроля изображения пересекает его родительскую границу.Вот способ, которым я бы это сделал:

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

Сделав шаг вперед, мы можем инкапсулировать код с помощью класса.

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