Question

在Tinman的大力协助下，围绕该问题可以移动多个图像-Check if nested control is outside parent control range

我现在陷入了试图将3个控件组合在一起并在其中一个控件移动时全部移动的情况。

我尝试将数组用作变量声明的一部分，但始终会出现“定义”错误。

我已经考虑过使用框架，但是这会导致控件需要能够移出框架并移入主要用户窗体的情况，从目前的代码角度来看，我觉得这更加复杂。

我看到了一些有关使用标签移动具有此标签名称的所有对象的信息，但这链接到数组变量声明方面。

如果有一种方法可以将我的'movableimages.image1'变量设置为包含多个图像，那么我认为这可以解决我的问题，但是我无法找到一种解决方法。

用户代码

 Option Explicit
    Private MovableImages(1 To 3) As New MoveableImage

Private Sub UserForm_Initialize()
    Dim ctrl As MSForms.Control

    For Each ctrl In Me.Controls
        ctrl.Tag = ctrl.Top & "|" & ctrl.Left
    Next
    Call RemoveCaption(Me)
    Image8.Visible = False
    Image11.Visible = False
    Image12.Visible = False
    Image13.Visible = False
    Image14.Visible = False
    Image15.Visible = False
    Label2.Visible = False

   '' Me.StartUpPosition = 0
   '' Me.Top = Application.Top + 400
   '' Me.Left = Application.Left + Application.Width - Me.Width - 560
    Set MovableImages(1).Image1 = Image2
    Set MovableImages(2).Image1 = Image3
    Set MovableImages(3).Image1 = Image4
    Set MovableImages(4).Image1 = Image5
    Set MovableImages(5).Image1 = Image6
    Set MovableImages(6).Image1 = Image7
    Set MovableImages(7).Image1 = Image8
    Set MovableImages(8).Image1 = Image11
    Set MovableImages(9).Image1 = Image12
    Set MovableImages(10).Image1 = Image13
    Set MovableImages(11).Image1 = Image14
    Set MovableImages(12).Image1 = Image15


End Sub

类模块代码

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

例如，当移动image2时，Image2 + Image 8 + label1都将通过定义的X，Y变量从当前位置移动。

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

Public WithEvents Image1 As MSForms.Image
Public WithEvents Image2 As MSForms.Image
Public Label1 As MSForms.Label

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)
    If Button = XlMouseButton.xlPrimaryButton Then
        MoveObject Image1, Image1Coords, x, y
        If Not Image2 is Nothing Then MoveObject Image2, Image1Coords, x, y
        If Not Label1 is Nothing Then MoveObject Label1, Image1Coords, x, y
    End If
End Sub

Private Sub Image2_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 Image2_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
        MoveObject Image2, Image1Coords, x, y
        If Not Image1 is Nothing Then MoveObject Image1, Image1Coords, x, y
        If Not Label1 is Nothing Then MoveObject Label1, Image1Coords, x, y
    End If
End Sub

Private Sub MoveObject(moveObj As Object, moveCoords as Coords, ByVal x As Single, ByVal y As Single)
    Const PaddingRight As Long = 4, PaddingBottom As Long = 8

    moveCoords.Left = moveObj.Left + x - moveCoords.x
    moveCoords.Top = moveObj.Top + y - moveCoords.y

    moveCoords.MaxLeft = moveObj.Parent.Width - moveObj.Width - PaddingRight
    moveCoords.MaxTop = moveObj.Parent.Height - moveObj.Height - PaddingBottom

    If moveCoords.Left < 0 Then moveCoords.Left = 0

    If moveCoords.Left < moveCoords.MaxLeft Then
        moveObj.Left = moveCoords.Left
    Else
        moveObj.Left = moveCoords.MaxLeft
    End If

    If moveCoords.Top < 0 Then moveCoords.Top = 0

    If moveCoords.Top < moveCoords.MaxTop Then
        moveObj.Top = moveCoords.Top
    Else
        moveObj.Top = moveCoords.MaxTop
    End If
End Sub

注释：

在不同组中需要的地方，需要更新Userform模块以设置.Image2和.Label1。例如：

Set MovableImages(1).Image1 = Image2
Set MovableImages(1).Image2 = Image8
Set MovableImages(1).Label1 = Label1

类模块中的主要区别是添加了Image2和Label1，将移动逻辑从_MouseMove事件中提取到了私有子集，将逻辑添加到了{ {1}}事件也可以移动其他两个对象，并添加_MouseMove的事件（类似于Image2事件，但有一些区别）。

在用户窗体中分组可移动项目

1 个答案: