Как изменить внешний вид меток пользовательских форм с помощью модуля класса?

Question

У меня есть эта пользовательская форма (изображение 1), и я пытаюсь применить некоторые настройки через модуль класса. Итак, моей первой целью было изменить формат метки при нажатии (Изображение 2). Пока все хорошо, я сделал это с помощью модуля класса cLabels. Теперь моя вторая цель (это та, с которой я застрял) - применить какой-то другой цвет к вышеупомянутой метке. Дело в том, что я не знаю, как этого добиться.

Я попытался создать другой модуль класса под названием "cUserForm", но я не знаю, как передать измененную метку модулю класса cUserForm и использовать его событие MouseMove. Я знаю, что могу применить модификацию через стандартный модуль UserForm с помощью события MouseMove, но дело в том, что мне не нужен подобный код в моем модуле UserForm, я хочу, чтобы модуль класса выполнял "грязную" работу. Ребят есть идеи как мне обойти проблему?

Дополнительная информация (но не важная для решения проблемы): Моя конечная цель - создать такие "Кнопки" https://drive.google.com/file/d/1ev_LNgxPqjMv0dtzlF7GSo7SOq0wDbR2/view?usp=sharing с некоторыми эффектами, такими как MouseHover, TabPress и так далее. Кнопки VBA очень уродливые. Для записи, я уже проделал все это в стандартном модуле UserForm (если кто-то хочет, чтобы книга видела, о чем я говорю, у меня есть это), но конечный результат был просто беспорядком, так много кода (и это был просто код для изменения внешнего вида UserForm, представьте, когда я помещаю какой-то код для выполнения определенного действия, боже).

Изображение 1

Изображение 2

Вот что у меня есть на данный момент:

Модуль UserForm

Option Explicit

Private ObjLabel As cLabels
Private ObjUserForm As cUserForm

Private Sub UserForm_Initialize()

 Set ObjLabel = New cLabels
 ObjLabel.CallClasse Me
 
 Set ObjUserForm = New cUserForm
 Set ObjUserForm.UserFormValue = Me
 
End Sub

cLabels

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsLabel As MSForms.Label

Private ClasseObject As cLabels
Private LabelCollection As New Collection

'## Properties
Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = clsLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set clsLabel = Value
End Property

'## Procedures/Methods
Private Sub clsLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 LabelHovered
End Sub

Public Sub CallClasse(MainObject As MSForms.UserForm)

 Dim ctrl As MSForms.Control

 For Each ctrl In MainObject.Controls

    If TypeOf ctrl Is MSForms.Label Then
        Set ClasseObject = New cLabels
        Set ClasseObject.ActiveLabel = ctrl
        LabelCollection.Add ClasseObject
    End If

 Next ctrl

End Sub

Private Sub LabelHovered()
 ActiveLabel.BackColor = vbYellow
End Sub

cUserForm

Option Explicit

'## Events/Variables/Collections
Private WithEvents clsUserForm As MSForms.UserForm
Private mActiveLabel As MSForms.Label
Private ObjLabel As New cLabels

'## Properties
Public Property Get UserFormValue() As MSForms.UserForm
    Set UserFormValue = clsUserForm
End Property

Public Property Set UserFormValue(Value As MSForms.UserForm)
    Set clsUserForm = Value
End Property

Public Property Get ActiveLabel() As MSForms.Label
    Set ActiveLabel = mActiveLabel
End Property

Public Property Set ActiveLabel(Value As MSForms.Label)
    Set mActiveLabel = Value
End Property

'## Procedures
Private Sub clsUserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    'MsgBox ObjLabel.ActiveLabel.BackColor 'Got an error
End Sub

Рабочая тетрадь:https://drive.google.com/file/d/1cLG4pLmC-jDaysjd_dK0EFuJ_LqYqJ-u/view?usp=sharing

Answer 1

Мне ваш вопрос показался очень интересным, и у меня есть немного другой, более объектно-ориентированный подход к тому, как вы могли бы это сделать. Я попытался реализовать паттерн наблюдателя, чтобы получить описанный эффект. (В качестве побочного примечания, обычно я бы немного обобщил решение, используя интерфейсы, но для этой быстрой демонстрации я покажу пару тесно связанных классов, которые выполняют свою работу)

Позвольте мне сначала представить все мои компоненты:

Классы:

LabelObserver

Option Explicit

Private WithEvents mInteralObj As MSForms.label
Private mBackGroundColor As Long
Private mMouseOverColor As Long

