ctreeview.cls

树状控件的一些相关操作

        Debug.Print dbgCtrlName; "::Validate -> Cancel="; CStr(Cancel)
    #End If

End Sub

'===========================================================================
'
Private Sub Class_Initialize()
    '## Set defaults...
    meContextMenuMode = [After Click]
    mbDragEnabled = False
End Sub

Private Sub Class_Terminate()
    '## release control
    UnHookCtrl
End Sub

'===========================================================================
' Public subroutines and functions
'
Public Function NodeAdd(Optional ByVal vRelative As Variant, _
                        Optional ByVal eRelationship As MSComctlLib.TreeRelationshipConstants, _
                        Optional ByVal sKey As String, _
                        Optional ByVal sText As String, _
                        Optional ByVal vImage As Variant, _
                        Optional ByVal vSelectedImage As Variant, _
                        Optional ByVal vTag As Variant, _
                        Optional ByVal bBold As Boolean = False, _
                        Optional ByVal bChecked As Boolean = False, _
                        Optional ByVal bEnsureVisible As Boolean = False, _
                        Optional ByVal bExpanded As Boolean = True, _
                        Optional ByVal bSelected As Boolean = False, _
                        Optional ByVal bVisible As Boolean = True, _
                        Optional ByVal lForeColor As OLE_COLOR, _
                        Optional ByVal lBackColor As OLE_COLOR, _
                        Optional ByVal vExpandedImage As Variant) As MSComctlLib.Node
Attribute NodeAdd.VB_Description = "Adds node to TreeView and sets properties in one call"

    Dim Node As MSComctlLib.Node

    On Error GoTo ErrorHandler
    Set Node = oTree.Nodes.Add(vRelative, eRelationship, sKey, sText, vImage, vSelectedImage)
    With Node
        #If DEBUGMODE = 1 Then
            Debug.Print "ADD-> Text = "; .Text; "   Index = "; CStr(.Index)
        #End If
        .Tag = vTag
        .Bold = bBold
        .Checked = bChecked
        If bEnsureVisible Then .EnsureVisible
        .Expanded = bExpanded
        .Selected = bSelected
        '.Visible = bVisible
        If lForeColor = 0 Then
            .ForeColor = vbWindowText
        Else
            .ForeColor = lForeColor
        End If
        If lBackColor = 0 Then
            .BackColor = vbWindowBackground
        Else
            .BackColor = lBackColor
        End If
        If Not IsMissing(vExpandedImage) Then
            .ExpandedImage = vExpandedImage
        End If
    End With
    
    Set NodeAdd = Node
    Exit Function

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

Public Sub ClearTreeView()
Attribute ClearTreeView.VB_Description = "A very fast way of clearing all nodes"
    '## Clear the treeview

    Dim hItem As Long
    Dim hwnd  As Long

    Redraw False
    hwnd = oTree.hwnd
    Do
        hItem = SendMessageLong(hwnd, TVM_GETNEXTITEM, TVGN_ROOT, 0)
        If hItem <= 0 Then Exit Do
        SendMessageLong hwnd, TVM_DELETEITEM, &O0, hItem
    Loop
    Redraw True

End Sub

Public Sub Redraw(Enabled As Boolean)
Attribute Redraw.VB_Description = "Enable/disable screen updates."

    Dim hwnd  As Long

    If Not (oTree Is Nothing) Then
        hwnd = oTree.hwnd
        If Enabled Then
            '## Lock the window update to avoid flickering
            SendMessageLong hwnd, WM_SETREDRAW, False, &H0
        Else
            '## Unlock the window
            SendMessageLong hwnd, WM_SETREDRAW, True, &H0
        End If
    End If

End Sub
Public Sub CollapseAll()
Attribute CollapseAll.VB_Description = "Hide all children"
    '## Collapse all nodes

    Dim Node  As Node

    Redraw False
    For Each Node In oTree.Nodes
        With Node
            If .Children Then .Expanded = False
        End With
    Next
    Redraw True

End Sub

