Nested Definition of UDT

**SearchingDataOnly** · Feb 27th, 2022, 09:39 AM

I'm changing classes in my project to UDTs (Type-Defs) and I'm running into a problem that I haven't noticed before:

In the class, we can design it like this:

Code:

Class cNode
    Parent As cNode
    FirstSibling As cNode
    LastSibling As cNode
End Class

However, we don't seem to be able to do such nesting in UDTs (Type-Defs), for example:

Code:

Type tNode
    Parent As tNode
    FirstSibling As tNode
    LastSibling As tNode
End Type

The above definition will show an error. I would like to know, what is a good solution for such a situation? Thanks.

**Peter Swinkels** · Feb 27th, 2022, 12:45 PM

Is the first part even vb6 code? I don't ever remember creating a class that way in that version of vb. Your code looks like vb.net.

Could you explain what you're trying to do?

**Elroy** · Feb 27th, 2022, 12:52 PM

Peter, you can have nested UDTs. You just can't have circular-referenced UDTs. That's one advantage classes have over UDTs. I use UDTs a lot, and if I wanted to do something like you're suggesting, I'd just make a separate UDT for each nesting level. However, this does limit you to the depth of your nesting (to the number of UDT levels you declared).

But, if it were me, I'd probably stick with classes to do this, and actually have when doing things with TreeNodes.

Code for clsTreeNodeCopy module:

Code:

Option Explicit
'
' Our saved node properties. These are basically what make this a copy.
Dim TheBackColor As Long
Dim mbBold As Boolean
Dim mbChecked As Boolean
Dim mbExpanded As Boolean
Public TheForeColor As Long
'Dim msKey As string ' Not used at the moment.
Public TheTag As String
Public TheText As String
'
' Collection of our children.
Dim cChildren As New Collection ' <--- This winds up being a collection of THIS class's objects.
'

Private Sub Class_Initialize()
TheBackColor = &H80000005 ' Just so we don't always have to mess with it.
TheForeColor = &H80000008 ' Just so we don't always have to mess with it.
End Sub

Friend Function AddChild(Optional sText As String, Optional sTag As String, Optional iForeColor As Long = &H80000008) As clsTreeNodeCopy
' This is for manually building a copy.
'
Dim oChildCopy As New clsTreeNodeCopy
oChildCopy.TheText = sText
oChildCopy.TheTag = sTag
oChildCopy.TheForeColor = iForeColor
cChildren.Add oChildCopy
Set AddChild = oChildCopy
End Function

Friend Sub CopyNode(oNode As Node) ' Copies all descendants.
'
' First, copy all the properties we're interest in.
TheBackColor = oNode.BackColor
mbBold = oNode.Bold
mbChecked = oNode.Checked
mbExpanded = oNode.Expanded
TheForeColor = oNode.ForeColor
'msKey = oNode.Key ' Not used at the moment.
TheTag = oNode.Tag
TheText = oNode.Text
'
' Now we climb down the tree and do the same for all the descendants.
Dim oChildNode As Node
Set oChildNode = oNode.Child
Do While Not oChildNode Is Nothing
Dim oChildCopy As clsTreeNodeCopy
Set oChildCopy = New clsTreeNodeCopy ' Make sure it's a fresh instantiation.
oChildCopy.CopyNode oChildNode ' This is sort of recursion.
cChildren.Add oChildCopy ' Save our child in our collection.
Set oChildNode = oChildNode.Next ' On to next child until we're out.
Loop
'
' We should have it all now.
End Sub

Friend Sub Iterate(Optional iLevel As Long)
' This is really just for testing.
'
Debug.Print Space$(iLevel * 4&); TheText
Dim oChildCopy As clsTreeNodeCopy
For Each oChildCopy In cChildren
oChildCopy.Iterate iLevel + 1& ' Recursion (sort of).
Next
End Sub

Friend Function InsertBeforeSibling(tvw As TreeView, oSibling As Node) As Node
' Typically, this is just called by the parent program.
' Returns the new node.
'
' Add the node and set the properties.
If oSibling Is Nothing Then Exit Function ' Just a validity check.
Set InsertBeforeSibling = tvw.Nodes.Add(oSibling, tvwPrevious)
SetNodeProperties InsertBeforeSibling
'
' Now insert all the descendants.
Dim oChildCopy As clsTreeNodeCopy
For Each oChildCopy In cChildren
oChildCopy.InsertAsChild tvw, InsertBeforeSibling
Next ' When we fall out, it should all be inserted.
End Function

