ctreeview.cls

用Treeview来显示每个Field

    bCheckKey = (Len(Trim$(NodeKey)) > 0)
    bKeyOK = (Not bCheckKey)
    For Each Node In oTree.Nodes
        With Node
            If UCase$(.Text) = UCase$(NodeText) Then
                If bCheckKey Then bKeyOK = (UCase$(.Key) = UCase$(NodeKey))
                If bKeyOK Then
                    If bSelect Then
                        .Selected = True
                        .EnsureVisible
                    End If
                    Set oResultNode = Node
                    NodeFind = True
                    Exit For
                End If
            End If
        End With
    Next

End Function

Public Function NodeMove(ParentNode As MSComctlLib.Node, _
                         ChildNode As MSComctlLib.Node, _
                Optional ByVal bSelect As Boolean = True) As Boolean
Attribute NodeMove.VB_Description = "Move a node from one parent to another  and optionally selects & ensures visibility"

    Dim lNDX   As Long
    Dim lCount As Long
    Dim lLoop  As Long
    Dim bRoot  As Boolean

    With ChildNode
        If ParentNode = ChildNode Then
            '## Same node - therefore no point
            Exit Function
        End If
        If IsParentNode(ParentNode, ChildNode) Then '## Are we moving a parent node?
            If IsRootNode(ChildNode) Then           '## Yes. Is it a root node?
                Exit Function                       '## Yes. Can't move a root node.
            End If
            '## move the children before moving the designated node
            lCount = .Children
            For lLoop = 1 To lCount
                lNDX = .Child.Index
                Set oTree.Nodes(lNDX).Parent = .Parent
            Next
        End If
        Set .Parent = ParentNode
        If bSelect Then
            .EnsureVisible
            .Selected = bSelect
        End If
    End With
    NodeMove = True

End Function

Public Function NodeRename(Node As MSComctlLib.Node, _
                     ByVal NewNodeText As String, _
            Optional ByVal bSelect As Boolean = True) As Boolean
Attribute NodeRename.VB_Description = "Changes the text of a node and optionally selects & ensures visibility"

    With Node
        If Len(NewNodeText) Then            '## Check if we have new text
            .Text = NewNodeText
            If Not IsRootNode(Node) Then
                .EnsureVisible
                .Selected = bSelect
            End If
            NodeRename = True
        End If
    End With

End Function


Public Sub ScrollView(Dir As eCodeScrollView)                                       '@@ v01.00.01
Attribute ScrollView.VB_Description = "Scrolls the treview using code"
    '
    '## Scrolls the treview using code
    '
    Dim lPageSize As Long

    With oTree
        lPageSize = .GetVisibleCount - 1        '## Number of viewable nodes less 1
        Select Case Dir
            Case [Home]
                .Nodes(1).Root.EnsureVisible
            Case [Page Up]
                pScrollToPrevNode(lPageSize).EnsureVisible
            Case [Up]
                pScrollToPrevNode(1).EnsureVisible
            Case [Down]
                pScrollToNextNode(1).EnsureVisible
            Case [Page Down]
                pScrollToNextNode(lPageSize).EnsureVisible
            Case [End]
                pScrollToLastNode(.Nodes(1).Root.LastSibling).EnsureVisible
        End Select
    End With

End Sub

Public Function NodeFirstViewable() As MSComctlLib.Node                             '@@ v01.00.01
Attribute NodeFirstViewable.VB_Description = "Returns the first viewable node"
    '
    '## Returns the first viewable node
    '
    Dim yPos As Long
    Dim xPos As Long
    
    With oTree
        yPos = mlNodeHeight \ 2 '## Halfway down the first viewable node
        Do
            xPos = xPos + 100   '## move across the control gradually
            If Not (oTree.HitTest(xPos, 5) Is Nothing) Then
                '
                '## Find the node from left to right until we get a hit
                '   and return the node found
                '
                Set NodeFirstViewable = oTree.HitTest(xPos, 5)
                Exit Do
            End If
        Loop Until xPos > oTree.Width '## Have we hit the RHS?
    End With

End Function

Public Function NodeLastViewable() As MSComctlLib.Node  '@@ v01.00.01
Attribute NodeLastViewable.VB_Description = "Returns the last visible node"
    '
    '## Returns the last visible node
    '
    Set NodeLastViewable = pScrollToNextNode
End Function

'===========================================================================
' Private subroutines and functions
'
Private Function pScrollToLastNode(Node As MSComctlLib.Node) As MSComctlLib.Node    '@@ v01.00.01
    '
    '## Recursive find and return the last expanded and visible node
    '
    Dim oNode  As MSComctlLib.Node

    With Node
        Debug.Print Node.Text
        If .Children Then
            '
            '## We have child nodes
            '
            If .Expanded Then
                '
                '## And expanded. Therefore traverse the next branch
                '
                Set pScrollToLastNode = pScrollToLastNode(Node.Child.LastSibling)
            Else
                '
                '## we've hit the end
                '
                Set pScrollToLastNode = Node
            End If
        Else
            '
            '## we've hit the end
            '
            Set pScrollToLastNode = Node
        End If
    End With

End Function

