6
\$\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!

\$\endgroup\$
  • \$\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\$ – Mathieu Guindon Feb 26 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\$ – FlameHorizon Feb 26 at 17:56
  • 1
    \$\begingroup\$ All I can think of when I read "sudo", is this XKCD comic \$\endgroup\$ – Mathieu Guindon Feb 26 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\$ – Mathieu Guindon Feb 26 at 18:14
  • 1
    \$\begingroup\$ Thanks... Your code doesn't compile though, does it? \$\endgroup\$ – Mathieu Guindon Feb 26 at 18:57
5
\$\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

BTW 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, oterwise 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 haf, 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.

\$\endgroup\$
  • \$\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\$ – FlameHorizon Feb 27 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\$ – FlameHorizon Feb 27 at 9:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.