TheSwamp

Code Red => VB(A) => Topic started by: Troy Williams on October 13, 2005, 09:05:25 AM

Title: VB 6 Treeview and nodes
Post by: Troy Williams on October 13, 2005, 09:05:25 AM
I have a treeview control on a form that is populated with a number of parent branches. Each of the parent branches contains a number of children and grand children. Each of the nodes has a checkbox that the user can check or uncheck. What I want to do is hide the main parent branches that are not checked, thereby hiding all of the branches underneath them. Conversely, if nothing is checked then all of the branches should be visible (or enabled).

Now, I have found a number of interesting approaches to solving this problem. One of the solutions was to simply reload the tree with only the necessary data from the database (I think as a last resort I may have to do this).When the form loads the treeview is populated from a series of complex sql calls to an access database. These routines were designed to be a one shot deal when the form loaded (which means that it will be difficult to modify them). I don't really want to have to tweak them to load only the data that I am interested in. The big problem is that all the code is in place in the program and it would take significant modifications to get the solutions working. I am wondering if there is a way to get the desired effect and would have a minimal impact on the code?

I have been playing around with the idea of getting a reference to all of the root nodes that I want to remove from the tree and storing them in a collection. I could then use the collection to repopulate the tree with the "hidden" branches.

Code: [Select]
Dim i As Long, upper As Long
Dim rootNodes As New Collection
Dim myNode As MSComctlLib.Node

upper = tvHoles.Nodes.Count

For i = 1 To upper
    Set myNode = tvHoles.Nodes.Item(i)   
    If myNode.Tag = "Root" Then
        rootNodes.Add myNode
    End If
Next

If rootNodes.Count > 0 Then
    Set myNode = rootNodes.Item(1)
    tvHoles.Nodes.Remove myNode.Index
    msgbox myNode.tag
End If

