Сгруппировать подвижные элементы в пользовательской форме

Question

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

Теперь я застрял при попыткечтобы достичь ситуации, когда 3 элемента управления сгруппированы вместе, и все перемещаются при перемещении одного из них.

Я пытался использовать массив как часть объявления переменной, но продолжаю получать ошибки 'define'.

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

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

Если бы был способ установить мою переменную '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

Например, при перемещении изображения2, изображения2 +Изображение 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 в частную подпрограмму, добавление логики в событие _MouseMove для перемещения также два других объекта и добавление событий для Image2 (аналогично Image1 событиям с некоторыми отличиями).