检查嵌套控件是否超出父控件范围

Question

我已将拖放功能添加到嵌套在我的 Excel 用户窗体中的框架控件内的图像控件中。

我试图阻止嵌套的图像控件移出父控件。

如果位置超出父控件的范围，我正在考虑在 BeforeDropOrPaste 事件中使用 IF 语句来退出所有正在运行的宏（因此也是 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

您需要确定 Image 控件边框与其父边框相交。 这是我的做法：

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 类

更进一步，我们可以使用类来封装代码。

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