Private Function pScrollToNextNode(Optional ByVal NumNodes As Long = 0) As MSComctlLib.Node '@@ v01.00.01

    Dim oVNode As MSComctlLib.Node          '## First viewable node
    Dim oSNode As MSComctlLib.Node          '## Start node
    Dim lCount As Long                      '## bean counter
    Dim lMax   As Long                      '## Maximum beans
    Dim bStart As Boolean                   '## Set true if we've reached first viewable node

    Set oVNode = NodeFirstViewable          '## Get first viewable node
    Set oSNode = oTree.Nodes(1).Root        '## record start node as first root node
    lMax = oTree.GetVisibleCount + NumNodes '## Set to maximum nodes viewable + number of
                                            '   nodes to scroll down
    Do                                      '## Step through each root node
        '
        '## Step through every node under each root node looking counting each
        '   node after the first viewable node until we've hit either the last
        '   node for found the last viewable.
        '
        Set pScrollToNextNode = pTraverseDown(oSNode, oVNode, lMax, lCount, bStart)
        If (Not (lCount = lMax)) And (Not (oSNode = oSNode.LastSibling)) Then
            '
            '## We still haven't found the node and we haven't exhausted
            '   every root node
            '
            Set oSNode = oSNode.Next
        Else
            '
            '## We've either hit the end or found the last viewable node
            '
            Exit Do
        End If
    Loop

End Function

Private Function pScrollToPrevNode(Optional ByVal NumNodes As Long = 0) As MSComctlLib.Node '@@ v01.00.01

    Dim lCount As Long                          '## bean counter
    Dim oNode As MSComctlLib.Node               '## Start node

    Set oNode = NodeFirstViewable               '## record start node as first root node
    '
    '## Loop backwards and forwards unit the node is found
    '
    Do
        '
        '## Backwards
        '
        If oNode = oNode.FirstSibling Then      '## Is the it the first child node of parent?
            If IsRootNode(oNode) Then           '## Yes. Is it a root node?
                If oNode.Root = oNode Then      '## Yes. Is it the primary root node?
                    Exit Do                     '## we have found the node wanted
                Else
                    lCount = lCount + 1         '## Increment bean counter
                    If lCount = NumNodes Then
                        Exit Do                 '## we have found the node wanted
                    End If
                End If
            Else
                Set oNode = oNode.Parent        '## step back up the branch
                lCount = lCount + 1             '## Increment bean counter
                If lCount = NumNodes Then
                    Exit Do                     '## we have found the node wanted
                End If
            End If
        Else
            Set oNode = oNode.Previous          '## move up a node for the same parent
            If oNode.Children Then              '## Does the new node have child nodes?
                '
                '## Yes. Step down (Forward) through the branches to the last node
                '
                Do
                    If oNode.Expanded Then      '## Are the child nodes expanded?
                        '
                        '## Yes. Get the next last node of child branch
                        '
                        Set oNode = oNode.Child.LastSibling
                    Else
                        '
                        '## we've found the previous node
                        '
                        Set pScrollToPrevNode = oNode
                        Exit Do                 '## we have found the node wanted
                    End If
                Loop While oNode.Children       '## are there more child nodes?
                lCount = lCount + 1             '## Increment bean counter
                If lCount = NumNodes Then
                    Exit Do                     '## we have found the node wanted
                End If
            Else
                '
                '## we've found the previous node
                '
                lCount = lCount + 1             '## Increment bean counter
                If lCount = NumNodes Then
                    Exit Do                     '## we have found the node wanted
                End If
            End If
        End If
    Loop
    Set pScrollToPrevNode = oNode               '## Return the requested previous node

End Function

Private Function pTraverseDown(Node As MSComctlLib.Node, _
                               StartNode As MSComctlLib.Node, _
                               Max As Long, _
                               Count As Long, _
                               Start As Boolean) As MSComctlLib.Node    '@@ v01.00.01
    '
    '## This will recursively step through every node from the start node
    '   looking for the first viewable. When found will count every following
    '   node until either the last node is hit or max is reached.
    '
    Dim oNode  As MSComctlLib.Node
    Dim lLoop As Long

    With Node
        'Debug.Print .Text, .FullPath, Count
        If .Key = StartNode.Key Then
            '
            '## we've reached the first viewable node. Start counting beans.
            '
            Start = True
        End If
        If Start Then
           Count = Count + 1                    '## Count the node
            If Count = Max Then                 '## Have we reached our quota?
                Set pTraverseDown = Node        '## Yes. Return the Last viewable node
                Exit Function
            End If
        End If
        If .Children Then                       '## Node has children?
            If .Expanded Then                   '## Yes. But have we expanded?
                Set oNode = .Child.FirstSibling '## Yes. Lets start work on the children
                Do
                    '
                    '## Lets start the process for every child node (recursively)
                    '
                    Set pTraverseDown = pTraverseDown(oNode, StartNode, Max, Count, Start)
                    If Count = Max Then         '## Have we reached our quota?
                        Exit Do                 '## Yes. Let's stop looking
                    End If
                    If Not (oNode = oNode.LastSibling) Then
                        '
                        '## We still haven't found the node and we haven't exhausted
                        '   every root node
                        '
                        Set oNode = oNode.Next
                    Else
                        '
                        '## No more child node left. Let's cut or losses and return
                        '   the last child node
                        '
                        Exit Do
                    End If
                Loop
            Else
                '
                '## Node's not expanded. Therefore return the same node
                '
                Set pTraverseDown = Node
            End If
        Else
            '
            '## Node's has no children. Therefore return the same node.
            '
            Set pTraverseDown = Node
        End If
    End With

End Function