VBCommons/utility/CDS_StaticHierarchy.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CDS_StaticHierarchy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' ================= Static hierarchy =======================
' Shared module version: 20210518
' Tested in: TestCommons
' Depends on: CDS_NodeSH
' Required reference: Scripting
' =========
' Example of valid structure
' 1
' 1.1
' 1.2
' 1.2.1
' 1.2.1.1
' 1.3
' 2
' 0
' ======
' Example of invalid structure ( increase level > 1 )
' 1
' 1.1.3
Option Explicit

Public nodes_ As Collection

Private levels_ As Scripting.Dictionary
Private previousRank_ As Long

Private Sub Class_Initialize()
  Set nodes_ = New Collection
  Set levels_ = New Scripting.Dictionary
  previousRank_ = -1
End Sub

Public Property Get MaxDepth() As Long
  MaxDepth = levels_.Count
End Property

Public Property Get Size() As Long
  Size = nodes_.Count
End Property

' Requires nRank <= previousLevel + 1
Public Function PushItem(nRank&) As CDS_NodeSH
  If nodes_.Count > 0 Then
    If previousRank_ < nRank Then _
      If previousRank_ <> nRank - 1 Then _
        Exit Function
  End If
      
  Dim iNewNode As New CDS_NodeSH: Call iNewNode.Init(nodes_.Count + 1, nRank)
  Set levels_(nRank) = iNewNode
  previousRank_ = nRank
  If levels_.Exists(nRank - 1) Then
    Set iNewNode.parent_ = levels_(nRank - 1)
    Call levels_(nRank - 1).children_.Add(iNewNode)
    Call IncrementDescendants(nRank - 1)
  End If
  
  Call nodes_.Add(iNewNode)
  Set PushItem = iNewNode
End Function

' =======
Private Function IncrementDescendants(nTarget&)
  Dim nRank As Variant
  For Each nRank In levels_
    If nRank <= nTarget Then _
      levels_(nRank).descendantsCount_ = levels_(nRank).descendantsCount_ + 1
  Next nRank
End Function