Public Sub CollapseChildNodes(ByVal Node As MSComctlLib.Node)
Attribute CollapseChildNodes.VB_Description = " Collapse all children that belong to Node"

    Dim lCount As Long
    Dim lLoop  As Long

    Redraw False
    With Node
        If Not Node Is Nothing Then
            .Expanded = False
        End If
        '节点是否还有子节点
        If .Children Then
            lCount = .Children
            Set Node = .Child
            For lLoop = 1 To lCount
                '递归调用本函数,直到没有子节点
                CollapseChildNodes Node
                If lLoop < lCount Then
                    Set Node = .Next
                End If
            Next
        End If
    End With
    Redraw True

End Sub

Public Property Get ContextMenuMode() As eContextMenuMode
Attribute ContextMenuMode.VB_Description = "Raise ContextMenu Event before or after Click Event [Default = After]"
    ContextMenuMode = meContextMenuMode
End Property

Public Property Let ContextMenuMode(ByVal Mode As eContextMenuMode)
    meContextMenuMode = Mode
End Property

Public Property Get Ctrl() As MSComctlLib.TreeView
Attribute Ctrl.VB_UserMemId = 0
Attribute Ctrl.VB_MemberFlags = "640"
    '## Default Object
    Set Ctrl = oTree
End Property

Public Sub CutIconState(SetState As Boolean)        '@@ v01.00.03
    '
    '## Sets or removes the slected (right-clicked) node's specified state.
    '
    Dim hItem As Long
  
    hItem = GetTVItemFromNode(oTree.hwnd, oTree.SelectedItem)
    If hItem Then
        SetTVItemState oTree.hwnd, hItem, TVIS_CUT, SetState
    End If

End Sub

Public Property Get DragEnabled() As Boolean
Attribute DragEnabled.VB_Description = "Enables/disables drag'n'drop"
    DragEnabled = mbDragEnabled
End Property

Public Property Let DragEnabled(ByVal Enabled As Boolean)
    mbDragEnabled = Enabled
End Property

Public Sub ExpandAll()
Attribute ExpandAll.VB_Description = "Show all children"
    '展开所有节点

    Dim Node  As Node

    On Error GoTo ErrorHandler                      '@@ v01.00.01
    Redraw False
    For Each Node In oTree.Nodes
        With Node
            If .Children Then .Expanded = True
        End With
    Next
    Redraw True
    Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 35606: ExpandAll
    End Select
End Sub
Public Sub ExpandChildNodes(ByVal Node As MSComctlLib.Node)
Attribute ExpandChildNodes.VB_Description = "Expand all children that belong to Node"

    Dim lCount As Long
    Dim lLoop  As Long

    Redraw False
    With Node
        If Not Node Is Nothing Then
            .Expanded = True
        End If
        '节点是否还有子节点
        If .Children Then
            lCount = .Children
            Set Node = .Child
            For lLoop = 1 To lCount
                '递归调用本函数,直到没有子节点
                ExpandChildNodes Node
                If lLoop < lCount Then
                    Set Node = .Next
                End If
            Next
        End If
    End With
    Redraw True

End Sub

Public Sub HookCtrl(Ctrl As MSComctlLib.TreeView)

    Dim bState As Boolean

    Set oTree = Ctrl                                '## Capture the Treeview control.
                                                    '   Class won't work if this isn't called first.
    With oTree
        #If DEBUGMODE = 1 Then
            dbgCtrlName = .Parent.Name + "." + .Name
        #End If
        '
        '## calculate the height (pixels) of a node '@@ v01.00.01
        '
        bState = .Scroll                            '## Remember if scrollbars are enabled
        .Scroll = False                             '## Turn them off
        mlNodeHeight = .Height \ .GetVisibleCount   '## calculate height
        .Scroll = bState                            '## restore scrollbar state
        FlatBorder .hwnd                            '@@ v01.00.03 (Forced flat border)
    End With

End Sub

Public Property Get ParentNodeText(Node As MSComctlLib.Node) As String
Attribute ParentNodeText.VB_Description = "Returns the parent node text (Safe routine to stop error condition if no parent node)"
    '## Returns the parent text
    '   NOTE: If a Node has no parent then VB raises an error.
    '         This is a much safer Node.Parent.Text routine.
    With Node
        ParentNodeText = IIf(.FullPath = .Text, "", .Parent)
    End With
