9
\$\begingroup\$

Context

Usually, when I have to deal with a collection of items (especially objects) I tent to create a container class for that collection (wrapper?). What I mean by that is: when I have to handle multiple clsCars objects I collect them inside clsCars class.


Building blocks

clsCar

Private pModel as String
Private pManufacturer as String
Public Property Get Model() as String
 Model = pModel
End Property
Public Property Let Model(ByVal Value as String)
 If Value = vbNullString Then
 Error.ArgumentException vbNullString, vbNullString
 End if
 pModel = Value
End Property
Public Property Get Manufacturer() as String
 Manufacturer = pManufacturer
End Property

To enforce a collection-like functionality would I implement a custom made ICollection interface in each container class.

ICollection

Public Sub Add(Byref Item as Object)
End Sub
Public Sub Remove(ByVal Index as Long)
End Sub
Public Function Count() as Long
End Function
Public Function Item(ByVal Index as Long) as Object
End Function

The way I would implement this interface is as following:

clsCars

Public Sub Add(Byref Item as clsCar)
 ICollection_Add Item
End Sub
Public Sub Remove(ByVal Index as Long)
 ICollection_Remove Index
End Sub
Public Function Count() as Long
 Count = ICollection_Count()
End Function
Public Function Item(ByVal Index as Long) as clsCar
 Set Item = ICollection_Item(Index) 
End Function
Private Sub ICollection_Add(Byref Item as Object)
 pContent.Add Item
End Sub
Private Sub ICollection_Remove(ByVal Index as Long)
 pContent.Remove Index
End Sub
Private Function ICollection_Count() as Long
 ICollection_Count = pContent.Count
End Function
Private Function ICollection_Item(ByVal Index as Long) as Object
 Set ICollection_Item = pContent(Index)
End Function

Sometimes, if there is a need to add a many clsCar objects, I would create an extra AddRange method.

clsCars

Public Sub AddRange(ByRef Items as clsCars)
 If Items is Nothing Then
 Error.ArgumentNullException vbNullString, vbNullString
 End if
 Dim Item as clsCar
 For each Item in Items.Content
 Me.Add Item
 Next Item
 Set Item = Nothing
End Sub

Finally, to iterate over items is use this dirty method. pContent is read-only filed.

clsCars

Private pContent as New Collection
Public Property Get Content() as Collection
 Set Content = pContent
End Property

But the clsCars class is not only responsible for storing clsCar objects, clsCars class can also perform simple filtering using properties of clsCar class and items inside the container. Consider:

clsCars

Public Function FilterByModel(ByVal Model as String) as clsCars
 If Model = vbNullString Then
 Error.ArgumentException vbNullString, vbNullString
 End if
 Dim Item as clsCar
 Dim Output as New clsCars
 For Each Item in pContent
 If Item.Model = Model Then
 Output.Add Item
 End if
 Next Item
 Set FilterByModel = Output
 Set Output = Nothing
 Set Item = Nothing
End Function
Public Function FilterByManufacturer(ByVal Manufacturer as String) as clsCars
 If Manufacturer = vbNullString Then
 Error.ArgumentException vbNullString, vbNullString
 End if
 Dim Item as clsCar
 Dim Output as New clsCars
 For Each Item in pContent
 If Item.Manufacturer = Manufacturer Then
 Output.Add Item
 End if
 Next Item
 Set FilterByManufacturer = Output
 Set Output = Nothing
 Set Item = Nothing
End Function

Implementing FilterByModel this way would allow me to do chain-filtering if necessary.

Cars.FilterByManufacturer("Ford").FilterByModel("Focus")

Error

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "Error"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Sub ArgumentNullException(ByVal ParamName As String, ByVal Message As String)
 Err.Raise 513, , "Value cannot be null." & vbNewLine & vbNewLine & _
 "Additional information: " & Message & vbNewLine & vbNewLine & _
 "Parameter: " & ParamName
End Sub 
Public Sub ArgumentException(ByVal ParamName As String, ByVal Message As String)
 Err.Raise 518, , "An exception of type ArgumentException was thrown." & vbNewLine & vbNewLine & _
 "Additional information: " & Message & vbNewLine & vbNewLine & _
 "Parameter: " & ParamName
End Sub

My thoughts while I was working on this:

  • Each FilterBy[PropertyName] function will be very similar. I could look into this and try to find some common ground/function.
  • Container class (in this case clsCars) will accept only specific type as an item (clsCars will not accept, as an item, for example a clsBook object)
  • I might end up with a lot of the same code which just does the same thing as VBA.Collection. See Add(), Remove(), Count(), Item()
  • It would be nice to have function which would select all clsCars if Manufacturer or Model matches with the input. Example: MatchOr("Manufacturer = Ford Or Model = Polo").

Conclusion

Should I continue doing things this way? Do you see any advantages/disadvantages following this sudo-practice? I hope my lack of proper English does not hurt your eyes too much!

