Using a WithEvents
variable to handle the MSForms.Control
events of, say, a TextBox
control has the irritating tendency to throw a rather puzzling run-time error 459 “Object or class does not support the set of events”. To be honest, I had completely forgotten about this when I started working on this MVVM framework. I had even posted an answer on Stack Overflow and my learning-it-the-hard-way is immortalized on that page.
…there’s a bit of COM hackery going on behind the scenes; there’s enough smokes & mirrors for VBA to successfully compile the above, but, basically, you’re looking at a glitch in The Matrix (Rubberduck’s resolver has similar “nope” issues with MSForms controls): there isn’t any obvious way to get VBA to bind a dynamic control object to its
-Mathieu Guindon, Apr 18 ’19MSForms.Control
events.
What I hadn’t noticed until today, was that another user had posted an answer to that question a few hours later that day – and that answer ultimately leads to the groundbreaking manual wiring-up of what VBA normally does automagically under the hood when we declare a WithEvents
variable.
pUnk’d
The code I’m about to share is heavily based on the work shared on Stack Overflow by user Evr, and uses the ConnectToConnectionPoint
Win32 API that, it must be mentioned, comes with a caveat:
This function is available through Windows XP and Windows Server 2003. It might be altered or unavailable in subsequent versions of Windows.
Regardless, it works (for now anyway, …if we lose Mac support for this specific capability).
Rubberduck uses similar connection points to handle a number of VBE events that aren’t otherwise exposed, so I knew this was going to work one way or another. The idea is to pass an IUnknown
pointer to an object that exposes members with very specific VB_UserMemId
attribute values, and have accordingly very specific member signatures.
This post lists a bunch of such attributes – however since there aren’t any problems with binding regular TextBox
and CommandButton
events (these do work with simple WithEvents
event providers), I’m only interested in these:
Event | VB_UserMemId |
---|---|
AfterUpdate | -2147384832 |
BeforeUpdate | -2147384831 |
Enter | -2147384830 |
Exit | -2147384829 |
This is going to be a little bit lower-level than usual, but every VBA user class has an IUnknown
pointer, So we can use any class module that has the members with the appropriate VB_UserMemId
attribute values, and pass that as the pUnk
pointer argument.
So, here’s the punk in question, exactly as I currently have it:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ControlEventsPunk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "Provides an event sink to relay MSForms.Control events."
'@Folder MVVM.Infrastructure.Win32
'@ModuleDescription "Provides an event sink to relay MSForms.Control events."
'based on https://stackoverflow.com/a/51936950
Option Explicit
Implements IControlEvents
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'[This function is available through Windows XP and Windows Server 2003. It might be altered or unavailable in subsequent versions of Windows.]
'https://docs.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-connecttoconnectionpoint
#If VBA7 Then
Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal Punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal PunkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
#Else
Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If
Private Type TState
RefIID As GUID 'The IID of the interface on the connection point container whose connection point object is being requested.
Connected As Boolean
PunkTarget As Object
Cookie As Long
Handlers As Collection
End Type
'from https://stackoverflow.com/a/61893857 (same user as #51936950!)
Private Const ExitEventID As Long = -2147384829
Private Const EnterEventID As Long = -2147384830
Private Const BeforeUpdateEventID As Long = -2147384831
Private Const AfterUpdateEventID As Long = -2147384832
Private This As TState
'@Description "Gets/sets the target MSForms.Control reference."
Public Property Get Target() As Object
Attribute Target.VB_Description = "Gets/sets the target MSForms.Control reference."
Set Target = This.PunkTarget
End Property
Public Property Set Target(ByVal RHS As Object)
Set This.PunkTarget = RHS
End Property
'@Description "Registers the listener."
Public Function Connect() As Boolean
Attribute Connect.VB_Description = "Registers the listener."
GuardClauses.GuardNullReference This.PunkTarget, TypeName(Me), "Target is not set."
ConnectToConnectionPoint Me, This.RefIID, True, This.PunkTarget, This.Cookie, 0&
This.Connected = This.Cookie <> 0
Connect = This.Connected
End Function
'@Description "De-registers the listener."
Public Function Disconnect() As Boolean
Attribute Connect.VB_Description = "De-registers the listener."
If Not This.Connected Then Exit Function
ConnectToConnectionPoint Me, This.RefIID, False, This.PunkTarget, This.Cookie, 0&
This.Connected = False
Disconnect = True
End Function
'@Description "A callback that handles MSForms.Control.AfterUpdate events for the registered target control."
Public Sub OnAfterUpdate()
Attribute OnAfterUpdate.VB_UserMemId = -2147384832
Attribute OnAfterUpdate.VB_Description = "A callback that handles MSForms.Control.AfterUpdate events for the registered target control."
Dim Handler As IHandleControlEvents
For Each Handler In This.Handlers
Handler.HandleAfterUpdate
Next
End Sub
'@Description "A callback that handles MSForms.Control.BeforeUpdate events for the registered target control."
Public Sub OnBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Attribute OnBeforeUpdate.VB_UserMemId = -2147384831
Attribute OnBeforeUpdate.VB_Description = "A callback that handles MSForms.Control.BeforeUpdate events for the registered target control."
Dim Handler As IHandleControlEvents
For Each Handler In This.Handlers
Handler.HandleBeforeUpdate Cancel
Next
End Sub
'@Description "A callback that handles MSForms.Control.Exit events for the registered target control."
Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute OnExit.VB_UserMemId = -2147384829
Attribute OnExit.VB_Description = "A callback that handles MSForms.Control.Exit events for the registered target control."
Dim Handler As IHandleControlEvents
For Each Handler In This.Handlers
Handler.HandleExit Cancel
Next
End Sub
'@Description "A callback that handles MSForms.Control.Enter events for the registered target control."
Public Sub OnEnter()
Attribute OnEnter.VB_UserMemId = -2147384830
Attribute OnEnter.VB_Description = "A callback that handles MSForms.Control.Enter events for the registered target control."
Dim Handler As IHandleControlEvents
For Each Handler In This.Handlers
Handler.HandleEnter
Next
End Sub
'@Description "Registers the specified object to handle the relayed control events."
Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents)
Attribute RegisterHandler.VB_Description = "Registers the specified object to handle the relayed control events."
This.Handlers.Add Handler
End Sub
Private Sub Class_Initialize()
Set This.Handlers = New Collection
This.RefIID.Data1 = &H20400
This.RefIID.Data4(0) = &HC0
This.RefIID.Data4(7) = &H46
End Sub
Private Sub IControlEvents_OnAfterUpdate()
OnAfterUpdate
End Sub
Private Sub IControlEvents_OnBeforeUpdate(ByVal Cancel As MSForms.IReturnBoolean)
OnBeforeUpdate Cancel
End Sub
Private Sub IControlEvents_OnEnter()
OnEnter
End Sub
Private Sub IControlEvents_OnExit(ByVal Cancel As MSForms.IReturnBoolean)
OnExit Cancel
End Sub
Private Sub IControlEvents_RegisterHandler(ByVal Handler As IHandleControlEvents)
RegisterHandler Handler
End Sub
Let’s ignore the IControlEvents
interface for now. The class has a Target
– that’ll be our TextBox
control instance. So we set the Target
, and then we can invoke Connect
, and when we’re done we can invoke Disconnect
to explicitly undo the wiring-up.
Then we have an OnEnter
method with VB_UserMemId = -2147384830
, which makes it an event handler procedure for MSForms.Control.Enter
. The name of the procedure isn’t relevant, but it’s important that the procedure is parameterless.
Similarly, the name of the OnExit
procedure has no importance, but it must have a single ByVal Cancel As MSForms.ReturnBoolean
parameter (only ByVal
and the data type matter). For events that have more than one parameter, the order is also important.
In theory that’s all we need: we could go on and handle Control.Exit
in this OnExit
procedure, and call it a day. In fact you can probably do that right away – however I need another step for my purposes, because I’m going to need my PropertyBindingBase
class to propagate these events “up” to, say, some TextBoxPropertyBinding
class that can implement some TextBox
-specific behavior for the Control
events.
Propagating Events
I had already a working pattern for my INotifyPropertyChange
requirements to propagate property changes across objects, and the pattern is applicable here too. See, I could have declared a Public Event Exit(ByRef Cancel As MSForms.ReturnBoolean)
on the ControlEventsPunk
class, and then I could have used a WithEvents
variable to handle them – and that would have worked too. Except I don’t want to use events here, because events work well as implementation details… but they can’t be exposed on an interface, which makes them actually more complicated to work with.
There are two interfaces: one that defines the “events” and exposes a method to register “handlers”, and the other mandates the presence of a callback for each “event”. For INotifyPropertyChange
the handler interface was named IHandlePropertyChange
, so I went with IControlEvents
and IHandleControlEvents
.
So, the “provider” interface looks like this:
'@Folder MVVM.Infrastructure.Bindings.Abstract
'@ModuleDescription "Provides the infrastructure to relay MSForms.Control events."
Option Explicit
Public Sub RegisterHandler(ByVal Handler As IHandleControlEvents)
End Sub
Public Sub OnEnter()
End Sub
Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Public Sub OnAfterUpdate()
End Sub
Public Sub OnBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
And then the “handler” interface looks like this:
'@Folder MVVM.Infrastructure.Bindings.Abstract
'@ModuleDescription "An object that can be registered as a handler for IControlEvents callbacks."
Option Explicit
Public Sub HandleEnter()
End Sub
Public Sub HandleExit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Public Sub HandleAfterUpdate()
End Sub
Public Sub HandleBeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
So, looking back at the ControlEventsPunk
class, we find that the implementation for RegisterHandler
consists in adding the provided Handler
object to an encapsulated Collection
that holds all the registered handlers; when we “handle” a control event, we iterate all registered handlers and invoke them all in a sequence. When an event has a Cancel
parameter, the last handler that ran gets the final say on whether the parameter should be True
or False
, and each handler receives the Cancel
value that was set by the previous handler than ran.
This is a slightly different paradigm than your regular VBA/VB6 auto-wired events, where one event only ever has one handler: now these work more like the multicast delegates that events are in .NET, with an “invocation list” and the ability to add/remove (although, I haven’t implemented the removal) handlers dynamically at run-time – except the “handlers” are full-fledged VBA objects here, rather than .NET delegates.
Whenever the MVVM infrastructure needs to propagate events, I use this pattern instead. This was my first time actually implementing an Observer Pattern, and hadn’t even realized! (thanks Max!) – that isn’t a pattern you see often in event-capable languages, but I can definitely see this proven, solid abstraction (Java developers would probably be rather familiar with that one) become my new favorite go-to pattern to expose events on an interface in VBA… But there’s probably a reason the first time I come across a situation where that pattern is really handy (and actually needed, for testability), is when I’m writing framework-level (i.e. an API intended to be used by code that isn’t written yet) code that’s very much as deep into the OOP rabbit hole as I’ve ever been in VBA (or any other language for that matter)… and there’s still no rock bottom in sight.
In any case, now that we have a way to handle and propagate control events, we can have MVVM property bindings that can format TextBox.Text
on exit, i.e. we can have a ViewModel that knows SomeProperty
has a value of 25.59, and the Text
property of the bound textbox control can say $25.59
just by specifying a FormatString
(like “Currency”, for example) when we create the binding.
For the next post in this series I think we’re ready to deep-dive into the actual binding mechanics, and I’ll have the updated MVVM infrastructure code on GitHub by then.