vbAccelerator - Contents of code file: cXmlTreeView.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cXmlTreeView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' The DOM tree for the XML document
Private m_xml As DOMDocument
' File name of the XML document
Private m_filename As String
' TreeView to render to
Private m_tvw As vbalTreeView
' Cached italic font used to render attributes
Private m_fntItalic As StdFont

' Gets/sets the XML Filename
Public Property Get Filename() As String
   Filename = m_filename
End Property
Public Property Let Filename(ByVal value As String)
   m_filename = value
End Property

' Gets/sets the Treeview control used to render the document
Public Property Get TreeView() As vbalTreeView
   Set TreeView = m_tvw
End Property
Public Property Let TreeView(tvw As vbalTreeView)
   Set m_tvw = tvw
End Property

' Loads the document, shows the root element and its children
Public Sub Load()

   m_tvw.Nodes.Clear

   Set m_xml = New DOMDocument
   m_xml.Load m_filename
   If Not (m_xml.parsed) Then
      Err.Raise 11540, App.EXEName & ".cXmlTreeView", m_xml.parseError.reason &
       " at " & m_xml.parseError.Line & ", position " & m_xml.parseError.linepos
   Else
      Dim nodTop As cTreeViewNode
      Set nodTop = m_tvw.Nodes.Add(, etvwChild, m_xml.documentElement.nodeName,
       m_xml.documentElement.nodeName)
      nodTop.Bold = True
      addChildren nodTop, m_xml.documentElement
      nodTop.Selected = True
      nodTop.Expanded = True
   End If

End Sub

' Dynamically loads the children of an element
Public Sub NodeExpand(node As cTreeViewNode)
Dim sXpath As String
Dim xmlNode As IXMLDOMNode
   
   If (node.Children.Count = 0) Then
      sXpath = node.Key
      Set xmlNode = m_xml.selectSingleNode(sXpath)
      addChildren node, xmlNode
   End If
   
End Sub

' Adds the child attributes and nodes to the specified parent
Private Sub addChildren(nodTop As cTreeViewNode, xmlNode As IXMLDOMNode)

Dim child As IXMLDOMNode
Dim attr As IXMLDOMAttribute
Dim nodChild As cTreeViewNode
Dim iCount As Long
Dim sKey As String
Dim sBaseKey As String
Dim bChildNodes As Boolean
Dim sText As String
Dim bText As Boolean
Dim bComment As Boolean

   ' Add the attributes:
   For Each attr In xmlNode.Attributes
      sKey = nodTop.Key & "//index.html" & attr.nodeName
      Set nodChild = nodTop.Children.Add(, etvwChild, sKey, attr.nodeName)
      nodChild.BackColor = RGB(232, 230, 187)
      nodChild.MouseOverBackColor = RGB(232, 230, 187)
      nodChild.Font = m_fntItalic
   Next

   ' Add the child nodes
   For Each child In xmlNode.childNodes
      
      bComment = False
      bText = False
      
      If (child.nodeType = NODE_TEXT) Then
         sBaseKey = nodTop.Key & "/text()"
         sText = child.nodeValue
         bText = True
      ElseIf (child.nodeType = NODE_COMMENT) Then
         sBaseKey = nodTop.Key & "/comment()"
         sText = child.nodeValue
         bComment = True
      Else
         sBaseKey = nodTop.Key & "/index.html" & child.nodeName
         sText = child.nodeName
      End If
      
      ' XML documents can have many nodes with the same
      ' name or type under a node.  To uniquely identify
      ' them with XPath we need to know the index of the
      ' item within its parent.  Here we just loop to
      ' find the index - that is a bit expensive if the
      ' document is enormous, so you could have a
      ' collection of previously added items here
      sKey = sBaseKey
      If (nodTop.Children.Exists(sKey)) Then
         nodTop.Children(sKey).Key = sBaseKey & "[0]"
         sKey = sBaseKey & "[1]"
      ElseIf (nodTop.Children.Exists(sKey & "[0]")) Then
         iCount = 2
         Do
            sKey = sBaseKey & "[" & iCount & "]"
            iCount = iCount + 1
         Loop While (nodTop.Children.Exists(sKey))
      End If
      
      ' Actually add the node and format it
      Set nodChild = nodTop.Children.Add(, etvwChild, sKey, sText)
      If bText Then
         nodChild.BackColor = RGB(181, 209, 238)
         nodChild.MouseOverBackColor = RGB(181, 209, 238)
      ElseIf bComment Then
         nodChild.ForeColor = RGB(138, 188, 92)
         nodChild.MouseOverForeColor = RGB(138, 188, 92)
      End If
      
      ' Now set the ShowPlusMinus to indicate whether this node
      ' can be expanded or not.  This allows us to dynamically
      ' add children on the TreeView's BeforeExpand event.
      bChildNodes = child.hasChildNodes
      If Not (child.Attributes Is Nothing) Then
         bChildNodes = bChildNodes Or (child.Attributes.length > 0)
      End If
      nodChild.ShowPlusMinus = bChildNodes
   
   Next
   
End Sub

' Gets the text for the specified tree node
Public Function GetItemText(nod As cTreeViewNode) As String
Dim sXpath As String
Dim xmlNode As IXMLDOMNode
   sXpath = nod.Key
   Set xmlNode = m_xml.selectSingleNode(nod.Key)
   GetItemText = xmlNode.Text
End Function

' Constructs a new instance of this class
Private Sub Class_Initialize()
   Set m_fntItalic = New StdFont
   m_fntItalic.Name = "Tahoma"
   m_fntItalic.Size = 8.25
   m_fntItalic.Italic = True
End Sub