10
\$\begingroup\$

It has been a royal pain that MSForm controls are missing simple events such as MouseOver and Blur, and I find myself often having a complex system of MouseMove events to achieve these for hover effects and other stylings.

To solve this issue I've created two class modules EventListenerEmitter and EventListenerItem.

Listening for the events

The UserForm stores the EventListnerEmitter using WithEvents so that it can then listen for raised events. The UserForm also has to pass itself as a parameter into a method named AddEventListnerAll , that is where the controls and form are stored.

Private WithEvents Emitter As EventListnerEmitter

Private Sub UserForm_Activate()
    Set Emitter = New EventListnerEmitter
    Emitter.AddEventListnerAll Me
End Sub

You can listen for all events in one event handler EmittedEvent (see the example below).

Private Sub Emitter_EmittedEvent(Control As Object, ByVal EventName As String, ByRef EventParameters As Scripting.Dictionary)
    
    'Select statements are really handy working with these events
    Select Case True
        
        'Change color when mouseover, for a fun hover effect :)
        Case EventName = "MouseOver" And TypeName(Control) = "CommandButton"
            Control.BackColor = 9029664
        
        'Don't forget to change it back!
        Case EventName = "MouseOut" And TypeName(Control) = "CommandButton"
            Control.BackColor = 8435998
    
    End Select
    
End Sub

You can also listen just to specific events as well.

Private Sub Emitter_Focus(Control As Object)
    
    'CHANGE BORDER COLOR FOR TEXTBOX TO A LIGHT BLUE
    If TypeName(Control) = "TextBox" Then
        Control.BorderColor = 16034051
    End If
    
End Sub

Private Sub Emitter_Blur(Control As Object)
    
    'CHANGE BORDER COLOR BACK TO A LIGHT GREY
    If TypeName(Control) = "TextBox" Then
        Control.BorderColor = 12434877
    End If
    
End Sub

EventListenerEmitter

This is the main entry point, and its purpose is to create and hold an array of the EventListenerItems and to be the mediator between the Userform and the EventListenerItems.

The Userform and each of its controls are passed through the function AddEventListner which are then stored in the array EventList() As New EventListnerItem. This invokes a method in EventListnerItem also named AddEventListner (this step is to have a WithEvents on that specific control).

Here is the code for EventListnerEmitter(minus a helper function IsArrayEmpty).

'ARRAY OF ALL THE DIFFERENT EVENT ListenerS FOR EVERY USERFORM CONTROL +FORM ITSELF
Private EventList() As New EventListenerItem

'ALL CURRENT POSSIBLE EVENTS THAT CAN BE EMITTED. NOTE, EMITTEDEVENT IS SENT FOR ALL!
Public Event EmittedEvent(ByRef Control As Object, ByVal EventName As String, ByRef EventParameters As Scripting.Dictionary)

Public Event Click(ByRef Control As Object)
Public Event DblClick(ByRef Control As Object, ByRef Cancel As MSForms.ReturnBoolean)
Public Event KeyUp(ByRef Control As Object, ByRef KeyCode As MSForms.ReturnInteger, ByRef Shift As Integer)
Public Event KeyDown(ByRef Control As Object, ByRef KeyCode As MSForms.ReturnInteger, ByRef Shift As Integer)
Public Event MouseOver(ByRef Control As Object)
Public Event MouseOut(ByRef Control As Object)
Public Event MouseMove(ByRef Control As Object, ByRef Shift As Integer, ByRef X As Single, ByRef Y As Single)
Public Event Focus(ByRef Control As Object)
Public Event Blur(ByRef Control As Object)
Public Event Change(ByRef Control As Object)

'***********************************************************************************
' PUBLIC METHODS
'***********************************************************************************

