请教一个树节点展开问题。

fnsmydyang

咱家是猫 发表于 2012-6-30 10:38
是噢,这个又忽略了,唉...这要考虑的东西还真多

嘻...，辛苦版主了。

咱家是猫

用了一个最方便,但不严谨的做法.这种做法要求你的所有节点的Text都不能有相同的.

Private Sub xTree_NodeClick(ByVal Node As Object)

    On Error Resume Next
   
    Dim tree0 As TreeView
    Dim strPath As String
   
    Static intLastNode As Integer
   
    Set tree0 = Me.xTree.Object

    strPath = "\" & Node.FullPath & "\"
    If intLastNode <> 0 Then
        For i = 1 To tree0.Nodes.Count
            If tree0.Nodes(i).Expanded = True Then
                If InStr(strPath, "\" & tree0.Nodes(i).Text & "\") = 0 Then
                    tree0.Nodes(i).Expanded = False
                End If
            End If
        Next i
    End If
   
    intLastNode = Node.Index
    Node.Seleted = True
    Node.Expanded = True
   
    lngKM = Nz(Right(Node.Key, Len(Node.Key) - 1))
   
End Sub

咱家是猫

这个方法还是回到了老路上--循环,但此循环在执行时,进行了更多的比对,解决了闪的问题.

fnsmydyang

咱家是猫 发表于 2012-6-30 11:08
这个方法还是回到了老路上--循环,但此循环在执行时,进行了更多的比对,解决了闪的问题.

版主，我是用数组存储Indext 值，但是闪的问题不能解决，请帮忙，谢谢！！！
Private Sub xTree_NodeClick(ByVal Node As Object)
On Error Resume Next
    Dim NodeP As Node
    Dim N As Integer
    Dim I As Integer
    Dim IntParentIndext() As Integer
    Set NodeP = Node
    For N = 0 To 100
        If Not (NodeP.Parent Is Nothing) Then
            Set NodeP = NodeP.Parent
            'MsgBox NodeP.Index
            IntParentIndext(N) = NodeP.Index
        Else
            Exit For
        End If
    Next
    For I = 0 To UBound(IntParentIndext())
        For J = 1 To Me.xTree.Nodes.Count
            If IntParentIndext(I) <> Me.xTree.Nodes(J).indext Then
               Me.xTree.Nodes(J).Expanded = False
            Else
            End If
        Next J
    Next I
    Me.xTree.Nodes(Node.Index).Selected = True
End Sub

咱家是猫

22楼的方法不行吗?

fnsmydyang

咱家是猫 发表于 2012-6-30 21:10
22楼的方法不行吗?

行的通，谢谢，只是想用不同的方法试一下。

鱼儿游游

咱家是猫 发表于 2012-6-30 11:07
用了一个最方便,但不严谨的做法.这种做法要求你的所有节点的Text都不能有相同的.

Private Sub xTree_Nod ...

下面的方法完美解决了：要求你的所有节点的Text都不能有相同的。

1. 
   
2. '=================================================================
   
3. '功能：只展开树当前节点，其它节点不展开
   
4. '
   
5. '调用： GetTreeAllParentNode_Key
   
6. '
   
7. '作者：鱼儿游游  QQ:7178000
   
8. '
   
9. '时间：2012-06-30
   
10. '=================================================================
    
11. Private Sub xTree_NodeClick(ByVal Node As Object)
    
12. On Error GoTo Err_Handler
    
13.     Dim tvwTree    As Object
    
14.     Dim dicNodeKey As Object
    
15.     Dim strNodeKey As String
    
16.     Dim intI As Integer
    
17.     Set tvwTree = Me.xTree.Object
    
18.     With tvwTree
    
19.         If GetTreeAllParentNode_Key(Node, dicNodeKey) Then
    
20.             For intI = 1 To .Nodes.Count
    
21.                strNodeKey = .Nodes(intI).Key
    
22.                If Not dicNodeKey.Exists(strNodeKey) Then .Nodes(intI).Expanded = False
    
23.             Next
    
24.         End If
    
25.         .Nodes(Node.Index).Selected = True
    
26.     End With
    
27. Exit_Handler:
    
28.     Set tvwTree = Nothing
    
29.     Set dicNodeKey = Nothing
    
30.     Exit Sub
    
31. Err_Handler:
    
32.     Resume Exit_Handler
    
33. End Sub
    
34. 
    
35. '=================================================================
    
36. '-函数名称: GetTreeAllParentNode_Key
    
37. '-功能描述: 返回指定树节点的所有父节点的KEY
    
38. '-输入参数: NodeX ......... 树中的任一节点
    
39. '           dicNodeKey .... 返回值
    
40. '-返回参数: 1、dicNodeKey 的内容，就是指定树节点的所有父节点的KEY
    
41. '           2、程序不出错返回：True，否则返回：False
    
42. '-作    者: 鱼儿游游  QQ:7178000
    
43. '-创建日期; 2012-06-30
    
44. '=================================================================
    
45. Private Function GetTreeAllParentNode_Key(ByVal NodeX As Node, ByRef dicNodeKey As Object) As Boolean
    
46. On Error GoTo Err_Handler
    
47.     Dim blnResult  As Boolean
    
48.     Dim nodCurrent As Node
    
49.     blnResult = False
    
50.     Set nodCurrent = NodeX
    
51.     Set dicNodeKey = CreateObject("Scripting.Dictionary")
    
52.     If Not dicNodeKey Is Nothing Then dicNodeKey.RemoveAll
    
53.     Do Until nodCurrent.Parent Is Nothing
    
54.        Set nodCurrent = nodCurrent.Parent
    
55.        dicNodeKey(nodCurrent.Key) = ""
    
56.     Loop
    
57.     blnResult = True
    
58. Exit_Handler:
    
59.     GetTreeAllParentNode_Key = blnResult
    
60.     Set nodCurrent = Nothing
    
61.     Exit Function
    
62. Err_Handler:
    
63.     blnResult = False
    
64.     MsgBox Err.Description, vbCritical, "返回选择节点的所有父点的KEY的集合函数"
    
65.     Resume Exit_Handler
    
66. End Function
    

复制代码

轻风

树控件不是有个 单项选择(SingleSel) 的属性吗？选上它好象就行了吧？

fnsmydyang

鱼儿游游 发表于 2012-7-1 09:49
下面的方法完美解决了：要求你的所有节点的Text都不能有相同的。

几天没上论坛，有这么多的人帮我解决问题，非常感谢，真是学海无涯，山外有山了。

fnsmydyang

轻风 发表于 2012-7-3 10:59
树控件不是有个 单项选择(SingleSel) 的属性吗？选上它好象就行了吧？

谢谢了，我试试。