Friend Function InsertAfterSibling(tvw As TreeView, oSibling As Node) As Node
' Typically, this is just called by the parent program.
' Returns the new node.
'
' Add the node and set the properties.
If oSibling Is Nothing Then Exit Function ' Just a validity check.
Set InsertAfterSibling = tvw.Nodes.Add(oSibling, tvwNext)
SetNodeProperties InsertAfterSibling
'
' Now insert all the descendants.
Dim oChildCopy As clsTreeNodeCopy
For Each oChildCopy In cChildren
oChildCopy.InsertAsChild tvw, InsertAfterSibling
Next ' When we fall out, it should all be inserted.
End Function

Friend Function InsertAsChild(tvw As TreeView, oParent As Node) As Node
' Typically, this is called as part of restoring the tree branches.
' But it can also be useful when adding new stuff to a tree.
'
' Add the node and set the properties.
If oParent Is Nothing Then Exit Function
Set InsertAsChild = tvw.Nodes.Add(oParent, tvwChild)
SetNodeProperties InsertAsChild
'
' Now insert all the descendants.
Dim oChildCopy As clsTreeNodeCopy
For Each oChildCopy In cChildren
oChildCopy.InsertAsChild tvw, InsertAsChild ' Recursion (sort of).
Next ' When we fall out, it should all be inserted.
End Function

Private Sub SetNodeProperties(oNode As Node)
oNode.BackColor = TheBackColor
oNode.Bold = mbBold
oNode.Checked = mbChecked
oNode.Expanded = mbExpanded
oNode.ForeColor = TheForeColor
oNode.Tag = TheTag
oNode.Text = TheText
End Sub

**dilettante** · Feb 27th, 2022, 01:40 PM

Just make your "node" be elements of a UDT array. Then each "node" can hold array indexes of its parent and sibling nodes.

If the DOM has to be able to grow (this sure seems like the same benighted attempt to create a massive JSON DOM... for "reasons" undisclosed) then just manage array resizing in chunks as you would for any large growable/srhinkable array.

**The trick** · Feb 27th, 2022, 03:21 PM

You can't use a circular declarations in UDTs because it doesn't make sense (the size of UDT tends to infinity). Just use a flat array with your nodes and store the index of its siblings in each node.

**Zvoni** · Feb 28th, 2022, 03:13 AM

Originally Posted by The trick

You can't use a circular declarations in UDTs because it doesn't make sense (the size of UDT tends to infinity). Just use a flat array with your nodes and store the index of its siblings in each node.

Why wouldn't it make sense?
It's a basic setup for linked lists stemming from a time there were no "classes" (remember "struct" in C)
The difference is: for that to work you actually need a pointer to such a structure

IMO it's the reason why it works with classes in vb6/vba, because a class-variable IS basically a pointer

To stay in OP's sample
Untested

Code:

Type tNode
    Parent As Long
    FirstSibling As Long
    LastSibling As Long
End Type

And then VarPtr / CopyMemory the hell out of it, and store it in the Members

That said: I'd stay with classes in vb6/vba. Too much hassle

**The trick** · Feb 28th, 2022, 11:34 AM

Why wouldn't it make sense?

Because of it doesn't make sense anywhere. You can't for example to do it in C/C++:

Code:

struct tNode {
	tNode Parent;
	tNode FirstSibling;
	tNode LastSibling;
};

A linked list is based on pointers not nodes itself. VB6 doesn't support pointers to UDTs. You can use pointers to an array (indices) as it was suggested. The advantage is better performance. For example this is a hash table class which is based on UDTs:

Code:

' //
' // CHashTable.cls - hash table with string keys
' //

Option Explicit
Option Base 0

Private Const HASH_SIZE As Long = 587

Private Type tHashPointer
    lHash   As Long
    lIndex  As Long
End Type

Private Type tHashItem
    vValue      As Variant
    sKey        As String
    lNext       As Long
    lPrevEnum   As Long
    lNextEnum   As Long
End Type

Private m_tItems()          As tHashItem
Private m_bCaseInsensitive  As Boolean
Private m_lCount            As Long
Private m_lFirstFree        As Long
Private m_lFirstItem        As Long
Private m_lLastItem         As Long

Public Property Get CaseInsensitive() As Boolean
    CaseInsensitive = m_bCaseInsensitive
End Property

Public Property Let CaseInsensitive( _
                    ByVal bValue As Boolean)
    
    If m_lCount Then
        Err.Raise 5
    End If
    
    m_bCaseInsensitive = bValue
    
End Property

Public Function Exists( _
                ByRef sKey As String) As Boolean
    Exists = FindItem(sKey).lIndex <> -1
End Function

Public Property Get Item( _
                    ByRef sKey As String) As Variant
    Dim tPointer    As tHashPointer
    
    tPointer = FindItem(sKey)
    
    If tPointer.lIndex = -1 Then
        Item = Empty
    Else
        If IsObject(m_tItems(tPointer.lIndex).vValue) Then
            Set Item = m_tItems(tPointer.lIndex).vValue
        Else
             Item = m_tItems(tPointer.lIndex).vValue
        End If
    End If

End Property

Public Property Let Item( _
                    ByRef sKey As String, _
                    ByVal vValue As Variant)
    Dim tPointer    As tHashPointer
    
    tPointer = FindItem(sKey)

    If IsEmpty(vValue) Then
        If tPointer.lIndex = -1 Then
            Exit Property
        Else
            DeleteItem sKey
        End If
    Else
    
        If tPointer.lIndex = -1 Then
            tPointer = AddItem(sKey)
        End If
        
        m_tItems(tPointer.lIndex).vValue = vValue
        
    End If
    
End Property

Public Property Set Item( _
                    ByRef sKey As String, _
                    ByVal vValue As Variant)
    Dim tPointer    As tHashPointer
    
    tPointer = FindItem(sKey)

    If IsEmpty(vValue) Then
        If tPointer.lIndex = -1 Then
            Exit Property
        Else
            DeleteItem sKey
        End If
    Else
    
        If tPointer.lIndex = -1 Then
            tPointer = AddItem(sKey)
        End If
        
        Set m_tItems(tPointer.lIndex).vValue = vValue
        
    End If
    
End Property

Public Property Get Count() As Long
    Count = m_lCount
End Property

Public Sub Clear()
    Dim lIndex  As Long
    
    ReDim m_tItems(HASH_SIZE - 1)
    
    For lIndex = 0 To HASH_SIZE - 1
    
        m_tItems(lIndex).lNext = -1
        m_tItems(lIndex).lNextEnum = -1
        m_tItems(lIndex).lPrevEnum = -1
        
    Next
    
    m_lFirstFree = HASH_SIZE
    m_lFirstItem = -1
    m_lLastItem = -1
    m_lCount = 0
    
End Sub

Public Property Get Items() As Variant
    Dim lIndex      As Long
    Dim lItemIndex  As Long
    Dim vRet()      As Variant
    
    If m_lCount Then
        
        ReDim vRet(m_lCount - 1)
        
        lItemIndex = m_lFirstItem
        
        For lIndex = 0 To m_lCount - 1
        
            If IsObject(m_tItems(lItemIndex).vValue) Then
                Set vRet(lIndex) = m_tItems(lItemIndex).vValue
            Else
                vRet(lIndex) = m_tItems(lItemIndex).vValue
            End If
            
            lItemIndex = m_tItems(lItemIndex).lNextEnum
            
        Next
        
        Items = vRet
        
    Else
        Items = Split("")
    End If
    
End Property

Public Property Get Keys() As String()
    Dim lIndex      As Long
    Dim lItemIndex  As Long
    Dim sRet()      As String
    
    If m_lCount Then
        
        ReDim sRet(m_lCount - 1)
        
        lItemIndex = m_lFirstItem
        
        For lIndex = 0 To m_lCount - 1
        
            sRet(lIndex) = m_tItems(lItemIndex).sKey
            lItemIndex = m_tItems(lItemIndex).lNextEnum
            
        Next
    
    End If
    
    Keys = sRet
    
End Property

Public Function CalculateHash( _
                ByVal sKey As String) As Long
    Dim lHash   As Long
    
    If m_bCaseInsensitive Then
        CharLowerBuff StrPtr(sKey), Len(sKey)
    End If
    
    HashData ByVal StrPtr(sKey), LenB(sKey), lHash, Len(lHash)
    
    CalculateHash = (lHash And &H7FFFFFFF) Mod HASH_SIZE
    
End Function

Private Sub DeleteItem( _
            ByRef sKey As String)
    Dim lHash       As Long
    Dim lIndex      As Long
    Dim lNextIndex  As Long
    Dim lPrevIndex  As Long
    Dim eComp       As VbCompareMethod
    
    lHash = CalculateHash(sKey)
    
    If m_bCaseInsensitive Then
        eComp = vbTextCompare
    Else
        eComp = vbBinaryCompare
    End If
    
    lIndex = lHash
    lPrevIndex = -1
    
    Do While StrComp(sKey, m_tItems(lIndex).sKey, eComp)
    
        lPrevIndex = lIndex
        lIndex = m_tItems(lIndex).lNext
        If lIndex = -1 Then Exit Sub    ' // Not found
        
    Loop

    If lPrevIndex = -1 Then
        
        ' // In main hash table
        lNextIndex = m_tItems(lIndex).lNext

        If lNextIndex <> -1 Then
            
            ' // Move next collision to main table
            m_tItems(lIndex).sKey = m_tItems(lNextIndex).sKey
            
            If IsObject(m_tItems(lNextIndex).vValue) Then
                Set m_tItems(lIndex).vValue = m_tItems(lNextIndex).vValue
            Else
                m_tItems(lIndex).vValue = m_tItems(lNextIndex).vValue
            End If
            
            If m_tItems(lIndex).lPrevEnum <> -1 Then
                m_tItems(m_tItems(lIndex).lPrevEnum).lNextEnum = m_tItems(lIndex).lNextEnum
            End If
            
            If m_tItems(lIndex).lNextEnum <> -1 Then
                m_tItems(m_tItems(lIndex).lNextEnum).lPrevEnum = m_tItems(lIndex).lPrevEnum
            End If
            
            If m_tItems(lNextIndex).lPrevEnum <> -1 Then
                m_tItems(m_tItems(lNextIndex).lPrevEnum).lNextEnum = lIndex
            End If
            
            If m_tItems(lNextIndex).lNextEnum <> -1 Then
                m_tItems(m_tItems(lNextIndex).lNextEnum).lPrevEnum = lIndex
            End If
            
            If m_lFirstItem = lNextIndex Then
                m_lFirstItem = lIndex
            ElseIf m_lFirstItem = lIndex Then
                If m_tItems(lIndex).lNextEnum <> lNextIndex Then
                    m_lFirstItem = m_tItems(lIndex).lNextEnum
                End If
            End If
            
            If m_lLastItem = lNextIndex Then
                m_lLastItem = lIndex
            ElseIf m_lLastItem = lIndex Then
                If m_tItems(lIndex).lPrevEnum <> lNextIndex Then
                    m_lLastItem = m_tItems(lIndex).lPrevEnum
                End If
            End If
            
            m_tItems(lIndex).lNextEnum = m_tItems(lNextIndex).lNextEnum
            m_tItems(lIndex).lPrevEnum = m_tItems(lNextIndex).lPrevEnum
            m_tItems(lIndex).lNext = m_tItems(lNextIndex).lNext
            
            DeallocItem lNextIndex
            
        Else
            
            If m_lFirstItem = lIndex Then
                m_lFirstItem = m_tItems(lIndex).lNextEnum
            End If
            
            If m_lLastItem = lIndex Then
                m_lLastItem = m_tItems(lIndex).lPrevEnum
            End If
            
            If m_tItems(lIndex).lNextEnum <> -1 Then
                m_tItems(m_tItems(lIndex).lNextEnum).lPrevEnum = m_tItems(lIndex).lPrevEnum
            End If
            
            If m_tItems(lIndex).lPrevEnum <> -1 Then
                m_tItems(m_tItems(lIndex).lPrevEnum).lNextEnum = m_tItems(lIndex).lNextEnum
            End If

            m_tItems(lIndex).sKey = vbNullString
            m_tItems(lIndex).vValue = Empty
            m_tItems(lIndex).lNext = -1
            m_tItems(lIndex).lNextEnum = -1
            m_tItems(lIndex).lPrevEnum = -1
            
        End If

    Else
        
        m_tItems(lPrevIndex).lNext = m_tItems(lIndex).lNext
        
        If m_lFirstItem = lIndex Then
            m_lFirstItem = m_tItems(lIndex).lNextEnum
        End If
        
        If m_lLastItem = lIndex Then
            m_lLastItem = m_tItems(lIndex).lPrevEnum
        End If
            
        If m_tItems(lIndex).lNextEnum <> -1 Then
            m_tItems(m_tItems(lIndex).lNextEnum).lPrevEnum = m_tItems(lIndex).lPrevEnum
        End If
        
        If m_tItems(lIndex).lPrevEnum <> -1 Then
            m_tItems(m_tItems(lIndex).lPrevEnum).lNextEnum = m_tItems(lIndex).lNextEnum
        End If
        
        DeallocItem lIndex
        
    End If
    
    m_lCount = m_lCount - 1
    
End Sub