'CALLED BY EVENTLISTENERCOLLECTION CLASS - MAIN ENTRYWAY OF EMITTING ALL EVENTS
Public Sub EmitEvent(ByRef Control As Object, ByVal EventName As String, ByRef EventParameters As Scripting.Dictionary)
    
    'EVENT RAISED FOR ALL EVENTS. THIS IS A WAY FOR THE USER TO COLLECT FROM A SINGLE LOCATION.
    RaiseEvent EmittedEvent(Control, EventName, EventParameters)
    
    'SPECIFIC EVENTS PER OBJECT-TYPE
    Select Case EventName
    
        Case "Click"
            RaiseEvent Click(Control)
        
        Case "DblClick"
            RaiseEvent DblClick(Control, EventParameters("Cancel"))
        
        Case "KeyUp"
            RaiseEvent KeyUp(Control, EventParameters("KeyCode"), EventParameters("Shift"))
            
        Case "KeyDown"
            RaiseEvent KeyDown(Control, EventParameters("KeyCode"), EventParameters("Shift"))
        
        Case "MouseOver"
            RaiseEvent MouseOver(Control)
            
        Case "MouseOut"
            RaiseEvent MouseOut(Control)
            
        Case "Focus"
            RaiseEvent Focus(Control)
            
        Case "Blur"
            RaiseEvent Blur(Control)
            
        Case "MouseMove"
            RaiseEvent MouseMove(Control, EventParameters("Shift"), EventParameters("X"), EventParameters("Y"))
        
    End Select

End Sub

'MUST CALL THIS IF YOU WANT TO programmatically SET CONTROL! OTHERWISE, EVENT'S WILL BE OFF!
Public Sub SetFocusToControl(ByRef Control As Object)
    
    'If the user was to set focus through VBA then this code will fall apart considering
    'it is unaware of that event occurring.
    If Not Control Is Nothing Then
        Control.setFocus
        EmitEvent Control, "Focus", Nothing
    End If
    
End Sub

'ADD EVENT ListenerS ON SPECIFIC CONTROLS - ALSO CALLED BY AddEventListenerAll
Public Sub AddEventListener(ByRef Control As Object)
    
    'Events are stored in a private EventListenerItem array
    If IsArrayEmpty(EventList) Then
        ReDim EventList(0 To 0)
    Else
        ReDim Preserve EventList(0 To UBound(EventList) + 1)
    End If
    
    'CALL AddEventListener IN EventListenerItem. THIS IS KEPT IN
    EventList(UBound(EventList)).AddEventListener Control, Me
    
End Sub

'ADD EVENT Listener TO ALL CONTROLS INCLUDING THE FORM
Public Sub AddEventListenerAll(ByRef Form As Object)
    
    AddEventListener Form
    
    Dim Ctrl As MSForms.Control
    For Each Ctrl In Form.Controls
        AddEventListener Ctrl
    Next Ctrl
    
End Sub

EventListenerItem

This class contains one control only, and stores that control under the appropriate WithEvents variable.

Additionally, it stores a reference to the emitter class Private WithEvents pEmitter As EventListenerEmitter.

As this control has events it will call EmitEvent from the EventListenerEmitter class, where it will then raise the appropriate events.

All controls will be listening for these events to then store whether or not it is the current hovered or focused control. This is how I'm able to then raise my custom events hover and blur.

I've broken this class up into sections for readability.

Private Variables

'SET FROM AddEventListener - NEEDED TO EMIT EVENT BACK TO IT.
Private WithEvents pEmitter As EventListenerEmitter

'CONTROLS THAT HAVE THE EVENTS CURRENTLY
Private WithEvents Form As MSForms.UserForm
Private WithEvents Txt As MSForms.Textbox
Private WithEvents Lbl As MSForms.Label
Private WithEvents Btn As MSForms.CommandButton
Private WithEvents Cmb As MSForms.ComboBox
Private WithEvents Frm As MSForms.Frame

'PROPERTIES OF SPECIFIC CONTROL
Private pControl As Object 'Used for comparison
Private IsHoveredControl As Boolean
Private IsFocusedControl As Boolean

Public Functions

Only one public function. It's called from EventListenerEmitter class.

