Type TREECUSTOMDATA
    pszTitle As Zstring Ptr
    pData As Any Ptr
End Type
 
Type TREENODE
    pRoot As TREENODE Ptr ' родитель
    pBrotherNext As TREENODE Ptr ' следующий (брат)
    pBrotherPrev As TREENODE Ptr ' предыдущий (брат)
    pFirstChild As TREENODE Ptr ' ребенок (самый первый)
    pLastBrother As TREENODE Ptr ' последний (брат)
    pData As TREECUSTOMDATA Ptr ' данные
    iExpand As Integer ' флаг: раскрыт ли список с детьми (0 - не раскрыт , 1 - раскрыт)
End Type
 
Type MAINTREE
    public:
    Declare Function InsertData(pPos As TREENODE Ptr , pParent As TREENODE Ptr , anyValue As Any Ptr) As TREENODE Ptr
    Declare Sub DeleteNode(pNodeDelete As TREENODE Ptr)
    declare Sub DeleteAllNodes()
    declare function GetFirstNode() as TREENODE ptr
    declare function ExpandNode(pNode As TREENODE Ptr) as integer
    declare function CollapseNode(pNode As TREENODE Ptr) as integer
    declare sub ExpandAllNodes()
    declare sub CollapseAllNodes()
    declare function GetCountNodes() as Integer
    declare function GetCurrentNode() as TREENODE ptr
    declare function SetCurrentNode(pNode As TREENODE Ptr) as integer
    declare Function IsNodeExpand(pNode As TREENODE Ptr) as Integer
    declare Function IsNodePossibilityExpand(pNode As TREENODE Ptr) as Integer
    declare Function GetChildNode(pNode As TREENODE Ptr) As TREENODE Ptr
    declare Function GetNextNode(pNode As TREENODE Ptr) As TREENODE Ptr
    declare Function GetPrevNode(pNode As TREENODE Ptr) As TREENODE Ptr
    declare Function GetParentNode(pNode As TREENODE Ptr) As TREENODE Ptr
    declare Function GetTitleNode(pNode As TREENODE Ptr) As zstring Ptr
    declare sub SetTitleNode(pNode As TREENODE Ptr , pszTitle as zstring ptr)
    Private:
    pFirstRoot As TREENODE Ptr
    pCurrent As TREENODE Ptr
    iSize As Integer
    declare Sub CollapseExpandRecursion(pNode As TREENODE ptr , iExpandFlag as integer)
    Declare Sub DeleteNodeRecursion(pNode As TREENODE  , pNodeDelete As TREENODE Ptr)
    Declare Function FindNode(pNode As TREENODE Ptr , pFindNode As TREENODE Ptr) As TREENODE Ptr
    Declare Sub AddHeadData(pPos As TREENODE Ptr , pNode As TREENODE Ptr)
    Declare Sub AddLastData(pPos As TREENODE Ptr , pNode As TREENODE Ptr)
    declare Sub DeallocNode(pNodeDelete As TREENODE Ptr)
    declare Sub DeleteNodeRecursion(pNode As TREENODE ptr)
End Type
 
#define TVI_FIRST Cast(TREENODE Ptr ,0)
#define TVI_LAST  Cast(TREENODE Ptr ,-1)
 
Sub MAINTREE.AddHeadData(pParent As TREENODE Ptr , pNode As TREENODE Ptr)
    If pParent Then
        If pParent->pFirstChild Then
            pNode->pBrotherNext = pParent->pFirstChild
            pParent->pFirstChild->pBrotherPrev = pNode
        Else
            pNode->pLastBrother = pNode
        Endif
        pParent->pFirstChild = pNode
    Else
        If pFirstRoot Then
            pNode->pBrotherNext = pFirstRoot
            pFirstRoot->pBrotherPrev = pNode
        Else
            pNode->pLastBrother = pNode
        Endif
        pFirstRoot = pNode
    Endif
End Sub
 
Sub MAINTREE.AddLastData(pPos As TREENODE Ptr , pNode As TREENODE Ptr)
    pNode->pBrotherPrev = pPos
    pNode->pBrotherNext = pPos->pBrotherNext
    pPos->pBrotherNext = pNode
    If pNode->pBrotherNext = 0 Then
        If pNode->pRoot Then
            pNode->pRoot->pFirstChild->pLastBrother = pNode
        Else
            pFirstRoot->pLastBrother = pNode
        Endif
    Endif
