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

您需要确定图像控件边框与其父边框相交。这是我的处理方式：

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

检查嵌套控件是否在父控件范围之外

1 个答案:

MoveableImage类

用户代码