'ONLY PUBLIC METHOD. CALLED FROM EVENTListener CLASS MODULE
Public Sub AddEventListener(ByRef ControlOrForm As Object, ByRef Emitter As EventListenerEmitter)
    
    'CAPTURE THE EMITTER CLASS. WILL USE THIS TO EMIT EVENTS FROM EACH CONTROL
    Set pEmitter = Emitter
    
    'USED TO COMPARE CHECK IF IT IS THE CONTROL TRIGGERING THE EVENT
    Set pControl = ControlOrForm
    
    'SET CONTROL(OR FORM) BASED ON IT'S TYPE
    Select Case TypeName(ControlOrForm)
        Case "CommandButton"
            Set Btn = ControlOrForm
        
        Case "ComboBox"
            Set Cmb = ControlOrForm
            
        Case "Frame"
            Set Frm = ControlOrForm
        
        Case "Label"
            Set Lbl = ControlOrForm
        
        Case "TextBox"
            Set Txt = ControlOrForm
            
        Case Else
 
            If IsUserform(ControlOrForm) Then
                Set Form = ControlOrForm
            End If

    End Select
    
End Sub

Private helper functions

'CALLED ON MOUSEMOVE EVENT, THIS IS A WAY OF CREATING A MOUSEOVER AND MOUSEOUT EVENT
Private Sub CheckIfHoveredControl()
    
    If Not IsHoveredControl Then
        IsHoveredControl = True
        pEmitter.EmitEvent pControl, "MouseOver", Dict()
    End If
    
End Sub

'CALLED ON MOUSEMOVE EVENT, THIS IS A WAY OF CREATING A MOUSEOVER AND MOUSEOUT EVENT
Private Sub CheckIfFocusedControl()
    
    If Not IsFocusedControl Then
    
        If TypeName(pControl) = "Frame" Then
             pEmitter.SetFocusToControl pControl.ActiveControl
        Else
            IsFocusedControl = True
            pEmitter.EmitEvent pControl, "Focus", Dict()
        End If
        
    End If
    
End Sub

'CHECK TO SEE IF OBJ IS A USERFORM
Private Function IsUserform(ByRef Obj As Object) As Boolean

    If TypeOf Obj Is MSForms.UserForm Then
      IsUserform = True
    End If

End Function

'SIMPLE DICTIONARY FACTORY - USED TO PASS EVENT PARAMETERS BACK TO EMITTER
Private Function Dict(ParamArray KeyValue() As Variant) As Scripting.Dictionary
    
    'CHECK IF THERE IS EVEN PARAMETERS
    If Not ArrayCount(KeyValue) Mod 2 = 0 Then
        Debug.Print "Function Dict() requires an even amount of key value arguments." _
        & " Only provided " & ArrayCount(KeyValue)
        Exit Function
    End If
    
    Set Dict = New Scripting.Dictionary
    Dim Index As Long
    For Index = LBound(KeyValue) To UBound(KeyValue) Step 2
        Dict.Add KeyValue(Index), KeyValue(Index + 1)
    Next Index
    
End Function

'USED WITH Dict To SEE IF THERE ARE AN EVEN AMOUNT OF PARAMETERS
Private Function ArrayCount(ByVal SourceArray As Variant) As Long
    
    ArrayCount = UBound(SourceArray) - LBound(SourceArray) + 1
    
End Function

Event Listener

This is so that each control can check if it is the current hovered or focused control and store that information. This is used to then raise custom events.

' ONCE AN EVENT HAS EMMITED, EACH EVENTListenerITEM WILL LISTEN FOR THAT EVENT
Private Sub pEmitter_EmittedEvent(ByRef Control As Object, ByVal EventName As String, ByRef EventParameters As Scripting.Dictionary)
    
    'CREATE A MOUSEOVER MOUSEOUT EVENTS
    Select Case EventName
    
        Case "MouseOver"
            If pControl.Name <> Control.Name And IsHoveredControl Then
                IsHoveredControl = False
                pEmitter.EmitEvent pControl, "MouseOut", Dict()
            End If
            
        Case "Focus"
            If pControl.Name <> Control.Name And IsFocusedControl Then
                IsFocusedControl = False
                pEmitter.EmitEvent pControl, "Blur", Dict()
            ElseIf pControl.Name = Control.Name And IsFocusedControl = False Then
                IsFocusedControl = True
            End If
    
    End Select

End Sub

Events Per control

