6
\$\begingroup\$

I am working an a more meaningful way to print objects in VBA. The desired result should look something like this.

Console.PrintLine List.Create(1, 2, 3)
List(1, 2, 3)

The concept is that objects implementing an IPrintable interface are printed as their ToString property. Primitive data types are printed as is

Console.PrintLine "a"
a

And other objects are represented as "TypeName(&ObjPtr)"

Console.PrintLine New Collection
Collection(&150653720)

But the issue that is gunking up my design is that I want nested objects to represent themselves

Console.PrintLine List.Create(1, List.Create(), New Collection)
List(1, List(), Collection(&150653384))

My solution is to use an auxiliary helper methods, located in a standard module called cast, which in a way provides a default implementation of IPrintable

Public Function ToString(ByVal x As Variant) As String

    Dim result As String

    If TypeOf x Is IPrintable Then
        result = x.ToString
    ElseIf IsObject(x) Then
        result = DefaultObjectToString(x)
    Else
        result = CStr(x)
    End If

    ToString = result

End Function
Private Function DefaultObjectToString(ByVal x As Object) As String

    DefaultObjectToString = ObjectToString(x, cast.CArray(Array("&" & ObjPtr(x))))

End Function
Public Function ObjectToString(ByVal o As Object, ByRef members() As Variant, _
        Optional ByVal delim As String = ", ") As String

    Dim stringMembers() As String
    If LBound(members) <= UBound(members) Then
        ReDim stringMembers(LBound(members) To UBound(members))
    End If

    Dim i As Long
    For i = LBound(members) To UBound(members)
        stringMembers(i) = ToString(members(i))
    Next i

    ObjectToString = TypeName(o) & "(" & Join(stringMembers, delim) & ")"

End Function

I would want this to be located in the IPrintable class but that must be empty to use it as an interface.

Now any method that is printing the objects can just use cast.ToString like console does

Public Sub PrintLine(Optional ByVal x As Variant)

    If IsMissing(x) Then
        Debug.Print vbNullString
    Else
        Debug.Print cast.ToString(x)
    End If

End Sub

Also here is how List implements IPrintable (ToArray is just an array version of the list.)

Public Property Get ToString(Optional delim As String = ", ") As String

    ToString = cast.ObjectToString(Me, ToArray, delim)

End Property
Public Property Get IPrintable_ToString() As String

    IPrintable_ToString = ToString()

End Property

If I had a BinaryTree object it would look like this.

Public Property Get ToString() As String

    ToString = cast.ObjectToString(Me, Array(LeftTree, RightTree), ", ")

End Property
\$\endgroup\$
  • \$\begingroup\$ Sorry it's taken me a while to look at this. Can you elaborate on why you want Cast to be a class? \$\endgroup\$ – RubberDuck Feb 4 '15 at 2:01
  • \$\begingroup\$ cast is a standard module not a class. I will update the post to specify \$\endgroup\$ – cheezsteak Feb 4 '15 at 14:48
  • \$\begingroup\$ Right. I get that, but I don't understand why exactly you need it to be a class. It seems an appropriate use for a module. \$\endgroup\$ – RubberDuck Feb 4 '15 at 14:51
  • 1
    \$\begingroup\$ @RubberDuck There really isn't an appropriate place for it. It really should be in IPrintable as a default implementation, but those don't exist in VBA. Making it a static class implies that I should be able to pass it as an argument but idk if that should be allowed or not. \$\endgroup\$ – cheezsteak Feb 4 '15 at 15:17
  • 2
    \$\begingroup\$ I'd love to see this Cast module! \$\endgroup\$ – Mathieu Guindon Feb 4 '15 at 15:20
5
\$\begingroup\$

I don't see anything ugly about your Cast module. If it was .Net I would use a Static (Shared) type class, and a standard *.bas module is roughly equivalent in VB6. It seems to have been the right move to me.

What I do question is the usefulness of defaulting to the object's pointer as a string representation of it. Since VB6 supports default properties, I would take advantage of it. It's not exactly pretty, but perhaps a more useful representation of an object.

Private Function TryCastToString(x As Variant) As String
    On Error GoTo ErrHandler

    TryCastToString = CStr(x)

    Exit Function

ErrHandler:
    Const MethodNotSupportedError As Integer = 438

    If Err.Number = MethodNotSupportedError Then
        TryCastToString = "&" & ObjPtr(x)
    Else
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Function

Which would change this function:

Private Function DefaultObjectToString(ByVal x As Object) As String

    DefaultObjectToString = ObjectToString(x, cast.CArray(Array("&" & ObjPtr(x))))

End Function

Into this:

Private Function DefaultObjectToString(ByVal x As Object) As String

    DefaultObjectToString = ObjectToString(x, cast.CArray(Array(TryCastToString(x))))

End Function

This provides a much nicer string back. Consider a workbook with a value of "Hello!" in cell A1 and the following code.

Public Sub test()
    Debug.Print Cast.ToString(ThisWorkbook)
    Debug.Print Cast.ToString(Range("A1"))
End Sub

This would result in the following:

Workbook(&2349672)
Range(Hello!)
\$\endgroup\$

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.