---

Brønshøj d. 25 januar 2001
Er der nogen der mangler noget kode til Dynamisk oprettelse af
Nodes(TreeView)?
basTreeView.bas læser en tekst fil med denne opbygning
linie 1 indryk 0
linie 2 indryk 1
linie 3 indryk 2
linie 4 indryk 3
linie 5 indryk 3
linie 6 indryk 1
linie 7 indryk 0

Koden er venligst stillet til rådighed af
Asbjørn Sloth Tønnesen
asbjorn@caduceus.dk

basTreeView.bas START
Option Explicit


Private Type nodeinfo
Tekst As String
Indryk As Integer
End Type
Dim RLine() As String ' RåLine
Dim ELine() As nodeinfo ' EditLine

Sub setTV(Tv As Control, src As String)
Tv.Style = tvwTreelinesPlusMinusText
Tv.LineStyle = tvwRootLines
MakeLineArray src
MakeNodesArray
CreateNodes Tv
End Sub

Sub CreateNodes(Tv As Control)
Dim i As Long
Dim Nodx As Node
Dim Key As String
Dim AntalLevels As Integer
Dim HighLevel As Integer
AntalLevels = FindLevel()
Dim LevelNow As Integer
Dim LastLevel As Integer
Dim Level() As String ' last name on that level
ReDim Preserve Level(AntalLevels)
Tv.Nodes.Clear
For i = 1 To UBound(ELine)
Key = "K" & i
LevelNow = ELine(i).Indryk
Debug.Print i & ": LevelNow = " & LevelNow
LastLevel = LevelNow - 1
Debug.Print i & ": LastLevel = " & LastLevel
If LevelNow > HighLevel Then

Set Nodx = Tv.Nodes.Add(Level(LastLevel), tvwChild, Key,
ELine(i).Tekst)
Level(ELine(i).Indryk) = Key
Debug.Print "Brugt tl " & i
Else
If Level(LevelNow) = Empty Then
Set Nodx = Tv.Nodes.Add(, , Key, ELine(i).Tekst)
Else
Set Nodx = Tv.Nodes.Add(Level(LevelNow), tvwNext, Key,
ELine(i).Tekst)
End If
Level(LevelNow) = Key
Debug.Print i & ": Key = " & Key
End If
Next i
Tv.Refresh
End Sub

Function AntalSpace(Str As String) As Integer
Dim Antal As Long
Dim Space2 As String
Dim Tegn As String
Dim Res As Integer
Dim i As Long
Space2 = Chr(32)
Antal = 0
For i = 1 To Len(Str)
Tegn = Mid(Str, i, 1)
If Tegn <> Space2 Then
Exit For
Else
Antal = Antal + 1
End If
Next
AntalSpace = Antal
End Function

Sub MakeNodesArray()
Dim Antal As Long
For Antal = 1 To UBound(RLine)
ReDim Preserve ELine(Antal)
ELine(Antal).Indryk = AntalSpace(RLine(Antal))
ELine(Antal).Tekst = Trim(RLine(Antal))
Next Antal
End Sub

Sub MakeLineArray(src As String)
Dim Antal As Long
Dim Filnr As Integer
Dim Tekst As String
Filnr = FreeFile
Open src For Input As #Filnr
Do While EOF(Filnr) = False
Line Input #Filnr, Tekst
If Tekst <> Empty Then
Antal = Antal + 1
ReDim Preserve RLine(Antal)
RLine(Antal) = Tekst
End If
Loop
Close #Filnr
End Sub

Function FindLevel() As Integer
Dim i As Long
Dim Level As Integer
Level = 0
For i = 1 To UBound(ELine)
If ELine(i).Indryk > Level Then
Level = ELine(i).Indryk
End If
Next i
FindLevel = Level
End Function