TheSwamp
Code Red => VB(A) => Topic started 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.
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.
-
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.
-
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)
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
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
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
-
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
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
-
Hola Mr. Melone. Good ta 'see' ya. Hope you've been well.
Welcome to theSwamp.