XML veritabanı ile ağaç menü

 
Option Explicit

Private Sub Form_Load()
Dim sFile As String
sFile = App.Path
If Right(sFile, 1) <> "\" Then sFile = sFile & "\"
sFile = sFile & "menu.xml"
XMLOnTreeView TreeView1, sFile
End Sub

Public Function XMLOnTreeView(tv As Object, XMLFile As String) As Boolean

'FONKSİYON: XML veritabanaındaki verileri ağaç görünümünde (treeview) gösterir

'PARAMETRELER:
'tv: TreeView Control
'XMLFile: Kullanıcal XML dosyasının tam yolu

'DÖNÜŞÜM: Evet / Hayır

'GEREKSİNİMLER: VB6 ve MSXML.DLL Version 2.0


Dim oDoc As New DOMDocument



If Not LCase(TypeName(tv)) = "treeview" Then Exit Function
tv.Nodes.Clear

If Dir(XMLFile) = "" Then Exit Function
If oDoc.Load(XMLFile) Then
XMLNodes2TVNodes tv, oDoc.childNodes, 0
End If

ErrorHandler:
Set oDoc = Nothing


End Function

Private Sub XMLNodes2TVNodes(tv As TreeView, ByRef Nodes As MSXML.IXMLDOMNodeList, _
ByVal Indent As Integer, Optional ParentKey As Variant)

Dim oNode As MSXML.IXMLDOMNode
Dim lKey As Long
Dim sKey As String

Indent = Indent + 2

For Each oNode In Nodes
If LCase(oNode.nodeName <> "xml") Then

If oNode.hasChildNodes = False Then

If oNode.nodeType = NODE_TEXT Or oNode.nodeType = NODE_CDATA_SECTION Then
tv.Nodes.Add CStr(ParentKey), tvwChild, , oNode.nodeValue
End If

Else
On Error Resume Next
If IsMissing(ParentKey) Then
sKey = oNode.nodeName
tv.Nodes.Add , , sKey, sKey
Else
Do
On Error Resume Next
sKey = oNode.nodeName & CStr(lKey)
tv.Nodes.Add CStr(ParentKey), tvwChild, sKey, oNode.nodeName
If Err.Number <> 0 Then
Err.Clear
lKey = lKey + 1
Else
Exit Do
End If
Loop
End If


End If

If oNode.hasChildNodes Then
XMLNodes2TVNodes tv, oNode.childNodes, Indent, sKey
End If
End If
Next oNode
End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

xml veritabanı ile ağaç menü