End Sub
 
Function MAINTREE.InsertData(pPos As TREENODE Ptr , pParent As TREENODE Ptr , anyValue As Any Ptr) As TREENODE Ptr
    Dim As TREECUSTOMDATA Ptr pValue , pTempValue = anyValue
    Dim As TREENODE Ptr pNode = Callocate(Sizeof(TREENODE))
    pValue = Callocate(Sizeof(TREECUSTOMDATA))
     
    If pNode = 0 Orelse pValue = 0 Then Return Cast(TREENODE Ptr , Cint(-1))
     
    If pTempValue Then
        If pTempValue->pszTitle Then
            pValue->pszTitle = Callocate(len(*(pTempValue->pszTitle))+1)
            *pValue->pszTitle = *pTempValue->pszTitle
        Endif
        If pTempValue->pData Then
            pValue->pData = pTempValue->pData
        Endif
    Endif
     
    pNode->pRoot = pParent
    pNode->pData = pValue
     
    If pPos = TVI_FIRST Then
        AddHeadData(pParent , pNode)
    Elseif pPos = TVI_LAST Then
        If pParent Then
            If pParent->pFirstChild Andalso pParent->pFirstChild->pLastBrother Then
                AddLastData(pParent->pFirstChild->pLastBrother , pNode)
            Else
                AddHeadData(pParent , pNode)
            Endif
        Else
            If pFirstRoot Then
                AddLastData(pFirstRoot->pLastBrother , pNode)
            Else
                AddHeadData(0 , pNode)
            Endif
        Endif
    Else
        AddLastData(pPos , pNode)
    Endif
     
    iSize += 1
    Return pNode
     
End Function
 
Function MAINTREE.FindNode(pNode As TREENODE Ptr , pFindNode As TREENODE Ptr) As TREENODE Ptr
     
    If pNode = 0 Orelse pFindNode = 0 Then Return 0
     
    Dim As TREENODE Ptr pRet
     
    If pNode = pFindNode Then
        Return pFindNode
    Endif
     
    If pNode->pFirstChild Then
        pRet = FindNode(pNode->pFirstChild , pFindNode)
        If pRet Then Return pRet
    Endif
     
    If pNode->pBrotherNext Then
        pRet = FindNode(pNode->pBrotherNext , pFindNode)
        If pRet Then Return pRet
    Endif
     
End Function
 
Sub MAINTREE.DeallocNode(pNodeDelete As TREENODE Ptr)
    if pNodeDelete then
        if pNodeDelete->pData then
            if pNodeDelete->pData->pszTitle then
                deallocate(pNodeDelete->pData->pszTitle)
                pNodeDelete->pData->pszTitle = 0
            EndIf
            deallocate(pNodeDelete->pData)
            pNodeDelete->pData = 0
        EndIf
        deallocate(pNodeDelete)
    endif
End Sub
 
Sub MAINTREE.DeleteNodeRecursion(pNode As TREENODE ptr)
     
    If pNode = 0 Then exit sub
     
    If pNode->pFirstChild Then
        DeleteNodeRecursion(pNode->pFirstChild)
    Endif
     
    If pNode->pBrotherNext Then
        DeleteNodeRecursion(pNode->pBrotherNext)
    Endif
     
    DeallocNode(pNode)
     
End Sub
 