Private Function AddItem( _
                 ByRef sKey As String) As tHashPointer
    Dim lIndex      As Long
    Dim lNewIndex   As Long
    Dim eComp       As VbCompareMethod
    
    If m_bCaseInsensitive Then
        eComp = vbTextCompare
    Else
        eComp = vbBinaryCompare
    End If
    
    lIndex = CalculateHash(sKey)
    
    AddItem.lHash = lIndex
    
    Do While StrComp(sKey, m_tItems(lIndex).sKey, eComp)
        If m_tItems(lIndex).lNext = -1 Then
            
            If lIndex = AddItem.lHash And Len(m_tItems(lIndex).sKey) = 0 Then
                lNewIndex = lIndex
            Else
                lNewIndex = AllocItem
                m_tItems(lIndex).lNext = lNewIndex
            End If
            
            m_tItems(lNewIndex).sKey = sKey
            m_tItems(lNewIndex).lNext = -1
            m_tItems(lNewIndex).lNextEnum = -1
            
            If m_lFirstItem = -1 Then
                m_lFirstItem = lNewIndex
            End If
            
            m_tItems(lNewIndex).lPrevEnum = m_lLastItem
            
            If m_lLastItem <> -1 Then
                m_tItems(m_lLastItem).lNextEnum = lNewIndex
            End If
            
            m_lLastItem = lNewIndex
            
            lIndex = lNewIndex
            
            m_lCount = m_lCount + 1
            
            Exit Do
            
        Else
            lIndex = m_tItems(lIndex).lNext
        End If
    Loop
    
    AddItem.lIndex = lIndex
    
End Function

Private Function FindItem( _
                 ByRef sKey As String) As tHashPointer
    Dim lIndex  As Long
    Dim eComp   As VbCompareMethod
    
    If m_bCaseInsensitive Then
        eComp = vbTextCompare
    Else
        eComp = vbBinaryCompare
    End If
    
    lIndex = CalculateHash(sKey)
    
    FindItem.lHash = lIndex
    
    Do While StrComp(sKey, m_tItems(lIndex).sKey, eComp)
        lIndex = m_tItems(lIndex).lNext
        If lIndex = -1 Then Exit Do
    Loop
    
    FindItem.lIndex = lIndex
    
End Function

Private Sub DeallocItem( _
            ByVal lIndex As Long)
                
    m_tItems(lIndex).sKey = vbNullString
    m_tItems(lIndex).vValue = Empty
    m_tItems(lIndex).lNext = m_lFirstFree
    m_tItems(lIndex).lNextEnum = -1
    m_tItems(lIndex).lPrevEnum = -1
    
    m_lFirstFree = lIndex
                
End Sub

Private Function AllocItem() As Long
    Dim lIndex      As Long
    Dim lCurSize    As Long
    
    If m_lFirstFree > UBound(m_tItems) Then
        
        lCurSize = (UBound(m_tItems) + 1)
        ReDim Preserve m_tItems(lCurSize * 2 - 1)
        
        For lIndex = lCurSize To UBound(m_tItems)
        
            m_tItems(lIndex).lNext = lIndex + 1
            m_tItems(lIndex).lNextEnum = -1
            m_tItems(lIndex).lPrevEnum = -1
            
        Next
        
    End If
    
    AllocItem = m_lFirstFree
    m_lFirstFree = m_tItems(m_lFirstFree).lNext
    
End Function

Private Sub Class_Initialize()

    Clear
    m_bCaseInsensitive = True
    
End Sub

**Elroy** · Feb 28th, 2022, 12:07 PM

Zvoni, maybe said like this ... the moment you use a UDT to declare a variable, the memory for that variable is allocated (possibly even at compile-time for module-level and Static variables). And, if there's a circular reference, you'd immediately demand all the memory you had. In fact, you'd demand infinite memory to handle infinite nesting (because it can't determine how deep you want your nesting to go).

With a class, we have more control, as we decide when new objects get instantiated, even nested objects. Therefore, circular references in classes don't have this same problem.

**Zvoni** · Feb 28th, 2022, 01:02 PM

Quoting myself:

The difference is: for that to work you actually need a pointer to such a structure

**SearchingDataOnly** · Feb 28th, 2022, 01:29 PM

Originally Posted by Peter Swinkels

Is the first part even vb6 code? I don't ever remember creating a class that way in that version of vb. Your code looks like vb.net.

The first part is just pseudocode (or twinBasi or VB.NET code), and it's just to be lazy.

Originally Posted by Elroy