'------------------------------------------------------------------------
' USERFORM
'------------------------------------------------------------------------
Private Sub Form_Click()
    pEmitter.EmitEvent pControl, "Click", Dict()
End Sub

Private Sub Form_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    pEmitter.EmitEvent pControl, "DblClick", Dict("Cancel", Cancel)
End Sub

Private Sub Form_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   CheckIfHoveredControl
   pEmitter.EmitEvent pControl, "MouseMove", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Form_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseDown", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Form_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseUp", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub


'------------------------------------------------------------------------
' COMMAND BUTTON
'------------------------------------------------------------------------
Private Sub Btn_Click()
    pEmitter.EmitEvent pControl, "Click", Dict()
End Sub

Private Sub Btn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    pEmitter.EmitEvent pControl, "DblClick", Dict("Cancel", Cancel)
End Sub

Private Sub Btn_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfHoveredControl
    pEmitter.EmitEvent pControl, "MouseMove", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Btn_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfFocusedControl
    pEmitter.EmitEvent pControl, "MouseUp", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Btn_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseDown", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Btn_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CheckIfFocusedControl
    pEmitter.EmitEvent pControl, "KeyUp", Dict("KeyCode", KeyCode, "Shift", Shift)
End Sub

Private Sub Btn_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    pEmitter.EmitEvent pControl, "KeyDown", Dict("KeyCode", KeyCode, "Shift", Shift)
End Sub


'------------------------------------------------------------------------
' LABEL
'------------------------------------------------------------------------
Private Sub Lbl_Click()
    pEmitter.EmitEvent pControl, "Click", Dict()
End Sub

Private Sub Lbl_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    pEmitter.EmitEvent pControl, "DblClick", Dict("Cancel", Cancel)
End Sub

Private Sub Lbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfHoveredControl
    pEmitter.EmitEvent pControl, "MouseMove", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub lbl_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseDown", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub lbl_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseUp", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub


'------------------------------------------------------------------------
' Frame
'------------------------------------------------------------------------
Private Sub Frm_Click()
    pEmitter.EmitEvent pControl, "Click", Dict()
End Sub

Private Sub Frm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    pEmitter.EmitEvent pControl, "DblClick", Dict("Cancel", Cancel)
End Sub

Private Sub Frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfHoveredControl
    pEmitter.EmitEvent pControl, "MouseMove", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Frm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfFocusedControl 'FRAME DOESN'T TAKE FOCUS BUT ACTIVE CONTROL IN FRAME DOES
    pEmitter.EmitEvent pControl, "MouseDown", Dict()
End Sub

Private Sub Frm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseUp", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub


'------------------------------------------------------------------------
' Textbox
'------------------------------------------------------------------------
Private Sub Txt_Click()
    pEmitter.EmitEvent pControl, "Click", Dict()
End Sub

Private Sub Txt_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    pEmitter.EmitEvent pControl, "DblClick", Dict("Cancel", Cancel)
End Sub

Private Sub Txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfHoveredControl
    pEmitter.EmitEvent pControl, "MouseMove", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Txt_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    CheckIfFocusedControl
    pEmitter.EmitEvent pControl, "MouseUp", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Txt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    pEmitter.EmitEvent pControl, "MouseDown", Dict("Button", Button, "Shift", Shift, "X", X, "Y", Y)
End Sub

Private Sub Txt_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CheckIfFocusedControl
    pEmitter.EmitEvent pControl, "KeyUp", Dict("KeyCode", KeyCode, "Shift", Shift)
End Sub

Private Sub Txt_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    pEmitter.EmitEvent pControl, "KeyDown", Dict("KeyCode", KeyCode, "Shift", Shift)
End Sub

This has worked for my overall needs to this point and I like how simple it is to use; however, I feel like there are better design patterns out there than what I currently have that are more flexible for change.

At this point, I only have a small list of events that I'm emitting and already it can be quite a bit of code to maintain. I would love any suggestion as I'm always looking to improve on best practices and writing clean code.

Here is my Github Repository in case you need the full code.