Sub MAINTREE.DeleteNode(pNodeDelete As TREENODE Ptr)
     
    If FindNode(pFirstRoot , pNodeDelete) = 0 Then
        Exit Sub
    Endif
     
    If pNodeDelete->pFirstChild Then
        DeleteNodeRecursion(pNodeDelete->pFirstChild)
    Endif
     
    If pNodeDelete->pBrotherPrev Then
        pNodeDelete->pBrotherPrev->pBrotherNext = pNodeDelete->pBrotherNext
        If pNodeDelete->pBrotherNext = 0 Then
            If pNodeDelete->pRoot Then
                pNodeDelete->pRoot->pFirstChild->pLastBrother = pNodeDelete->pBrotherPrev
            Else
                pFirstRoot->pLastBrother = pNodeDelete->pBrotherPrev
            Endif
        else
            pNodeDelete->pBrotherNext->pBrotherPrev = pNodeDelete->pBrotherPrev
        Endif
    else
        if pNodeDelete->pBrotherNext then
            If pNodeDelete->pRoot Then
                pNodeDelete->pRoot->pFirstChild = pNodeDelete->pBrotherNext
            else
                pNodeDelete->pBrotherNext->pLastBrother = pNodeDelete->pBrotherNext
                pFirstRoot = pNodeDelete->pBrotherNext
            EndIf
            pNodeDelete->pBrotherNext->pBrotherPrev = 0
        else
            If pNodeDelete->pRoot Then
                pNodeDelete->pRoot->pFirstChild = 0
            else
                pFirstRoot = 0
            EndIf
        EndIf
    Endif
     
    DeallocNode(pNodeDelete)
    pNodeDelete = 0
    if iSize then
        iSize -= 1
    EndIf
    pCurrent = 0
     
End Sub
 
Sub MAINTREE.DeleteAllNodes()
    DeleteNodeRecursion(pFirstRoot)
    pFirstRoot = 0
    iSize = 0
    pCurrent = 0
End Sub
 
function MAINTREE.GetFirstNode() as TREENODE ptr
    return pFirstRoot
End Function
 
Sub MAINTREE.CollapseExpandRecursion(pNode As TREENODE ptr , iExpandFlag as integer)
     
    If pNode = 0 Then exit sub
     
    If pNode->pFirstChild Then
        CollapseExpandRecursion(pNode->pFirstChild , iExpandFlag)
        pNode->iExpand = iExpandFlag
    Endif
     
    If pNode->pBrotherNext Then
        CollapseExpandRecursion(pNode->pBrotherNext , iExpandFlag)
    Endif
     
End Sub
 
function MAINTREE.ExpandNode(pNode As TREENODE Ptr) as integer
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    if pNode->pFirstChild then
        dim as TREENODE Ptr pTemp = pNode
        while pTemp
            pTemp = pTemp->pRoot
            if pTemp then
                pTemp->iExpand = 1
            EndIf
        Wend
        pNode->iExpand = 1
        return 1
    EndIf
End Function
 
function MAINTREE.CollapseNode(pNode As TREENODE Ptr) as integer
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    if pNode->pFirstChild then
        CollapseExpandRecursion(pNode->pFirstChild , 0)
        pNode->iExpand = 0
        return 1
    EndIf
End Function
 
sub MAINTREE.ExpandAllNodes()
    if pFirstRoot then
        CollapseExpandRecursion(pFirstRoot , 1)
        if pFirstRoot->pFirstChild then
            pFirstRoot->iExpand = 1
        else
            pFirstRoot->iExpand = 0
        EndIf
    endif
End sub
 
sub MAINTREE.CollapseAllNodes()
    if pFirstRoot then
        CollapseExpandRecursion(pFirstRoot , 0)
    endif
End sub
 
function MAINTREE.GetCountNodes() as Integer
    return iSize
End Function
 
function MAINTREE.GetCurrentNode() as TREENODE ptr
    return pCurrent
End Function
 
function MAINTREE.SetCurrentNode(pNode As TREENODE Ptr) as integer
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    pCurrent = pNode
    return 1
End Function
 
Function MAINTREE.IsNodeExpand(pNode As TREENODE Ptr) as Integer
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    return pNode->iExpand
End Function
 
Function MAINTREE.IsNodePossibilityExpand(pNode As TREENODE Ptr) as Integer
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    if pNode->pFirstChild then
        return 1
    EndIf
End Function
 
Function MAINTREE.GetChildNode(pNode As TREENODE Ptr) As TREENODE Ptr
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    return pNode->pFirstChild
End Function
 
Function MAINTREE.GetNextNode(pNode As TREENODE Ptr) As TREENODE Ptr
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    return pNode->pBrotherNext
End Function
 
Function MAINTREE.GetPrevNode(pNode As TREENODE Ptr) As TREENODE Ptr
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    return pNode->pBrotherPrev
End Function
 
