Modulo Ampliar funcinalidad TreeView

[Krnl64]

Aqui les dejo otro code interesante.

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 [Seleccionar] Expandir



' 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