List 从记录集创建层次结构

我有以下问题： 我必须用层次结构对记录集的数据进行排序

这是来自数据库的数据

您可以看到有两列，POS和PARENT。 这些值必须相互关联。 如果PARENT为0，则新排序中的值仅获取一个连续数字。在本例中为1-3

其他每个值都会基于父项获得一个新的连续数字

---

我很确定我可以用C#解决这个问题，但在这种情况下VB6是必需的。不幸的是，我在解决VB6的问题时遇到了极端的问题。

这看起来像是一个链表练习。您可以创建具有FirstChild对象和NextItem对象的clsListItem类：

Public Position As Integer
Public Hierarchy As String
Public FirstChild As clsListItem
Public NextItem As clsListItem

沿着列表向下移动时，将创建一个新对象并查找其父对象。然后检查父级的第一个子级是否存在。如果没有，则将对象设置为第一个子对象，否则使用NextItem在子对象中导航，直到NextItem为Nothing。然后将对象设置为NextItem：

Public Sub Sort(ByVal p_sList As String)
    Dim arrLines
    Dim arrFields
    Dim iCounter As Integer
    Dim objItem As clsListItem
    Dim objParent As clsListItem
    Dim objChild As clsListItem
    Dim iPosition As Integer
    Dim iParent As Integer
    Dim iParentIndex As Integer
    Dim iChildIndex As Integer

    ' Split values into lines
    arrLines = Split(p_sList, vbCrLf)

    ' Initialize Parent Index
    iParentIndex = 1

    For iCounter = 1 To UBound(arrLines) + 1

        arrFields = Split(arrLines(iCounter - 1), ",")

        iPosition = arrFields(0)
        iParent = arrFields(1)

        ' Get Item
        Set objItem = GetItem(iPosition)

        If iParent = 0 Then

            ' This is a top-level item
            objItem.Hierarchy = iParentIndex
            iParentIndex = iParentIndex + 1

        Else

            ' Get Parent
            Set objParent = GetItem(iParent)

            ' Initialize Child Index
            iChildIndex = 1

            If objParent.FirstChild Is Nothing Then
                ' We are the first child
                Set objParent.FirstChild = objItem
            Else

                ' Find last child
                Set objChild = objParent.FirstChild
                iChildIndex = iChildIndex + 1

                Do While Not objChild.NextItem Is Nothing
                    Set objChild = objChild.NextItem
                    iChildIndex = iChildIndex + 1
                Loop

                Set objChild.NextItem = objItem

            End If

            objItem.Hierarchy = objParent.Hierarchy & "." & iChildIndex

        End If

    Next

    Dim sMessage As String

    For iCounter = 1 To colListItems.Count
        Set objItem = colListItems.item(iCounter)
        With objItem
            sMessage = sMessage & .Position & ": " & .Hierarchy & vbCrLf
        End With
    Next

    MsgBox sMessage

End Sub

这样可以将所有数据组织到具有所需层次结构的对象中

获取/创建项目的助手函数：

Public Function GetItem(ByVal p_iPosition As Integer) As clsListItem
    Dim objItem As clsListItem

    On Error GoTo ItemNotFound

    Set objItem = colListItems.item("P" & p_iPosition)

    GoTo ReturnItem

ItemNotFound:

    Set objItem = New clsListItem
    objItem.Position = p_iPosition

    colListItems.Add objItem, "P" & p_iPosition

ReturnItem:
    Set GetItem = objItem
End Function

最后，我用来创建您拥有的值表的代码（仔细检查，可能是打字错误）：

Private Function AddPair(ByVal p_sList As String, ByVal p_iPos As Integer, ByVal p_iParent As Integer) As String
    Dim sReturn As String

    sReturn = p_sList

    If sReturn <> "" Then sReturn = sReturn & vbCrLf

    sReturn = sReturn & p_iPos & "," & p_iParent

    AddPair = sReturn


End Function

Private Sub Form_Load()
    Dim list As String

    list = AddPair(list, 1, 0)
    list = AddPair(list, 13, 0)
    list = AddPair(list, 16, 0)
    list = AddPair(list, 2, 1)
    list = AddPair(list, 12, 1)
    list = AddPair(list, 3, 2)
    list = AddPair(list, 4, 2)
    list = AddPair(list, 5, 2)
    list = AddPair(list, 6, 2)
    list = AddPair(list, 7, 2)
    list = AddPair(list, 8, 7)
    list = AddPair(list, 11, 7)
    list = AddPair(list, 9, 8)
    list = AddPair(list, 10, 8)
    list = AddPair(list, 14, 13)
    list = AddPair(list, 15, 13)
    list = AddPair(list, 17, 16)
    list = AddPair(list, 18, 16)

    Sort (list)

End Sub