Function MAINTREE.GetParentNode(pNode As TREENODE Ptr) As TREENODE Ptr
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    return pNode->pRoot
End Function
 
Function MAINTREE.GetTitleNode(pNode As TREENODE Ptr) As zstring Ptr
    If FindNode(pFirstRoot , pNode) = 0 Then
        return 0
    Endif
    if pNode->pData then
        return pNode->pData->pszTitle
    EndIf
End Function
 
sub MAINTREE.SetTitleNode(pNode As TREENODE Ptr , pszTitle as zstring ptr)
    If FindNode(pFirstRoot , pNode) = 0 Then
        exit sub
    Endif
    if pNode->pData then
        if pNode->pData->pszTitle then
            deallocate(pNode->pData->pszTitle)
            pNode->pData->pszTitle = 0
        EndIf
        if pszTitle then
            pNode->pData->pszTitle = callocate(len(*pszTitle))
            *(pNode->pData->pszTitle) = *pszTitle
        EndIf
    EndIf
End sub
 
Sub PrintAllData(pNode As TREENODE Ptr , iChild As Integer)
     
    If pNode = 0 Then Exit Sub
     
    If pNode->pData Andalso pNode->pData->pszTitle Then
        If iChild Then
            For i As Long = 1 To iChild
                ? Chr(9);
            Next
        Endif
        if pNode->pFirstChild then
            if pNode->iExpand then
                ? "-";
            else
                ? "+";
            EndIf
        else
            ? " ";
        EndIf
        ? *pNode->pData->pszTitle
    Endif
     
    If pNode->pFirstChild andalso pNode->iExpand Then
        PrintAllData(pNode->pFirstChild , iChild+1)
    Endif
     
    If pNode->pBrotherNext Then
        PrintAllData(pNode->pBrotherNext , iChild)
    Endif
     
End Sub
 
Dim pTree As MAINTREE
Dim As Zstring Ptr pszDim(8) = {@"1" , @"1-1" , @"2" , @"2-1" , @"2-1-1" , @"2-2" , @"2-2-1" , @"3" , @"3-1"}
Dim As TREECUSTOMDATA tcd
tcd.pszTitle = pszDim(0)
Dim As TREENODE Ptr pNode1 = pTree.InsertData(TVI_LAST , 0 , @tcd) ' 1
tcd.pszTitle = pszDim(1)
Dim As TREENODE Ptr pNode1_1 = pTree.InsertData(TVI_LAST , pNode1 , @tcd) ' 1-1
tcd.pszTitle = pszDim(2)
Dim As TREENODE Ptr pNode2 = pTree.InsertData(TVI_LAST , 0 , @tcd) ' 2
tcd.pszTitle = pszDim(3)
Dim As TREENODE Ptr pNode2_1 = pTree.InsertData(TVI_LAST , pNode2 , @tcd) ' 2-1
tcd.pszTitle = pszDim(4)
Dim As TREENODE Ptr pNode2_1_1 = pTree.InsertData(TVI_LAST , pNode2_1 , @tcd) ' 2-1-1
tcd.pszTitle = pszDim(5)
Dim As TREENODE Ptr pNode2_2 = pTree.InsertData(TVI_LAST , pNode2 , @tcd) ' 2-2
tcd.pszTitle = pszDim(6)
Dim As TREENODE Ptr pNode2_2_1 = pTree.InsertData(TVI_LAST , pNode2_2 , @tcd) ' 2-2-1
tcd.pszTitle = pszDim(7)
Dim As TREENODE Ptr pNode3 = pTree.InsertData(TVI_LAST , 0 , @tcd) ' 3
tcd.pszTitle = pszDim(8)
Dim As TREENODE Ptr pNode3_1 = pTree.InsertData(TVI_LAST , pNode3 , @tcd) ' 3-1
 
? "################"
? "Expand 2_2 node"
? "################"
pTree.ExpandNode(pNode2_2)
PrintAllData(pTree.GetFirstNode() , 0)
 
?
? "################"
? "Expand all nodes"
? "################"
pTree.ExpandAllNodes()
PrintAllData(pTree.GetFirstNode() , 0)
 
?
? "################"
? "Collapse all nodes"
? "################"
pTree.CollapseAllNodes()
PrintAllData(pTree.GetFirstNode() , 0)