You can probably skim most of this, it’s unlikely to be useful for a review and is just for background info. Also download the files
I have a project which requires a caller to pass flag values to child procedures; these procedures may wish to edit the value of the flags, and the caller should have these changes reflected in its own copies of them. Ordinarily a perfect candidate for such a flag would be a
ByRef Boolean – the parent creates an array of truthy flags and passes them
ByRef to the procedures.
However this approach is messy when the number of children is dynamic; ideally a
VBA.Collection of flags would be held by the parent – but collections can only add value types (like Booleans)
ByVal – the changes the child procedures make to the flags will not be reflected in the content of the
Collection. A workaround would be to use pointers directly, or do some clever array ReDimming, but the solution I went with was to use a
Bool object in place of the
Boolean flags – these can always be passed as references.
Anyway, I appreciate that’s all a bit theoretical, in fact my precise motivation isn’t really necessary right now and will be up for scrutiny in a later post with the class in use, for now though there’s only one more thing to add:
Separately, I’ve been planning to replace many of the mundane data types in VBA with some more jazzy object-y ones – a bit like python has – which will eventually allow me to create classes which determine their own responses to operations. For now though I’m mostly focusing on the data storage aspects; how my class can be used in place of the datatype it encapsulates, and later I’ll look at stuff like operator overloading and inheritance.
Here’s the main class – which can be seen as a foundation for what’s described above
'@Folder("API.Utils") '@ModuleDescription("Boolean object that can be passed byRef") '@PredeclaredID Option Explicit 'NOTE RtlCopyMemory would be faster (as source and dest won't overlap) but is not exposed to VBA ''@Description("API: Destination and Source can be byVal pointers or byRef variables, length is LenB(dataType)") #If Win64 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long) Private Declare PtrSafe Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef destination As Any, ByVal length As Long) #Else Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long) Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef destination As Any, ByVal length As Long) #End If Private Type tBool Value As Boolean End Type Private this As tBool '@Description("Truthy encapsulated value") '@DefaultMember Public Property Get Value() As Boolean Value = this.Value End Property Public Property Let Value(ByVal newVal As Boolean) this.Value = newVal End Property '@Description("Create instance of Bool class from objPtr") Public Function FromPtr(ByVal pData As LongPtr) As Bool 'TODO fails in VB6 as no LongPtr Dim result As New Bool CopyMemory result, pData, LenB(pData) Set FromPtr = result ZeroMemory result, LenB(pData) ' free up memory, equiv: CopyMemory result, 0&, LenB(pData) End Function '@Description("Class Constructor takes Boolean or Boolean-like values") Public Function Create(ByVal initialValue As Variant) As Bool Dim result As New Bool result.Value = CBool(initialValue) Set Create = result End Function
'@PredeclaredId; I’m using this class as a factory for instances of itself – it’ll probably go into an addin as
PublicNotCreatable so requires a factory of some sort. It has 2 constructor methods,
.Self; I like using
With New Blah statements in the constructors like in this answer, but I thought the additional
.Self method or equivalent would clutter the interface and lead to additional confusion given the next point
'@DefaultMember; going against all of Rubberduck’s advice, I’ve used a default member which is not a
.Item method. But here I think it’s justified, as the class is meant only to be a wrapper for actual data; the class must have an intrinsic encapsulated value in order to operate correctly. And that value is all that is required to
Create an indistinguishable instance of the class. I feel a default member should represent what a class is – a
Bool is the value of the encapsulated variable, the point in a Collection specified by a key/ index is the item located there. A Range is not simply the value in the cell, it is also the address and the formatting and … that’s why Range’s default member is so confusing.
As well as feedback on the approach and functionality of the class, I’d really appreciate some insight on best practices regarding layout, documentation and structure of the project, as such I’ve included all the comments/attributes and here are some unit tests:
Option Explicit Option Private Module '@TestModule '@Folder("API.Utils.Tests") Private Assert As Rubberduck.PermissiveAssertClass Private Fakes As Rubberduck.FakesProvider '@ModuleInitialize Private Sub ModuleInitialize() 'this method runs once per module. Set Assert = New Rubberduck.PermissiveAssertClass Set Fakes = New Rubberduck.FakesProvider End Sub '@ModuleCleanup Private Sub ModuleCleanup() 'this method runs once per module. Set Assert = Nothing Set Fakes = Nothing End Sub '@TestInitialize Private Sub TestInitialize() 'this method runs before every test in the module. End Sub '@TestCleanup Private Sub TestCleanup() 'this method runs after every test in the module. End Sub '@TestMethod("Uncategorized") Private Sub DefaultPropertyLetGet() On Error GoTo TestFail 'Arrange: Dim b As New Bool b.Value = False 'Act: b = True 'Assert: Assert.AreEqual True, b.Value Assert.AreEqual True, (b) 'should just be b - this is an issue with the assert class TestExit: Exit Sub TestFail: Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description End Sub '@TestMethod("Uncategorized") Private Sub ClassConstructor() On Error GoTo TestFail 'Arrange: Dim a As Bool, b As Bool, c As Bool 'Act: Set b = Bool.Create(True) Set a = Bool.Create(False) Set c = Bool.Create(a) 'implicit conversion with CBool 'Assert: Assert.AreEqual True, b.Value Assert.AreEqual False, a.Value Assert.AreEqual a.Value, c.Value Assert.AreNotSame a, c 'c only has the same value as a TestExit: Exit Sub TestFail: Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description End Sub '@TestMethod("Uncategorized") Private Sub AssigningByReferenceCanOverwrite() On Error GoTo TestFail 'Arrange: Dim base As Bool, copy As Bool 'Act: Set base = Bool.Create(True) Set copy = Bool.FromPtr(ObjPtr(base)) copy = False 'Assert: Assert.AreEqual False, base.Value Assert.AreSame base, copy TestExit: Exit Sub TestFail: Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description End Sub '@TestMethod("Uncategorized") Private Sub InvalidConstructionRaisesTypeMismatchError() Const ExpectedError As Long = 13 'type mismatch On Error GoTo TestFail 'Arrange: Dim b As Bool 'Act: Set b = Bool.Create("Not a boolean!") 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
I’m not sure if I’m using these quite right; I wrote them all after I’d written the class itself. Additionally, I’ve had to qualify the default member explicitly with
b.Value in the tests; I believe this is a bug/ incorrect behaviour in the
Rubberduck.PermissiveAssertClass (I made a comment to that effect in the repository)