End Property

Public Function IsChildNode(TestNode As MSComctlLib.Node, _
                            ParentNode As MSComctlLib.Node, _
                   Optional NodeDepth As eNodeDepth = [First Branch]) As Boolean    '@@ v01.00.03

    If NodeDepth = [First Branch] Then
        If ParentNode.Children Then
            If Not IsRootNode(TestNode) Then
                IsChildNode = (TestNode.Parent = ParentNode)
            End If
        End If
    Else
        IsChildNode = IsParentNode(TestNode, ParentNode)
    End If

End Function

Public Function IsParentNode(ChildNode As MSComctlLib.Node, _
                             ParentNode As MSComctlLib.Node) As Boolean
    '## Checks if one node is the parent of another.
    '   This is a recursive routine that steps down through
    '   the branches of the parent node.

    Dim lNDX As Long

    If ParentNode.Children Then             '## Does the parent node have children?
        lNDX = ParentNode.Child.Index       '## Yes, remember the first child
        Do                                  '## Step through all child nodes
            If lNDX = ChildNode.Index Then  '## is ChildNode the test node?
                IsParentNode = True         '## ParentNode is the parent of ChildNode.
                Exit Do
            End If
            If IsParentNode(ChildNode, oTree.Nodes(lNDX)) Then  '## Step down through the branches
                IsParentNode = True         '## ParentNode is the parent of ChildNode.
                Exit Do
            End If
            If lNDX <> ParentNode.Child.LastSibling.Index Then  '## Have we tested the last child node?
                lNDX = oTree.Nodes(lNDX).Next.Index             '## No. Point to the next child node
            Else
                Exit Do                                         '## Yes.
            End If
        Loop
    End If

End Function

Public Function IsRootNode(Node As MSComctlLib.Node) As Boolean
Attribute IsRootNode.VB_Description = "Check is selected node is a root node."
    '## Check is selected node is a root node.
    With Node
        IsRootNode = (.FullPath = .Text)
    End With
End Function

Public Sub UnHookCtrl()
Attribute UnHookCtrl.VB_Description = "Releases the hooked control."
    '## Release the hooked control
    Set oTree = Nothing
End Sub

Public Property Let CancelCopy(IsCancelled As Boolean)                  '@@ v01.00.03
    '## Cancel the node copy operation
    mbCancelCopy = IsCancelled
End Property

Public Function NodeCopy(DestNode As MSComctlLib.Node, _
                         SrcNode As MSComctlLib.Node, _
          Optional ByVal IncludeChildren As Boolean = True) As Boolean  '@@ v01.00.03

    Dim oSNode As MSComctlLib.Node
    Dim oDNode As MSComctlLib.Node

    '
    '## Ensure that we don't overwrite the original nodes values
    '
    Set oSNode = SrcNode
    Set oDNode = DestNode

    If oSNode = oDNode Then
        '## Same node - therefore no point trying to copy
        mbCancelCopy = True
        Exit Function
    End If
    '
    '## Force the Nodes to be expanded before the copy operation is performed. This
    '   will allow child nodes to be loaded if done on demand
    '
    oDNode.Expanded = True
    oSNode.Expanded = True
    '
    '## Let the actual process happen externally to cTREEVIEW - a must if working with a database
    '   or multiple types of data.
    '
    RaiseEvent CopyNode(oDNode, oSNode)     '## Get the calling routine to copy the node.
    If mbCancelCopy Then                    '## Was the process cancelled?
        Exit Function                       '## Yes.
    End If
    If IncludeChildren Then                                     '## Include all child nodes?
        If oSNode.Children Then                                 '## Yes. Are there child nodes?
            Set oSNode = oSNode.Child.FirstSibling              '## Yes. Select the first child.
            Do
                If NodeCopy(oDNode.Child.LastSibling, oSNode, IncludeChildren) Then '## Copy child node
                    If Not (oSNode = oSNode.LastSibling) Then   '## Are there more child nodes?
                        Set oSNode = oSNode.Next                '## Yes.
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If