Es para ampliar la funcionalidad del control Treeview
Lo hago por varios motivos:
* Aprendi a programar solo (Nadie en mi family sabe de informatica ni ramas asociadas)
* Cuando tuve dudas o lo saque al tiempo, o lo aparqué
* Compartir el conocimiento: Saber nos hace libres (Si alguien no lo entiende, que estudie filosofia xDDD)
* Con pequeñas aportaciones de cada uno, el foro mejora cada vez mas y TODOS salimos beneficiados
* ETC
Código:
' Module : modTreeView
' Description : Routines to extend the functionality of the
' VB TreeView control
Private Declare Function SendMessageLong _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Const WM_SETREDRAW = &HB
Public Sub CollapseAllTreeViewNodes( _
tvwIn As TreeView)
' Comments : Collapses all the nodes on a treeview control
' Parameters: tvwIn - the TreeView control to modify
' Returns : Nothing
Dim nod As Node
On Error GoTo PROC_ERR
' Suppress drawing while collapsing
SendMessageLong tvwIn.hwnd, _
WM_SETREDRAW, 0, ByVal 0&
' loop through all nodes, changing each expanded
' node to be unexpanded
For Each nod In tvwIn.Nodes
If nod.Expanded = True Then
nod.Expanded = False
End If
Next nod
' Resume drawing after collapsing
SendMessageLong tvwIn.hwnd, _
WM_SETREDRAW, 1, ByVal 0&
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"CollapseAllTreeViewNodes"
Resume PROC_EXIT
End Sub
Public Sub CopyTreeView( _
tvwFrom As TreeView, _
tvwTo As TreeView)
' Comments : Copies the contents of one treeview control to another
' Parameters: tvwFrom - Source treeview
' tvwTo - Target treeview
' Returns : Nothing
Dim intCount As Integer
Dim intIndex As Integer
Dim nodTemp As Node
Dim nodNew As Node
Dim nodParent As Node
On Error GoTo PROC_ERR
' Suppress drawing while deleting or adding
SendMessageLong tvwTo.hwnd, WM_SETREDRAW, 0, ByVal 0&
' Remove existing nodes
tvwTo.Nodes.Clear
intCount = tvwFrom.Nodes.Count
' Erase the 'to' control
tvwTo.Nodes.Clear
' Bypass if the source treeview is empty
If intCount <> 0 Then
' Copy each item in the source treeview
For intIndex = 1 To intCount
' Get a pointer to the node at the current index
Set nodTemp = tvwFrom.Nodes(intIndex)
' Handle Root node
If nodTemp.Parent Is Nothing Then
Set nodParent = Nothing
If nodTemp.Key = "" Then
Set nodNew = tvwTo.Nodes.Add(, , , nodTemp.Text)
Else
Set nodNew = tvwTo.Nodes.Add(, , nodTemp.Key, nodTemp.Text)
End If
Else
' Find the already-copied node in the Target treeview that
' corresponds with the index of of the Parent node in the
' Source treeview. Note that this technique will not work if the
' Source and Target treeview controls have different settings for
' the 'Sorted' property
Set nodParent = tvwTo.Nodes(nodTemp.Parent.Index)
' If the node in the Source treeview has a key, assign it when
' we create the new node, otherwise the new node will not have a key
If nodTemp.Key = "" Then
Set nodNew = _
tvwTo.Nodes.Add(nodParent, tvwChild, , nodTemp.Text)
Else
Set nodNew = _
tvwTo.Nodes.Add(nodParent, tvwChild, nodTemp.Key, nodTemp.Text)
End If
End If
' Set the remaining properties
nodNew.Expanded = nodTemp.Expanded
nodNew.Tag = nodTemp.Tag
nodNew.Image = nodTemp.Image
nodNew.ExpandedImage = nodTemp.ExpandedImage
Next intIndex
End If
' Resume drawing after adding
SendMessageLong tvwTo.hwnd, WM_SETREDRAW, 1, ByVal 0&
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"CopyTreeView"
Resume PROC_EXIT
End Sub
Public Sub ExpandAllTreeViewNodes( _
tvwIn As TreeView)
' Comments : Expands all the nodes on a treeview control
' Parameters: tvwIn - the TreeView control to modify
' Returns : Nothing
Dim nod As Node
On Error GoTo PROC_ERR
' Suppress drawing while expanding
SendMessageLong tvwIn.hwnd, _
WM_SETREDRAW, 0, ByVal 0&
' loop through all nodes, changing each unexpanded
' node to be expanded
For Each nod In tvwIn.Nodes
If nod.Expanded = False Then
nod.Expanded = True
End If
Next nod
' Resume drawing after expanding
SendMessageLong tvwIn.hwnd, _
WM_SETREDRAW, 1, ByVal 0&
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"ExpandAllTreeViewNodes"
Resume PROC_EXIT
End Sub
Public Function FindTextTreeView( _
tvwIn As TreeView, _
strSearchText As String, _
Optional fExact As Boolean = True) _
As Variant
' Comments : Finds a node in the treeview control which
' contains the search text
' Parameters: tvwIn - the TreeView to search
' strSearchText - the text to search for. Ignores case
' fExact - if true, finds only the exact search text. If
' false, finds partial matches.
' Returns : If found, the node that matches the search text, otherwise
' nothing
Dim nod As Node
Dim fFound As Boolean
On Error GoTo PROC_ERR
' search each node for the specified text
For Each nod In tvwIn.Nodes
' match the text exactly (ignoring case)
If fExact Then
If UCase(nod.Text) = UCase(strSearchText) Then
fFound = True
Exit For
End If
Else
' match if the text contains the search string
If UCase(nod.Text) Like _
("*" & UCase(strSearchText) & "*") Then
fFound = True
Exit For
End If
End If
Next nod
If fFound Then
Set FindTextTreeView = nod
Else
Set FindTextTreeView = Nothing
End If
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"FindTextTreeView"
Resume PROC_EXIT
End Function
Public Function GetNodeLevel(nodTest As Node) As Integer
' Comments : Returns a number indicating how many levels deep
' the node is on the TreeView
' Parameters: nodTest - the TreeView node to check
' Returns : The TreeView depth level
Dim nodTemp As Node
Dim intDepth As Integer
On Error GoTo PROC_ERR
Set nodTemp = nodTest
Do Until nodTemp.Parent Is Nothing
intDepth = intDepth + 1
Set nodTemp = nodTemp.Parent
Loop
GetNodeLevel = intDepth
Exit Function
PROC_ERR:
GetNodeLevel = 0
'Resume PROC_EXIT
End Function
Salu2