asked Feb 26, 2019 at 17:32
\$\endgroup\$
7
  • \$\begingroup\$ I hope my lack of proper English does not hurt your eyes too much! -- I have to say, cls-prefix in the name of any class module hurts my eyes much harder than any English mistakes (is that "sudo" meant to be "pseudo"?) ;-) \$\endgroup\$ Commented Feb 26, 2019 at 17:50
  • \$\begingroup\$ Ha :). My Uni teacher used a few times term "sudo-code" interchangeability with "pseudo-code". From that context I assumed they mean the same thing. If they are not the same thing then, it might be another thing to fix :) \$\endgroup\$ Commented Feb 26, 2019 at 17:56
  • 1
    \$\begingroup\$ All I can think of when I read "sudo", is this XKCD comic \$\endgroup\$ Commented Feb 26, 2019 at 17:57
  • \$\begingroup\$ Please edit the ...actual implementation... into the post; it's hard to review a custom collection class when all that's there is a wireframe view of it. Same for ...stuff... \$\endgroup\$ Commented Feb 26, 2019 at 18:14
  • 1
    \$\begingroup\$ Thanks... Your code doesn't compile though, does it? \$\endgroup\$ Commented Feb 26, 2019 at 18:57

1 Answer 1

8
\$\begingroup\$

To enforce a collection-like functionality would I implement a custom made ICollection interface in each container class.

While an ICollection interface is nice in theory, in practice it doesn't really play nicely with how VBA implements enumerables. The single main advantage of using an object collection is its ability to leverage [_NewEnum] and be iterated with a For Each loop... but you can't have that functionality through an interface.

What's nice about ICollection is that it abstracts away the notion of something that can act as a collection, enabling client code to leverage polymorphism and work with a FooCollection or a BarCollection seamlessly, or even work with a Queue or a Stack custom collection that would implement the same interface. But here we're looking at a Cars collection, and if our client code is written against ICollection then we lose everything that's useful about the custom collection (e.g. filtering capabilities), and might as well be working with some VBA.Collection instance.

But the clsCars class is not only responsible for storing clsCar objects

See, with an ICollection interface you're forced to have this:

Public Sub Add(ByRef Item as Object)
End Sub

By the way, that should be ByVal, not ByRef. Anyway, the problem with that is that you can't legally have this:

Private Sub ICollection_Add(ByRef Item as clsCar)
 ' Actual implementation...
End Sub

Because the signature mismatches that of the interface: Item must be Object, otherwise the interface contract isn't fulfilled and the code can't compile.

I'd just ditch the ICollection interface and make a Cars collection that requires Car items to be added.

That would instantly shrink the Cars class by half, and enable goodies such as these:

'@DefaultMember
Public Property Get Item(ByVal index As Variant) As Object
 Set Item = internal.Item(index)
End Property
'@Enumerator
Public Property Get NewEnum() As IUnknown
 Set NewEnum = internal.[_NewEnum]
End Property

If you aren't using Rubberduck, you might not know that these special @Comments actually control hidden member attributes. The @DefaultMember annotation makes these two statements equivalent:

Set theCar = allCars.Item("foo")
Set theCar = allCars("foo")

And the @Enumerator annotation makes this code legal:

For Each theCar In allCars
 Debug.Print theCar.Model
Next

By convention, the Item property if a collection class is that class' default member.


I would have made Count and Item members be Property Get procedures, not Function. The reason VBA.Collection has them as Function procedures is historical; Count as a method implies much more work going on than what's actually happening, and Item simply makes complete sense as a default property.


As for the filtering, consider taking inspiration from .NET here - now there's a legit case for polymorphism!

'@Interface IPredicate
Option Explicit
Public Function IsTrue(ByVal obj As Object, ByVal value As Variant) As Boolean
End Function

Now you can have a MatchesManufacturerPredicate that might look like this:

Option Explicit
Implements IPredicate
Private Function IsTrue(ByVal obj As Object, ByVal value As Variant) As Boolean
 If Not TypeOf obj Is Car Then Error.InvalidArgumentException
 IsTrue = (obj.Manufacturer = value)
End Function

Then the Cars collection can have a FilterBy(ByVal predicate As IPredicate) method that simply runs the collection through the encapsulated function!

Set toyotas = allCars.FilterBy(New MatchesManufacturerPredicate, "Toyota")
Set fords = allCars.FilterBy(New MatchesManufacturerPredicate, "Ford")
Set p911s = allCars.FilterBy(New MatchesModelPredicate, "911")
Set oldCars = allCars.FilterBy(New LessThanYearPredicate, 2009)

With a single FilterBy method on the collection, you can now have infinite filtering possibilities, as long as you're willing to encapsulate the filtering function into its own class.

Robert Todar
2951 gold badge2 silver badges16 bronze badges
answered Feb 26, 2019 at 18:45
\$\endgroup\$
2
  • \$\begingroup\$ Hey. Thanks for you input, but I can't get this code to run. Should I create a new post here, or should I provide code somewhere else? \$\endgroup\$ Commented Feb 27, 2019 at 8:59
  • \$\begingroup\$ Never mind, I managed to fix my own problems by myself :). I like your view on this problem. Thanks for tips regarding filtering! I might follow up regarding this topic in the future. Thanks for your time! \$\endgroup\$ Commented Feb 27, 2019 at 9:19

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.