Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > VB6 > ProgressBar относительно 2-ух файлов


Автор: Voldemar2004 17.3.2005, 21:13
Дано: c:\file.wav например
есть функция определения размера файла.
Надо: написать ProgressBar, но так, чтобы он обновлялся в динамическом режиме без
участия пользователя.
Причем размер файла file.wav - фиксирован, а file.ogg - динамически увеличивается.

Код

Function FileUtils_GetDirLen(strPath As String, Optional blCheckSubDir As Boolean = False) As Long

On Error Resume Next
Dim MyName As String
Dim lngLen As Long
Dim lngLenSub As Long
Dim arDirs() As String
Dim lngBound As Long
Dim blPresent As Boolean
Dim i As Long


If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

Err.Clear
MyName = Dir(strPath)
Do While MyName <> "" And Err.Number = 0

    If MyName <> "." And MyName <> ".." Then
 
 
        If (GetAttr(strPath & MyName) And vbDirectory) <> vbDirectory Then

            lngLen = lngLen + FileUtils_GetFileLen(strPath & MyName)
        End If
    End If
    Err.Clear
    MyName = Dir
Loop

If blCheckSubDir = True Then
    Err.Clear
    lngBound = 0
    MyName = Dir(strPath, vbDirectory)
    Do While MyName <> "" And Err.Number = 0
    
        If MyName <> "." And MyName <> ".." Then
            blPresent = False
          
            For i = 1 To lngBound
              
                If arDirs(i) = MyName Then
                 
                    blPresent = True
                    Exit For
                End If
            Next i
       
            If blPresent = False Then
       
                lngBound = lngBound + 1
            
                ReDim Preserve arDirs(lngBound)
              
                arDirs(lngBound) = MyName
              
                If (GetAttr(strPath & MyName) And vbDirectory) = vbDirectory Then
                    If blCheckSubDir = True Then
                
                        lngLenSub = lngLenSub + FileUtils_GetDirLen(strPath & MyName & "\", blCheckSubDir)
        
                        MyName = Dir(strPath, vbDirectory)
                    End If
                End If
            End If
        End If
        Err.Clear
        MyName = Dir
    Loop
End If
FileUtils_GetDirLen = lngLen + lngLenSub
End Function


Код

Function FileUtils_GetFileLen(strPath As String) As Long


On Error Resume Next
FileUtils_GetFileLen = FileLen(strPath)
End Function


Код

Text1.Text = (FileLen("c:\file.wav"))/1048576
Text2.Text = (FileLen("c:\file.ogg"))/1048576


делим на 1048576 (1024*1024) чтобы получать размер сразу в Мб.

Автор: Naghual 18.3.2005, 11:09
Чегото я не совсем уловил что тебе нужно

Автор: Akina 18.3.2005, 11:25
Цитата(Voldemar2004 @ 17.3.2005, 22:13)
Надо: написать ProgressBar, но так, чтобы он обновлялся в динамическом режиме без участия пользователя.

Ну и? Делаешь отедльную форму с прогресс-баром и таймером. Когда нужен - загружаешь и показываешь его, передаешь ему имена файлов, которые нужно отслеживать. Он сам по таймеру смотрит размеры файлов и рисует прогресс. Когда процесс закончился - закрывается, либо его закрывает приложение. Или - если нужен прогресс-бар на форме - просто добавь таймер с соотв. кодом. Дискретность - порядка 100 мс.

Автор: cardinal 18.3.2005, 14:32
Цитата(Akina @ 18.3.2005, 09:25)
Дискретность - порядка 100 мс.

То есть прописывать надо 200 smile В какой-то книге чувак сказал, что чтобы получить секунду надо прописывать 500 в интервале таймера...

p.s. это так мысли на отвлеченные темы...

Автор: Naghual 18.3.2005, 15:11
Цитата
То есть прописывать надо 200  В какой-то книге чувак сказал, что чтобы получить секунду надо прописывать 500 в интервале таймера...

Не согласен. Интервал Таймера исчисляется в миллисекундах. И что-бы получить 1с нужно установить интервал 1000.
А у чувака того не в порядке со временем было на компе.

Автор: cardinal 18.3.2005, 16:09
Цитата(Naghual @ 18.3.2005, 13:11)
И что-бы получить 1с нужно установить интервал 1000.

Это ясно но на практике на самом деле по другому (так сказал этот чувак в книге)...

Но на самом деле правильно Naghual, что не согласен. Я сейчас сварганил маленький тест и он показал, что 1000 более на секунду похоже, чем 500.

Интересно где я такую туфту вычитал? smile

Автор: Akina 18.3.2005, 16:22
VB6.
Кидаем на форму 2 лейбла, таймер на 1000 мс и кнопку. В модуль пишем код:

Код

Dim flag As Boolean

Private Sub Command1_Click()
flag = Not flag
End Sub

Private Sub Timer1_Timer()
If flag Then Label1.Caption = Str(Time) & Str(Timer) Else Label2.Caption = Str(Time) & Str(Timer)
End Sub

Стартуем, периодически кликаем кнопку, делаем выводы про чуваков. Не веришь - возьми еще и секундомер.

Автор: cardinal 18.3.2005, 16:32
Верю smile

Автор: Naghual 18.3.2005, 16:39
Цитата
1000 более на секунду похоже

Но все-же не есть секундой! И это правильно, так-как, этот таймер говняный. Вот если запустить в фоне процесс, например, компресии звука/видео (или любой другой ресурсоемкий), то на секунду больше будет похоже именно 500 а не 1000.

Вот такой вот баг в этом таймере от мелкософта.

Мораль: Или смирится, или использовать другой таймер.

Автор: Akina 18.3.2005, 16:55
Цитата(Naghual @ 18.3.2005, 17:39)
если запустить в фоне процесс, например, компресии звука/видео (или любой другой ресурсоемкий), то на секунду больше будет похоже именно 500 а не 1000.

Тогда используем свойство функции Time получать время из аппаратного таймера. Делаем Timer1 со срабатыванием порядка 50-100 мс и в нем такой код:

Код
Private Sub Timer1_Timer()
Statiс PreviousTime
If Time() <> PreviousTime Then
    PreviousTime = Time() 
    ' Выполняем нужный код- раз в секунду.
End If
End Sub

Автор: Naghual 18.3.2005, 19:15
Akina, ну согласись, что это тоже очень приближенный таймер. Он реализуется на более далеком от системного таймера уровне и зщависит от того-же мелкософтовского таймера. Лично я не вижу в нем особого смысла.
Хотя, как вариант, работать будет.

Автор: cardinal 18.3.2005, 19:31
Я думаю этот вариант
http://vingrad.ru/VB-VB-002119
остается самым лучшим на данный момент...

Автор: Akina 18.3.2005, 19:34
Цитата(Naghual @ 18.3.2005, 20:15)
ну согласись, что это тоже очень приближенный таймер

Не соглашусь. Максимальное его отклонение не превышает времени задержки текущего тика - а если эта задержка более полусекунды, то пора говорить о зависшем процессе... т.е. если в системе нет кривых процессов (как сдохших, так и забывающих отдавать педиорически управление в ось), то точность такого таймера достаточно высока.
Кстати, он работает даже если запустить, к примеру, 3 ВинРАРа в приоритетом повыше (типа 12-13) на архивирование данных на виртуальном диске - при дискретности опроса в 100 мс у меня он глотал в среднем 7 ежесекундных тиков из 10, но при 20 мс уже ничего не пропускал...

Автор: Naghual 18.3.2005, 19:35
Согласен.

Автор: Voldemar2004 20.3.2005, 09:01
Можно еще усложнить задачу: мы никогода точно не знаем размера 2-го файла file.ogg.
ProgressBar то застынет где-то на 5%, то опередит файл file.ogg, поэтому в максимальном значении ProgressBar'a надо выставить что-то типа: размер file.wav делим на коэффициент сжатия этого файла (1411/битрейт сжатия=коэфф.) +- 10% от исходного файла.

Автор: Voldemar2004 22.3.2005, 16:44
До меня сразу-то не дошло что надо Прогресс-Бар воткнуть в Timer. Timer я выставил на 1000 - хотя разницы между 100, 200, 500 и 1000 никакой не заметил. Naghual говорит, что если запусть процесс ресурсоемкий, то время криво отображаться будет, так на это можно сделать приоритет минимальный в Диспетчере Задач. И ваще мне кажется это от мощности ЦПУ зависит больше, чем от объекта Timer, который все так ругают - у меня все проходит гладко.

Код


Private Sub Timer1_Timer()

Dim i As Long
Dim BitRate As Integer
On Error GoTo Err53FileNoFound
If FileLen("c:\esm.ogg") / 1048576 > 1 Then
BitRate = 500
i = ((FileLen("c:\esm.wav")) / (1048576)) / (1411 / (BitRate - BitRate * 0.135))
Text2.Text = (FileLen("c:\esm.ogg")) / 1048576
ProgressBar1.Min = 0.0001
ProgressBar1.Max = i
ProgressBar1.Value = Val(Text2.Text)
End If
Err53FileNoFound: If Err.Number = 53 Then
End If

End Sub


Private Sub Command1_Click()
Text1.Text = FileLen("c:\ESM.wav")
Shell ("c:\OggShell\oggenc.exe") & (" --bitrate 500 c:\esm.wav"), vbHide
End Sub

Добавлено @ 16:46
Да, и еще один вопрос: как программно в Visual BAsic убить процесс в Диспетчере Задач например с PID № 1400. Именно УБИТЬ ПРОЦЕСС, а не Снять Задачу!

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)