HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Using events together with interfaces in VBA

Submitted by: @import:stackexchange-codereview··
0
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 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 Sub


IWorkerEvents

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 Sub


The 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 Sub


Worker2

```
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 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:

  • Public access modifier is sometimes explicit, often implicit.



  • Not sure why IWorkerEvents parameter needs to be passed ByRef.



  • Not sure why Message parameter needs to be passed ByRef.



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 Sub


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 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 Sub


The IWorker interface then looks like this:

Option Explicit

Public Sub Work()
End Sub


So 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 With


The 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 Sub


This 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, ensurin

Code 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 Sub
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 Sub
Option Explicit

Public Sub Work()
End Sub
With Worker1.Create(workerEvents)
    .Work
End With
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 Sub

Context

StackExchange Code Review Q#163158, answer score: 7

Revisions (0)

No revisions yet.