检查嵌套控件是否在父控件范围之外 [英] Check if nested control is outside parent control range

问题描述

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

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.

我当时想考虑如果位置超出父控件的范围，则在BeforeDropOrPaste事件中使用IF语句退出所有正在运行的宏(因此，mousemove事件).

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

如果嵌套控件的位置在父控件范围之外或与父控件范围相交，则将嵌套控件返回到MouseMove事件之前的位置.

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.

编辑-我发现这段代码使用了一个函数，如果控件对象重叠则返回一个真值. http://www.vbaexpress.com/forum/showthread.php?33829-Solved-finding-if-two-controls-overlap

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

例如在将Frame控件称为"Frame1"而将Image控件称为"Image1"的情况下，该如何工作?

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

MoveableImage类

再进一步，我们可以使用一个类封装代码.

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

用户表单代码

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

这篇关于检查嵌套控件是否在父控件范围之外的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！