patternMinor
Using events together with interfaces in VBA
Viewed 0 times
eventswithtogetherusingvbainterfaces
Problem
Introduction
Because of the limitation of VBA in using events in interfaces I was searching for a kind of workaround.
For sure I also read this which also provides an approach, but I was searching for an easier way.
I ended up with the following solution.
The idea behind
Instead of defining the events directly in an interface - because it is not possible to use them in an implementing class in VBA - I use an additional 'event' class, where all necessary events will be placed in, and which will be injected into the interface implementing classes.
Naming of the event class
I'm aware of that this class is not really used as an interface, but it only should be used with the regarding interface.
So I named it also with an
Another benefit of this is that it will be listed beneath the regarding interface.
Circular references
The worker object is provided with the event on purpose.
As long as it is used in the event handler with care, that means, it should not be stored anywhere else, there shouldn't be any risk regarding circular references.
The interfaces
IWorker
IWorkerEvents
The implementations
Worker1
Worker2
```
Option Explicit
Implements IWorker
Private Type TWorker
Because of the limitation of VBA in using events in interfaces I was searching for a kind of workaround.
For sure I also read this which also provides an approach, but I was searching for an easier way.
I ended up with the following solution.
The idea behind
Instead of defining the events directly in an interface - because it is not possible to use them in an implementing class in VBA - I use an additional 'event' class, where all necessary events will be placed in, and which will be injected into the interface implementing classes.
Naming of the event class
I'm aware of that this class is not really used as an interface, but it only should be used with the regarding interface.
So I named it also with an
I prefix.Another benefit of this is that it will be listed beneath the regarding interface.
Circular references
The worker object is provided with the event on purpose.
As long as it is used in the event handler with care, that means, it should not be stored anywhere else, there shouldn't be any risk regarding circular references.
The interfaces
IWorker
Option Explicit
Public Property Set Events(ByRef value As IWorkerEvents)
End Property
Public Sub Work()
End SubIWorkerEvents
Option Explicit
Public Event Notify(ByRef worker As IWorker, message As String)
Public Sub Notify(ByRef worker As IWorker, message As String)
RaiseEvent Notify(worker, message)
End SubThe implementations
Worker1
Option Explicit
Implements IWorker
Private Type TWorker
Events As IWorkerEvents
End Type
Private this As TWorker
Private Property Set IWorker_Events(RHS As IWorkerEvents)
Set this.Events = RHS
End Property
Private Sub IWorker_Work()
Debug.Print "Worker 1 works hard."
Notify "is working..."
End Sub
Sub Notify(ByVal message As String)
If Not this.Events Is Nothing Then
this.Events.Notify Me, message
End If
End SubWorker2
```
Option Explicit
Implements IWorker
Private Type TWorker
Solution
I use an additional 'event' class, where all necessary events will be placed in, and which will be injected into the interface implementing classes.
That. That is how it's done. It's COM-friendly, it works, and it's simple. Beautiful.
From
I only have a few minor points, that Rubberduck would have picked up:
With the next Rubberduck release, you could also have
These special comments (well, the actual description string) would then be visible in the object browser's bottom panel, and in Rubberduck's context-sensitive selection command bar, whenever an
The write-only
The
So the client code is written against
Guard clauses ensure the object is always in a valid state and prevent misusing the class.
The
The fact that
Notice I removed the
Until the next Rubberduck release, the module and member attributes need to be added manually, by exporting the module, editing them in, and then re-importing the module.
I like seeing test code. VBA code that works off interfaces and injected dependencies want to be tested! With Rubberduck you could have written unit tests that actually document the implementation/specs, for example in some
This simple test passes when the
Another test would pass when the
That. That is how it's done. It's COM-friendly, it works, and it's simple. Beautiful.
From
Option Explicit to the names of literally everything, including that private type and that this field. You could open any of my own VBA projects and see exactly that, it's almost scary.I only have a few minor points, that Rubberduck would have picked up:
Publicaccess modifier is sometimes explicit, often implicit.
- Not sure why
IWorkerEventsparameter needs to be passedByRef.
- Not sure why
Messageparameter needs to be passedByRef.
With the next Rubberduck release, you could also have
@Description annotations, that the add-in automatically translates to VB_Description attributes, for example:'@Description "Sets the event provider object for this instance."
Public Property Set Events(ByRef value As IWorkerEvents)
End Property
'@Description "Executes the worker."
Public Sub Work()
End SubThese special comments (well, the actual description string) would then be visible in the object browser's bottom panel, and in Rubberduck's context-sensitive selection command bar, whenever an
IWorker member is selected anywhere in the code.The write-only
Events property is also a little flag: it prompts for a better design - a factory method off a default instance comes to mind:Option Explicit
'@PredeclaredId
Implements IWorker
Private Type TWorker
Events As IWorkerEvents
End Type
Private this As TWorker
'@Description "Creates a new worker instance."
Public Function Create(ByVal workerEvents As IWorkerEvents) As IWorker
If workerEvents Is Nothing Then Err.Raise 5, "IWorkerEvents instance cannot be Nothing."
With New Worker1
Set .Events = workerEvents
Set Create = .Self
End With
End Function
'@Description "Gets this instance through the IWorker interface. Used by the Create method."
Public Property Get Self() As IWorker
Set Self = Me
End Property
'@Description "Gets or sets the worker events. Useless from default instance."
Friend Property Get Events() As IWorkerEvents
Set Events = this.Events
End Property
Friend Property Set Events(ByVal value As IWorkerEvents)
Set this.Events = value
End Property
Private Sub IWorker_Work()
If this.Events Is Nothing Then Err.Raise 5, "Instance was not created with .Create method."
Debug.Print "Worker 1 works hard."
this.Events.Notify Me, "is working..."
End SubThe
IWorker interface then looks like this:Option Explicit
Public Sub Work()
End SubSo the client code is written against
IWorker and only sees a Work method, and that's really all they need to care about.Guard clauses ensure the object is always in a valid state and prevent misusing the class.
The
Worker1 concrete class has a VB_PredeclaredId attribute, which exposes the Create method, so the code that New's up a Worker1 class can do this instead:With Worker1.Create(workerEvents)
.Work
End WithThe fact that
Events is visible from a Worker1 instance is not a problem, because the client code does not work from that interface, it only ever sees IWorker members; the Friend modifiers could just as well be Public, but there's no point exposing them beyond this VBAProject, so Friend is good enough.Notice I removed the
Notify procedure (which was implicitly Public), because it's really just an implementation detail that doesn't need to be exposed, and can very well simply be inlined in the Work method.Until the next Rubberduck release, the module and member attributes need to be added manually, by exporting the module, editing them in, and then re-importing the module.
I like seeing test code. VBA code that works off interfaces and injected dependencies want to be tested! With Rubberduck you could have written unit tests that actually document the implementation/specs, for example in some
Worker1Tests module:Option Explicit
Option Private Module
'@TestModule
'@Folder "Tests"
Private Assert As New Rubberduck.AssertClass
Private Fakes As New Rubberduck.FakesProvider
'@TestMethod
Public Sub GivenNullWorkerEvents_Throws()
Const ExpectedError As Long = 5
On Error GoTo TestFail
Dim sut As Worker1
Set sut = New Worker1
If Not sut.Events Is Nothing Then Assert.Inconclusive "Events should be Nothing"
sut.Work
Assert:
Assert.Fail "Expected error was not raised."
TestExit:
Exit Sub
TestFail:
If Err.Number = ExpectedError Then
Resume TestExit
Else
Resume Assert
End If
End SubThis simple test passes when the
Work method raises run-time error 5 because the object wasn't created with the Create function.Another test would pass when the
Work method would raise the Notify event on a fake implementation of the IWorkerEvents class, ensurinCode Snippets
'@Description "Sets the event provider object for this instance."
Public Property Set Events(ByRef value As IWorkerEvents)
End Property
'@Description "Executes the worker."
Public Sub Work()
End SubOption Explicit
'@PredeclaredId
Implements IWorker
Private Type TWorker
Events As IWorkerEvents
End Type
Private this As TWorker
'@Description "Creates a new worker instance."
Public Function Create(ByVal workerEvents As IWorkerEvents) As IWorker
If workerEvents Is Nothing Then Err.Raise 5, "IWorkerEvents instance cannot be Nothing."
With New Worker1
Set .Events = workerEvents
Set Create = .Self
End With
End Function
'@Description "Gets this instance through the IWorker interface. Used by the Create method."
Public Property Get Self() As IWorker
Set Self = Me
End Property
'@Description "Gets or sets the worker events. Useless from default instance."
Friend Property Get Events() As IWorkerEvents
Set Events = this.Events
End Property
Friend Property Set Events(ByVal value As IWorkerEvents)
Set this.Events = value
End Property
Private Sub IWorker_Work()
If this.Events Is Nothing Then Err.Raise 5, "Instance was not created with .Create method."
Debug.Print "Worker 1 works hard."
this.Events.Notify Me, "is working..."
End SubOption Explicit
Public Sub Work()
End SubWith Worker1.Create(workerEvents)
.Work
End WithOption Explicit
Option Private Module
'@TestModule
'@Folder "Tests"
Private Assert As New Rubberduck.AssertClass
Private Fakes As New Rubberduck.FakesProvider
'@TestMethod
Public Sub GivenNullWorkerEvents_Throws()
Const ExpectedError As Long = 5
On Error GoTo TestFail
Dim sut As Worker1
Set sut = New Worker1
If Not sut.Events Is Nothing Then Assert.Inconclusive "Events should be Nothing"
sut.Work
Assert:
Assert.Fail "Expected error was not raised."
TestExit:
Exit Sub
TestFail:
If Err.Number = ExpectedError Then
Resume TestExit
Else
Resume Assert
End If
End SubContext
StackExchange Code Review Q#163158, answer score: 7
Revisions (0)
No revisions yet.