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