⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modtreeselect.bas

📁 操作节点
💻 BAS
字号:
Attribute VB_Name = "modTreeSelect"
Option Explicit


Private Enum NodeCheck
    nodChecked = True
    nodUnchecked = False
    nodPartial = 1
End Enum



Public Sub TreeSelectiveCheck(Node As MSComctlLib.Node)
    
    Node.Bold = False
    
    TreeSetChildren Node, Node.Checked
    
    If TreeCheckSibling(Node, Node.Checked) Then
        TreeSetParents Node, Node.Checked
    Else
        TreeSetParents Node, nodPartial
    End If
    
End Sub

Public Sub TreeSingleCheck(Tree As TreeView, Node As MSComctlLib.Node)
    
Dim nodX As Node

    If Node.Checked Then
        For Each nodX In Tree.Nodes
            If nodX.Index <> Node.Index And nodX.Checked Then
                nodX.Checked = False
            End If
        Next
    End If
    
End Sub

Private Sub TreeSetChildren(Node As MSComctlLib.Node, bCheck As Boolean)

Dim nodX As Node
        
    If Node.Children = 0 Then
        Exit Sub
    End If
    
    Set nodX = Node.Child
    Do Until nodX Is Nothing
        nodX.Bold = False
        nodX.Checked = bCheck
        
        If nodX.Children > 0 Then
            TreeSetChildren nodX, bCheck
        End If
        
        Set nodX = nodX.Next
    Loop
    
End Sub

Private Sub TreeSetParents(Node As MSComctlLib.Node, ByVal nCheck As NodeCheck)
    
Dim nodX As Node

    If (Node.Parent Is Nothing) Then
        Exit Sub
    End If
    
    Set nodX = Node.Parent
    Select Case nCheck
        Case nodChecked
            nodX.Checked = True
            nodX.Bold = False
        Case nodUnchecked
            nodX.Checked = False
            nodX.Bold = False
        Case nodPartial
            nodX.Checked = False
            nodX.Bold = True
    End Select
    
    If nCheck = nodPartial Then
        TreeSetParents nodX, nodPartial
    Else
        If TreeCheckSibling(nodX, nodX.Checked) Then
            TreeSetParents nodX, nodX.Checked
        Else
            TreeSetParents nodX, nodPartial
        End If
    End If
        
End Sub

Private Function TreeCheckSibling(Node As MSComctlLib.Node, ByVal bCheck As Boolean) As Boolean
    
Dim nodX As Node

    TreeCheckSibling = True
    
    Set nodX = Node.FirstSibling
    
    Do Until nodX Is Nothing
        If nodX.Checked <> bCheck Then
            TreeCheckSibling = False
            Exit Do
        End If
        
        Set nodX = nodX.Next
    Loop
    
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -