Den här koden måste snabbas upp!!!!
<code>
Public Sub ExtrTree(GetDrive As String, ByVal FollowUp As String)
Dim tback As Node
Dim tback2 As Node
Form1.Tree1.Nodes.Clear
Set tback2 = Form1.Tree1.Nodes.Add(, , GetDrive, GetDrive, 1, 1)
Form1.MousePointer = 11
Open CurFile For Input As #1
Do
Line Input #1, trad
If trad = "<" & GetDrive & ">" Then

Do
Line Input #1, ttrad
If ttrad Like "<*>" Then GoTo steng
tarray = Split(ttrad, "\", , vbTextCompare)
If UBound(tarray) = 1 Then
Set tback = Form1.Tree1.Nodes.Add(GetDrive, tvwChild, mroot & "\" & tarray(1), tarray(1), 3, 3)
Else
On Error Resume Next
utarray = UBound(tarray)
mkay = GetDrive
For a = 1 To utarray - 1
omkay = mkay
mkay = mkay & "\" & tarray(a)
Set tback = Form1.Tree1.Nodes.Add(omkay, tvwChild, mkay, tarray(a), 2, 2)

Next
Set tback = Form1.Tree1.Nodes.Add(mkay, tvwChild, mkay & "\" & tarray(utarray), tarray(utarray), 3, 3)
End If
Loop
End If
Loop Until EOF(1)
steng:
tback2.Child.EnsureVisible
Close #1
If FollowUp <> "" Then
For a = 0 To Form1.Tree1.Nodes.Count - 1
If FollowUp = Form1.Tree1.Nodes.Item(a).Key Then: Form1.Tree1.Nodes.Item(a).EnsureVisible: Form1.Tree1.Nodes.Item(a).Selected = True
Next
End If
Form1.MousePointer = 0
End Sub
</code>

Tack på förhand... Timpa..

Ja, det förstår jag,
Börja med att testa att strukturera om lösning, största prestandavinsten ligger inte i att gör koden bättre utan att göra lösningen bättre.

Men jag vet inte hur jag ska lösa det... Det är den snabbaste lösningen jag kommit på hitills.

Jag ska kolla på det när jag har tid senare ikväll

Har gjort ett försök att snabba upp din kod. Men den är väldigt grötig. Har ej kunnat testa den:

<code>
Public Sub ExtrTree(GetDrive As String, ByVal FollowUp As String)
Dim tback As Node
Dim tback2 As Node
Dim Nodes As Nodes
On Error GoTo ExtrTree_Err
Screen.MousePointer = vbHourglass

Set Nodes = Form1.Tree1.Nodes
Nodes.Clear
Set tback2 = Nodes.Add(, , GetDrive, GetDrive, 1, 1)
tback2.Expanded = True

Open CurFile For Input As #1
Do Until EOF(1)
Line Input #1, trad
If trad = "<" & GetDrive & ">" Then
Do Until EOF(1)
Line Input #1, ttrad
If ttrad Like "<*>" Then
Exit Do 'GoTo steng
Else
tarray = Split(ttrad, "\", , vbTextCompare)
utarray = UBound(tarray)
mkay = GetDrive
For a = 1 To utarray - 1
omkay = mkay
mkay = mkay & "\" & tarray(a)
Set tback = Nodes.Add(omkay, tvwChild, mkay, tarray(a), 2, 2)
Next
Set tback = Nodes.Add(mkay, tvwChild, mkay & "\" & tarray(utarray), tarray(utarray), 3, 3)
End If
Loop
End If
Loop
Close #1

If Len(FollowUp) Then
Nodes(FollowUp).Selected = True
End If
Screen.MousePointer = vbNormal
Exit Sub

ExtrTree_Err:
Select Case Err.Number
Case ccNonUniqueKey
Resume Next
Case ccElemNotFound
Resume Next
Case Else
Screen.MousePointer = vbNormal
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
End Sub
</code>

Followup delen är fel...
Den måste få en sträng. Typ: hej\hoj\jaga.hej
och så letar den upp den i trädet. Får den ingen sträng så ska den inte leta reda på den.

Den första publica relesen kan ni ladda ner här: http://medlem.tripodnet.nu/Timpa/DM2.zip (828k)
Med Drive Mirror 2 kan du skapa speglingar av enheter. Spara det i databaser och sök bland dom.. Mycket bra om man har många cd skivor med mycke filer på, med Drive Mirror 2 blir det lätt ha ha ordning på allt.
Det finns en Drive Mirror 1.x oxå... Den har jag använt mer än något annat program.

Programmet kräver VBRuntime 6 filerna.

MVH Timpa

Du kan hämta en node genom dess nyckel(key). Om den saknas ger den ett fel.

Eller vad menar du?

Ok, toror jag fatar vad du menar...
btw.
är det snabbare att ha:
do until eof(1)
loop

än

do
loop until eof(1)

ok, det gick snabbare med
<code>
If FollowUp <> "" Then
Form1.Tree1.Nodes(FollowUp).Selected = True
Form1.Tree1.Nodes(FollowUp).EnsureVisible
End If
</code>

var iaf tvungen att använda EnsureVisible, annar scrollar den bara neråt och inte åt sidorna.

<code>
Open CurFile For Input As #1
Do Until EOF(1)
Line Input #1, trad
If trad = "<" & GetDrive & ">" Then
Do Until EOF(1)
Line Input #1, ttrad
If ttrad Like "<*>" Then
Exit Do 'GoTo steng
Else
tarray = Split(ttrad, "\", , vbTextCompare)
utarray = UBound(tarray)
mkay = GetDrive
For a = 1 To utarray - 1
omkay = mkay
mkay = mkay & "\" & tarray(a)
Set tback = Nodes.Add(omkay, tvwChild, mkay, tarray(a), 2, 2)
Next
Set tback = Nodes.Add(mkay, tvwChild, mkay & "\" & tarray(utarray), tarray(utarray), 3, 3)
End If
Loop
End If
Loop
'<--------------------------------------------------- HÄR!
Close #1
</code>

du använder dig av Exit Do, men då hoppar den väll bara ur den innersta loopen? jag vill ju att den ska hoppa dit jag markerar i exemplet...

Tycker inte Goto gör koden mindre överskådlig. Men om du vill att den ska gå ut båda looparna så lägger du till en Exit Do i slutet på If-Satsen:
<code>
Open CurFile For Input As #1
Do Until EOF(1)
Line Input #1, trad
If trad = "<" & GetDrive & ">" Then
Do Until EOF(1)
Line Input #1, ttrad
If ttrad Like "<*>" Then
Exit Do
Else
tarray = Split(ttrad, "\", , vbTextCompare)
utarray = UBound(tarray)
mkay = GetDrive
For a = 1 To utarray - 1
omkay = mkay
mkay = mkay & "\" & tarray(a)
Set tback = Nodes.Add(omkay, tvwChild, mkay, tarray(a), 2, 2)
Next
Set tback = Nodes.Add(mkay, tvwChild, mkay & "\" & tarray(utarray), tarray(utarray), 3, 3)
End If
Loop
Exit Do
End If
Loop
Close #1
If FollowUp <> "" Then
With Nodes(FollowUp)
.Selected = True
.EnsureVisible
End With
End If
</code>

Synpunkter för övrigt på din kod.
* Odeklarerade eller globala variabler. T.ex ttrad, trad, mkay, omkay
* Koden är ej kapslad. Jag skulle skickat treview som argument.
* Konstig namngivning. T.ex. ttrad, mkay, omkay, a

Kan du förklara lite snabbt vad du vill göra så ska jag se om jag kan hjälpa dig!

Fast i morgon dock.. Ska sova nue...

MVH
//Jonas

Detta bör gå fort....
<code>
Public Sub ExtrTree(ByVal GetDrive As String, ByVal FollowUp As String)
On Error GoTo ExtrTree_Err
Dim bFound As Boolean
Dim sInput As String
Dim sArray() As String
Dim sTemp() As String
Dim lCount1 As Long
Dim lCount2 As Long
Dim BottomKey As String
Dim ChildKey As String
Dim nTemp As Node
Dim nNodes As Nodes

Screen.MousePointer = vbHourglass

Set nNodes = Form1.Tree1.Nodes
nNodes.Clear

Open CurFile For Binary As #1
sInput$ = String(LOF(1), Chr(0))
Get #1, , sInput$
Close #1

sArray() = Split(sInput, vbCrLf)

Set nTemp = nNodes.Add(, , GetDrive, GetDrive), 1, 1)
nTemp.Expanded = True

bFound = False
For lCount1 = 0 To UBound(sArray)
If bFound Then
If sArray(lCount1) Like "<*>" Then
Exit For
End If

sTemp = Split(sArray(lCount1), "\", , vbTextCompare)

ChildKey = GetDrive
For lCount2 = 0 To UBound(sTemp) - 1
BottomKey = ChildKey
ChildKey = BottomKey & "\" & sTemp(lCount2)
Set nTemp = nNodes.Add(BottomKey, tvwChild, ChildKey, sTemp(lCount2)), 2, 2)
nTemp.Expanded = True
Next lCount2
Set nTemp = nNodes.Add(ChildKey, tvwChild, ChildKey & "\" & sTemp(lCount2), sTemp(lCount2)), 3, 3)
nTemp.Expanded = True
End If

If sArray(lCount1) = "<" & GetDrive & ">" Then
bFound = True
End If
Next lCount1

If Len(FollowUp) Then
Nodes(FollowUp).Selected = True
End If

Screen.MousePointer = vbNormal
Exit Sub

ExtrTree_Err:
Screen.MousePointer = vbNormal
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
</code>
MVH
//Jonas

Jag vet att jag har dåliga variabler... men jag är så j*vla dålig på att komma på variabel namn. Jag aldrig gått någon kurs i vb så jag kan inte det så bra.
Men är 2 st exit do snabbare än en goto?

Ja, men det är inte det som är grejjen med koden som jag har gjort..

Om du tittar lite på den så ser du att jag öppnar och stänger filen i början av dokumentet. För det är inte så bra att ha en file öppen eller att arbeta med den öppen.. Det är oftast trögt... Så det är bättre att ladda in det till en variabel och sen arbeta utifrån den..

Och det är det jag har gjort med den där koden! :)

MVH
//Jonas

hAmpzter, sorry att behöva säga det men din kod funkade inte alls. tror du har missat en eller två loopar.

Hejsan igen...

Kunde inte ladda ner en version av ditt program förra gången... Satt på jobbet och just den sidan var tydligen låst från jobbet så jag fick bara upp ett felmeddelande att den här sidan är inte tillåten att visas..


Jag laddade iaf hem ditt program idag och skapade en fil med det..
Såg att jag hade gjort några slarvfel och sen så hade jag ju glömt vissa saker när det gällde att få in flera på en gång..


Jag vet inte om den nya koden är grymmt mycket snabbare än din gamla, men den känns snabbare enligt vad jag tyckte när jag testade iaf.. :)

<code>
Public Sub ExtrTree(ByVal GetDrive As String, ByVal FollowUp As String)
On Error GoTo ExtrTree_Err
Dim bFound As Boolean
Dim bFoundKey As Boolean
Dim sInput As String
Dim sArray() As String
Dim sTemp() As String
Dim sLast() As String
Dim lCount1 As Long
Dim lCount2 As Long
Dim BottomKey As String
Dim ChildKey As String
Dim nTemp As Node
Dim nNodes As Nodes


Screen.MousePointer = vbHourglass

Set nNodes = Form1.Tree1.Nodes
nNodes.Clear

Open curfile For Binary As #1
sInput$ = String(LOF(1), Chr(0))
Get #1, , sInput$
Close #1

sArray() = Split(sInput, vbCrLf)

Set nTemp = nNodes.Add(, , GetDrive, GetDrive, 1, 1)
nTemp.Expanded = True

bFound = False
For lCount1 = 0 To UBound(sArray)
If bFound Then
If sArray(lCount1) Like "<*>" Then
Exit For
End If

sTemp = Split(Mid(sArray(lCount1), 2), "\", , vbTextCompare)

bFoundKey = False
For lCount2 = 0 To UBound(sTemp) - 1
If BottomKey <> "" And Not bFoundKey Then
If sLast(lCount2) = sTemp(lCount2) Then
BottomKey = BottomKey & "\" & sTemp(lCount2)
Else
bFoundKey = True
End If
ElseIf bFoundKey Then
BottomKey = ChildKey
Else
BottomKey = GetDrive
bFoundKey = True
End If

If bFoundKey Then
ChildKey = BottomKey & "\" & sTemp(lCount2)
Set nTemp = nNodes.Add(BottomKey, tvwChild, ChildKey, sTemp(lCount2), 2, 2)
End If
Next lCount2

If bFoundKey Then
Set nTemp = nNodes.Add(ChildKey, tvwChild, ChildKey & "\" & sTemp(lCount2), sTemp(lCount2), 3, 3)
Else
Set nTemp = nNodes.Add(BottomKey, tvwChild, BottomKey & "\" & sTemp(lCount2), sTemp(lCount2), 3, 3)
End If
sLast = sTemp
BottomKey = GetDrive
End If

If sArray(lCount1) = "<" & GetDrive & ">" Then
bFound = True
End If
Next lCount1

If Len(FollowUp) > 0 Then
nNodes(FollowUp).Selected = True
End If

Screen.MousePointer = vbNormal
Exit Sub

ExtrTree_Err:
Screen.MousePointer = vbNormal
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
</code>

MVH
//Jonas

Ok, ska testa den.

den var 1,5 till 2 sec snabbare än min kod när jag öppnade mitt c: på 10827 filer.

Okej... :/

Det är svårt att göra den snabbare när filen är sparad som den är...
Tyvärr...

Om du inte sparar filen på ett annat sätt så kommer det nog inte bli så mycket snabbare...

Jag kan iaf inte komma på något mycket snabbare sätt att läsa in filen just nu.. Men kommer jag på något så säger jag till!!

MVH
//Jonas

Testa denna:
http://www.mvps.org/btmtz/vbexplorer/

/Pelle

Har inte läst tråden så noga men jag tror nog att ni optimerar på fel ställe.

Om man inte har treeview'n synlig (exempelvis om du har den i en tabControl där tabben med treview'n inte visas) när noderna läggs till så går det mycket snabbare. I ett litet test jag gjorde fick jag en förbättring från ung 5000 millisekunder till 20 seckunder bara genom att inte visa treeviewn när jag lade till noderna.

Observera att det funkar inte med att bara ta myTreeView.visible = FALSE

det finns ett api lockwindowupdate för just detta..

anropa den innan treeviewn fylls och sedan en gång till efter allt är klart , det ger samma effekt som benny beskriver , men utan att behöva trixa med visible proppen

//Roger

Snyggt att vi antagligen har löst ett inlägg som det visst var 3 år sen det postades ;)

Det funkar inte med visible!

Så här fixar man det med LockWindowUpdate
<code>
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Integer) As Integer
...
LockWindowUpdate(myTreeView.Handle.ToInt32)
'Lägg till en massa noder
LockWindowUpdate(0)

</code>

Hååå Håååå Hooo Var fick du luft från ?