The code snippet above successfully grabs a reference to the first root node in the treeview and then removes it from the treeview. The myNode object seems to retain a reference to all the things that it had when it was in the tree including its children. I can't seem to figure out a way to add the myNode object back into the tree. Any help on getting this to work or even just disabling the node would be greatly appreciated.
Title: Re: VB 6 Treeview and nodes
Post by: Troy Williams on October 13, 2005, 09:46:43 AM
Don't worry about this... I decided to scrap the treeview. It turns out that the changes that needed to make made the treeview control confusing to the users. So I went with a couple of pick boxes.
Title: Re: VB 6 Treeview and nodes
Post by: mmelone on March 22, 2006, 04:46:10 PM
For future reference, I ran into exactly the same problem you did, and here is my solution.  (I copied it directly from my app, so you will have to go through and take out what you don't need, in order to get it to work)

Code: [Select]
Public Function ApplyFilter()
On Error GoTo Trap
Dim Filtered As Boolean
Dim nd As Node
Dim arr() As String
With ModelNames
    Select Case FilterBar.SelectedItem.Key
        Case "UnCheckedModelsFilter"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If UserFilter = "" Or IsUser(nd) Then
                        If IsModelChecked(nd) = False And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
           
        Case "QuestionsFilter"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If UserFilter = "" Or IsUser(nd) Then
                        If IsModelQuestions(nd) = True And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
           
        Case "UnResolvedErrorsFilter"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If UserFilter = "" Or IsUser(nd) Then
                        If IsErrorUnResolved(nd) = True And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
           
        Case "ResolvedErrorsFilter"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If UserFilter = "" Or IsUser(nd) Then
                        If IsFixed(nd) = True And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
           
        Case "Responses"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If IsUser(nd) = True Then
                        If IsResponse(nd) = True And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
           
        Case "ByDate"
            ModelNames.Visible = False
            FilterResults.Visible = False
            FilterResults.Nodes.Clear
            FilterResults.Visible = True
            For Each nd In .Nodes
                arr() = Split(nd.FullPath, "|")
                Select Case UBound(arr())
                    Case 0
                    'node is root
                    CopyTVParentNode nd, FilterResults.Nodes, False
                    Case 1
                    'node is modelnamelevel
                    If UserFilter = "" Or IsUser(nd) Then
                        If IsDate(nd) = True And nd.image <> 4 Then
                            CopyTVParentNode nd, FilterResults.Nodes, True
                            End If
                        End If
                    End Select
                Next
            Filtered = True
            Exit Function
        End Select
       
    If UserFilter <> "" Then
        ModelNames.Visible = False
        FilterResults.Visible = False
        FilterResults.Nodes.Clear
        FilterResults.Visible = True
        For Each nd In .Nodes
            arr() = Split(nd.FullPath, "|")
            Select Case UBound(arr())
                Case 0
                'node is root
                CopyTVParentNode nd, FilterResults.Nodes, False
                Case 1
                'node is modelnamelevel
                If IsUser(nd) = True Then
                    CopyTVParentNode nd, FilterResults.Nodes, True
                    End If
                End Select
            Next
        Filtered = True
        End If
   
    If Not Filtered Then
        ModelNames.Visible = True
        FilterResults.Visible = False
        End If
    End With
Exit Function
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
    Case vbAbort
        Exit Function
    Case vbRetry
        Stop
        Resume
    Case vbIgnore
        Resume Next
    End Select
End Function
Code: [Select]
Private Sub CopyTVParentNode(nodeParent As Node, nodesDest As Nodes, Optional AddChildren As Boolean = True, Optional SkipParent As Boolean)
On Error GoTo Trap
Dim nodeDummy As Node
Dim nodeChild As Node
If Not SkipParent Then
    If (nodeParent.Parent Is Nothing) Then
        Set nodeDummy = CopyNode(nodeParent, nodesDest)
        Else
        Set nodeDummy = CopyNode(nodeParent, nodesDest, nodesDest(nodeParent.Parent.Key))
        End If
    End If
If AddChildren Then
Set nodeChild = nodeParent.Child
    Do While Not (nodeChild Is Nothing)
        If nodeChild.Children Then
            Call CopyTVParentNode(nodeChild, nodesDest, True)
            Else
            Set nodeDummy = CopyNode(nodeChild, nodesDest, nodesDest(nodeChild.Parent.Key)) ', nodeDummy)
            End If
        Set nodeChild = nodeChild.Next
        Loop
    End If
Exit Sub
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
    Case vbAbort
        Exit Sub
    Case vbRetry
        Stop
        Resume
    Case vbIgnore
        Resume Next
    End Select
End Sub
Code: [Select]
Private Function CopyNode(nodeSrc As Node, nodesDest As Nodes, Optional nodeParent As Node) As Node
On Error GoTo Trap
'On Error Resume Next
With nodeSrc
    If (.Parent Is Nothing) Then
        Set CopyNode = nodesDest.Add(, , .Key, .Text, .image, .SelectedImage)
        CopyNode.BackColor = nodeSrc.BackColor
        CopyNode.Tag = nodeSrc.Tag
        If CopyNode.image = 4 Then
            CopyNode.Expanded = False
            Else
            CopyNode.Expanded = True
            End If
        Else
        If (nodeParent Is Nothing) Then
            Set CopyNode = nodesDest.Add(.Parent.index, _
            tvwChild, .Key, .Text, .image, .SelectedImage)
            CopyNode.BackColor = nodeSrc.BackColor
            CopyNode.Tag = nodeSrc.Tag
            If CopyNode.image = 4 Then
                CopyNode.Expanded = False
                Else
                CopyNode.Expanded = True
                End If
            Else
            Set CopyNode = nodesDest.Add(nodeParent, _
            tvwChild, .Key, .Text, .image, .SelectedImage)
            CopyNode.BackColor = nodeSrc.BackColor
            CopyNode.Tag = nodeSrc.Tag
            If CopyNode.image = 4 Then
                CopyNode.Expanded = False
                Else
                CopyNode.Expanded = True
                End If
            End If
        End If
    End With
Exit Function
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
    Case vbAbort
        Exit Function
    Case vbRetry
        Stop
        Resume
    Case vbIgnore
        Resume Next
    End Select
End Function
Title: Re: VB 6 Treeview and nodes
Post by: mmelone on March 22, 2006, 04:49:37 PM
Oh yeah, the key here is that I used two treeviews.  One of them is the unfiltered version (with all the nodes in it), the other gets erased every time a filter is applied, and repopulated based on filter conditions.  Then, you just pass all events back to the origonal treeview.  For example
Code: [Select]
Private Sub FilterResults_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo Trap
ModelNames_NodeClick Node
Set ModelNames.SelectedItem = Node
Exit Sub
Trap:
Select Case MsgBox(Err.Description, vbAbortRetryIgnore, Err.Number)
    Case vbAbort
        Exit Sub
    Case vbRetry
        Stop
        Resume
    Case vbIgnore
        Resume Next
    End Select
End Sub
Title: Re: VB 6 Treeview and nodes
Post by: Chuck Gabriel on March 22, 2006, 08:34:43 PM
Hola Mr. Melone.  Good ta 'see' ya.  Hope you've been well.

Welcome to theSwamp.