\$\endgroup\$
9
  • \$\begingroup\$ Now that's a very refreshing post to review! Good job, and welcome to CR! \$\endgroup\$ May 16, 2019 at 20:00
  • 1
    \$\begingroup\$ There's a reason this site has 2x the maximum post length of Stack Overflow ;-) \$\endgroup\$ May 16, 2019 at 20:06
  • 1
    \$\begingroup\$ I get a Type mismatch error at this line EmitEvent Control, "Focus", "". You should use Nothing in place of the vbNullString but I would probably just make EventParameters optional. \$\endgroup\$
    – TinMan
    May 20, 2019 at 1:49
  • 1
    \$\begingroup\$ @RobertTodar That's correct, you shouldn't update the code in your question (ever technically - in case someone's working on a review as you edit - but generally I think it's fine if your question has had no activity yet for a couple of days). However you can post a separate follow-up question with updated code (see the linked discussion). NB is there something specific to your original code which you want feedback on & Matt's answer didn't cover? If so then consider making a note of that in the bounty description (or a new question) \$\endgroup\$
    – Greedo
    May 21, 2019 at 7:18
  • 1
    \$\begingroup\$ @Greedo looks like I can't update the bounty notes to add even more clarification. Essentially, I'm looking for a full code review that can tell me if my overall design can be improved before I start adding a bunch of controls and events to it. Are there better ways for abstractions and/or encapsulation? Is this a candidate for interfaces? I'll even take feedback if my code is designed well. The main goal is to learn and grow in how I approach problems like this one. \$\endgroup\$ May 21, 2019 at 14:49

2 Answers 2

6
+50
\$\begingroup\$

No time for a full-blown review, but glancing over the code, a few points stick out:


Enthusiastic Abstractions

In a few places, you extracted a trivial one-liner function that is only used in a single place. IMO that's the wrong abstraction to use - for example:

Private Function IsUserform(ByRef Obj As Object) As Boolean

    If TypeOf Obj Is MSForms.UserForm Then
      IsUserform = True
    End If

End Function

That could have been written as IsUserForm = TypeOf obj Is MSForms.UserForm, an expression that is perfectly fine to have inline IMO:

    Case Else

        If TypeOf ControlOrForm Is MSForms.UserForm Then
            Set Form = ControlOrForm
        End If

That If block should really have an Else clause that throws an error to tell the calling code "I'm afraid I can't let you do that" or something. It's currently silently failing, and that's never good.

ArrayCount is also probably better off as a local variable if it's only used in one place - otherwise it should be in some utilities module, and I'd call it ArrayLength, more in-line with standard terminology.

Private Function Dict(ParamArray KeyValue() As Variant) As Scripting.Dictionary

    'CHECK IF THERE IS EVEN PARAMETERS
    Dim arrayCount As Long
    arrayCount = UBound(KeyValue) - LBound(KeyValue) + 1

    If Not arrayCount Mod 2 = 0 Then
        Debug.Print "Function Dict() requires an even amount of key value arguments." _
        & " Only provided " & arrayCount
        Exit Function
    End If

There's no need to invoke the function twice, even less so just for a Debug.Print statement. That said, this should be a serious bug, and I would expect it to throw a run-time error, not just output to the Debug pane.

    If arrayCount Mod 2 <> 0 Then
        Err.Raise 5, TypeName(Me), "Invalid parameters: expecting key/value pairs, but received an odd number of arguments."
    End If

I'd spell it ToDictionary though, and the KeyValue() argument would probably be clearer as keyValuePairs() - I like my arrays and collections pluralized.


Stringly-Typed Events

The one single thing that's making the solution much flakier than it needs to be, is the fact that the event names are all hard-coded string literals, everywhere.

What's missing is a Public Enum, somewhere:

Public Enum EmittedEvent
    Click
    DoubleClick
    MouseMove
    MouseOut
    MouseOver
    MouseDown
    MouseUp
    KeyUp
    KeyDown
    Focus
    Blur
End Enum

Then you get auto-completion at the call sites, Option Explicit is protecting you from a typo, and you can refactor/rename them at will without breaking everything:

Public Sub EmitEvent(ByRef Control As Object, ByVal EventType As EmittedEvent, ByRef EventParameters As Scripting.Dictionary)
\$\endgroup\$
2
  • 1
    \$\begingroup\$ I really like KeyValuePairs(), that stands out a bunch more to me. Where would you store the Public Enum? I originally started off in that direction, and something felt wrong having it declared globally. \$\endgroup\$ May 16, 2019 at 21:20
  • \$\begingroup\$ I'd put the enum in the emitter class I think. \$\endgroup\$ May 16, 2019 at 21:40
4
\$\begingroup\$

Scripting.Dictionary

The code is not using any of the Dictionary's special features. Replacing the Scripting.Dictionaries with VBA.Collections will eliminate the external reference, make the class easier to distribute and MAC friendly.

Synergies

Most of the pieces in place but they just don't work together as smoothly as they could.

Take a look at this code snippet from the TestFormEvents userform.

Private Sub Emitter_Blur(Control As Object)

    RendorEventLabel Control, Blur

    'CHANGE BORDER COLOR BACK TO A LIGHT GREY
    If TypeName(Control) = "TextBox" Then
       Control.BorderColor = 12434877
       Control.BorderStyle = fmBorderStyleNone
        Control.BorderStyle = fmBorderStyleSingle
    End If

End Sub

Pretty straight forward but it just handles a textbox. What if you wanted to add effects for all 6 of the supported controls (UserForm, Textbox, Label, CommandButton, ComboBox, and Frame)? A Select Case would help. Of course, you would have to have to make sure that each of the Cases is cased right, no IntelliSense for strings.

Private Sub Emitter_Blur(Control As Object)

    RendorEventLabel Control, Focus

    'CHANGE BORDER COLOR FOR TEXTBOX TO A LIGHT BLUE
    Select Case TypeName(Control)
    Case "UserForm"

    Case "TextBox"
        Control.BorderColor = 16034051
        Control.BorderStyle = fmBorderStyleNone
        Control.BorderStyle = fmBorderStyleSingle
    Case "Label"

    Case "CommandButton"

    Case "ComboBox"

    Case "Frame"

    End Select

End Sub

This looks pretty good but should I have added `Case "MultiPage"? No, MultiPage is not supported There is no way to know what controls are supported without examining the source code.

Now say that we wanted to do something a little fancier like change CommandButton's scrollbar property. Oh, they don't have a scrollbar...ugh no IntelliSense...the Control is typed as an Object. No problem really, we can just create a separate variable for each supported control. Yuck!

Tweaks

The first thing that I would do is add another enumeration for supported controls.

Public Enum EmitterControls
    ecUserForm
    ecTextbox
    ecLabel
    ecCommandButton
    ecComboBox
    ecFrame
End Enum

But how to implement the enumeration? We could bubble it up as a parameter. That would work but I think that there is a better way.

I would make these changes to the EventListenerItem class - Add a ControlType Property - Change the scope of the MSForms variables to Public - Rename the MSForms to match there Type (CommandButton As MSForms.CommandButton) - Retype the Control from Object to EventListenerItem - Pass the instance of the EventListenerItem as Control

Here is how the code snippet above would look after the changes:

Private Sub Emitter_Blur(Control As EventListenerItem)

    RendorEventLabel Control, Focus

    'CHANGE BORDER COLOR FOR TEXTBOX TO A LIGHT BLUE
    Select Case Control.ControlType
    Case EmitterControls.ecUserForm

    Case EmitterControls.ecTextbox
        Control.TextBox.BorderColor = 16034051
        Control.TextBox.BorderStyle = fmBorderStyleNone
        Control.TextBox.BorderStyle = fmBorderStyleSingle
    Case EmitterControls.ecLabel

    Case EmitterControls.ecCommandButton

    Case EmitterControls.ecComboBox

    Case EmitterControls.ecFrame

    End Select

End Sub

The big pay off is having IntelliSense available for writing the Select Case and accessing the MsForms control properties.

Enumeration IntelliSense

EventListenerItem MsForms Control IntelliSense

This setup would also allow us to add an ActiveEventListenerItem property to the EventListenerEmitter class, which just might come in handy.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.