Дано: 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) чтобы получать размер сразу в Мб.

Чегото я не совсем уловил что тебе нужно

Цитата(Voldemar2004 @ 17.3.2005, 22:13)

Надо: написать ProgressBar, но так, чтобы он обновлялся в динамическом режиме без участия пользователя.

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

Цитата(Akina @ 18.3.2005, 09:25)

Дискретность - порядка 100 мс.

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

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

Цитата

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

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

Цитата(Naghual @ 18.3.2005, 13:11)

И что-бы получить 1с нужно установить интервал 1000.

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

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

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

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

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

Верю

Цитата

1000 более на секунду похоже

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

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

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

Цитата(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

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

Я думаю этот вариант
VB-VB-002119
остается самым лучшим на данный момент...

Цитата(Naghual @ 18.3.2005, 20:15)

ну согласись, что это тоже очень приближенный таймер

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

Согласен.

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

До меня сразу-то не дошло что надо Прогресс-Бар воткнуть в 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. Именно УБИТЬ ПРОЦЕСС, а не Снять Задачу!