Private Const clGREY As Long = &H8000000F

'// "Constructor"
Public Sub Init(label As MSForms.label, _
                Optional mouseOverColor As Long = clGREY, _
                Optional backGroundColor As Long = clGREY)
                
    Set mInteralObj = label
    mBackGroundColor = backGroundColor
    mMouseOverColor = mouseOverColor
End Sub

Private Sub Class_Terminate()
    Set mInteralObj = Nothing
End Sub

Public Sub MouseLeft()
    '//Remove Highlight
    mInteralObj.BackColor = mBackGroundColor
End Sub

Private Sub mInteralObj_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '//Highlight
    mInteralObj.BackColor = mMouseOverColor
End Sub

LabelNotifier

Option Explicit
Private observersCollection As Collection

Private Sub Class_Initialize()
    Set observersCollection = New Collection
End Sub

Public Sub AddObserver(observer As LabelObserver)
    observersCollection.Add observer
End Sub

Public Sub RemoveObserver(observer As LabelObserver)
    Dim i As Long
    '// We have to search through the collection to find the observer to remove
    For i = 1 To observersCollection.Count
        If observersCollection(i) Is observer Then
            observersCollection.Remove i
            Exit Sub
        End If
    Next i
End Sub

Public Function ObserverCount() As Integer
    ObserverCount = observersCollection.Count
End Function

Public Sub Notify()
    Dim obs As LabelObserver
    
    If Me.ObserverCount > 0 Then
    
        For Each obs In observersCollection
            '//call each observer's MouseLeft method
            obs.MouseLeft
        Next obs
    
    End If
End Sub

Private Sub Class_Terminate()
    Set observersCollection = Nothing
End Sub

Модуль:

LabelObserverFactory (это не обязательно - он просто предоставляет удобный упрощенный способ создания действительныхLabelObservers)

Option Explicit

Public Function NewYellowHighlightCustomLabel(label As MSForms.label) As LabelObserver
    Dim product As New LabelObserver
    
    product.Init label, vbYellow
    
    Set NewYellowHighlightCustomLabel = product
End Function

Public Function NewRedHighlightCustomLabel(label As MSForms.label) As LabelObserver
    Dim product As New LabelObserver
    
    product.Init label, vbRed
    
    Set NewRedHighlightCustomLabel = product
End Function

UserForm

MyForm (обратите внимание, что в этой форме есть три метки с именами по умолчанию, размещенными на ней для целей этой демонстрации)

Option Explicit

Private notifier As LabelNotifier


Private Sub UserForm_Initialize()
    Set notifier = New LabelNotifier
    
    '//add controls to be notified
    notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label1)
    notifier.AddObserver LabelObserverFactory.NewRedHighlightCustomLabel(Me.Label2)
    notifier.AddObserver LabelObserverFactory.NewYellowHighlightCustomLabel(Me.Label3)
    
    
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    '//Notify labels that mouse has left them
    notifier.Notify
End Sub

Private Sub UserForm_Terminate()
    Set notifier = Nothing
End Sub

А теперь объясним, что здесь происходит:

В форме есть объект LabelNotifier, который устанавливается при инициализации формы, который он будет использовать для уведомления наших меток о том, что мышь отошла от них. Мы делаем это, прослушивая событие MouseMove формы. (Я знаю, что вы пытаетесь избежать этого, но, надеюсь, тот факт, что у нас будет только одна строка кода, независимо от того, на сколько ярлыков вы воздействуете, удовлетворит желание инкапсулировать логику где-то еще.) Когда мы получаем движение мыши, мы заставим уведомитель выполнять свою единственную работу - отправлять сообщение всем добавленным к нему ярлыкам.

LabelObserver является противоположной частью LabelNotifier. Наблюдатель за этикетками отвечает за то, чтобы сообщить этикеткам об изменении цвета и о том, какие цвета использовать.

Даже если вам не нравится эта реализация, мне было весело над ней работать.:-)

Answer 2

Вам не нужно создавать отдельный модуль класса, чтобы что-то изменить в форме. Просто добавьте методы обработки событий в код формы. (В редакторе форм щелкните форму правой кнопкой мыши и выберите "Просмотреть код".)

Вы можете использовать MouseMove событие для кнопки, чтобы изменить свой цвет, а затем используйте MouseMove для формы, чтобы сбросить цвет кнопки, например:

Private Sub UserForm_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)

    CommandButton1.BackColor = &H8000000F
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)

    CommandButton1.BackColor = vbYellow
End Sub