Jag vill lägga till en progressbar som visar fortskridningen av lästa filer.
Det funkar MEN fladdrar hela tiden, den visar inte det rätta förloppet.
Hur GÖR jag???? se koden nedan OBS !!! endast VB 6

Dim ListItem As ListItem

Set ListItem = mListItems.Add(, , FileName)
ListItem.SubItems(1) = Path
ListItem.SubItems(2) = Size
mFileCount = mFileCount + 1
ProgressBar1.Min = 0
ProgressBar1.Max = mFileCount
If mTimeOut < Timer Then
DoEvents
Cancel = mCancel
mTimeOut = Timer + 1

ProgressBar1.Value = mFileCount
ProgressBar1.Refresh
End If

Ok spånar lite, Flyttar/lägger till DoEvents
Sen funderar jag, skall du verkligen göra < ProgressBar1.Refresh>
efter varje fil,tycker det fattas code kör du detta i en Loop ?
Testa att ta bort <ProgressBar1.Refresh>
<code>
Dim ListItem As ListItem
Dim mFileCount As Long
Set ListItem = mListItems.Add(, , FileName)
ListItem.SubItems(1) = Path
ListItem.SubItems(2) = Size
mFileCount = mFileCount + 1
ProgressBar1.Min = 0
ProgressBar1.Max = mFileCount
If mTimeOut < Timer Then
DoEvents
Cancel = mCancel
mTimeOut = Timer + 1
ProgressBar1.Value = mFileCount
ProgressBar1.Refresh
DoEvents
End If
</code>

Har testat att tabort refresh
Samma dåliga resultat som innan.

det finns mer code

Private Sub IFindFileCallBack_FindFile(ByVal Path As String, ByVal FileName As String, ByVal Size As Double, ByRef Cancel As Boolean)
Dim ListItem As ListItem
Dim mFileCount As Long
Set ListItem = mListItems.Add(, , FileName)
ListItem.SubItems(1) = Path
ListItem.SubItems(2) = Size
mFileCount = mFileCount + 1
ProgressBar1.Min = 0
ProgressBar1.Max = mFileCount
If mTimeOut < Timer Then
DoEvents
Cancel = mCancel
mTimeOut = Timer + 1
ProgressBar1.Value = mFileCount
'ProgressBar1.Refresh
DoEvents
End If


End Sub

här är koden när jag skall söka fil/er
Private Sub cmdFind_Click()
On Error GoTo cmdFind_Click_Err
If cmdFind.Caption = "Cancel" Then
mCancel = True
Else
cmdFind.Caption = "Cancel"

mFileCount = 0
mFolderCount = 0
Set mListItems = lvwResults.ListItems
mListItems.Clear
FindFilesAPI txtFolder, txtFilter, Me

lblStatus.Caption = ""
cmdFind.Caption = "Find"
mCancel = False
End If

cmdFind_Click_Exit:
Exit Sub

cmdFind_Click_Err:
MsgBox Err.Description, vbCritical
Resume cmdFind_Click_Exit
End Sub

Har löst problemet

Men så för helv... berätta för oss HUR !

Fae... det är ju hela pointen med såna här Forum att berättar "FeedBack"
hur man löser olika problem , bra eller dåligt bara det löser ett problem. !!!

Private Sub IFindFileCallBack_FindFile(ByVal Path As String, ByVal FileName As String, ByVal Size As Double, ByRef Cancel As Boolean)
Dim ListItem As ListItem
Dim mFileCount As Long
Dim x, y As Long
'Timer1.Enabled = True
Set ListItem = mListItems.Add(, , FileName)
ListItem.SubItems(1) = Path
ListItem.SubItems(2) = Size
mFileCount = mFileCount + 1
ProgressBar1.Min = 0
ProgressBar1.Max = mFileCount '
ProgressBar1.Value = 0
If mTimeOut < Timer Then
DoEvents

Cancel = mCancel
mTimeOut = Timer + 1

DoEvents

End If

sleep 500
ProgressBar1.Value = ProgressBar1.Value + 1
End Sub

Är det inte lite dumt att sova i en halv sekund? Om du söker och finner 100 filer kommer sökningen ta 100*0.5=50 sekunder extra. En hel minut i onödan.
Dessutom är väl en progressbar helt fel. Eftersom det är en sökning vet du väl inte hur många filler det är från början. Max värdet. Utan du behöver igentlige en animation som visar att den arbetar/söker.

Exakt Andreas tänkte likadant

Lennart !
Du skall inte skriva Dim x, y As Long
Då blir x Variant och y Long
så här skall det se ut
Dim x As Long, y As Long
Använd <b>Screen.MousePointer = vbHourglass</b> i sådana här kör
<code>
Private Sub IFindFileCallBack_FindFile(ByVal Path As String, ByVal FileName As String, ByVal Size As Double, ByRef Cancel As Boolean)
Dim ListItem As ListItem
Dim mFileCount As Long
Set ListItem = mListItems.Add(, , FileName)
ListItem.SubItems(1) = Path
ListItem.SubItems(2) = Size
Screen.MousePointer = vbHourglass
mFileCount = mFileCount + 1
If mTimeOut < Timer Then
Cancel = mCancel
mTimeOut = Timer + 1
End If
Screen.MousePointer = vbDefault
End Sub
</code>