Помогите решить проблему с ProgressBar

← →
Evg12 (2003-07-30 16:30) [0]

Уважаемые. Столкнулся с проблемой. - Во время работы программы выводится форма с ProgressBar. Оказалось что ProgressBar при вызове StebBy или StepIt кушает слишком много времени для рисования. Как сделать чтоб ProgressBar и та самая форма была отдельной задачей (тоесть рисовались не трача времени основной задачи). Или предложите любой другой способ.

← →
panov (2003-07-30 16:34) [1]

А ты по форуму неного вглубь поищи.

← →
Юрий Зотов (2003-07-30 16:37) [2]

Сама задача невизуальная?
То есть - математика, копирование фалов и т.п.?

Если да - вынесите ее в отдельный поток. Периодически он через PostMessage должен уведомлять основной поток, а то уже обновляет ProgressBar.

← →
Evg12 (2003-07-30 18:54) [3]

to Юрий Зотов: Еслиб я знал как это делается я в конфу не написал бы.

← →
Evg12 (2003-07-30 19:30) [4]

to panov: 30 страниц вглубь - ничего. Дальше думаю безсмысленно.

← →
Толик (2003-07-30 19:35) [5]

Дальше думаю безсмысленно.

Буквально вчера вопрос поднимался.

← →
Юрий Зотов (2003-07-30 19:47) [6]

Зачем 30 страниц? Нашел на 7-й.
:о)

http://delphimaster.net/view/1-1059402444/

← →
Evg12 (2003-07-30 20:04) [7]

Спасибо. Странно. Видимо пропустил. Кстати не исключено что конфа глючит или модераторы бушуют. Частенько вижу как неожиданно исчезают сообщения со страниц. А потом также неожиданно появляются.

← →
Юрий Зотов (2003-07-30 20:13) [8]

> Evg12 (30.07.03 20:04)
> А потом также неожиданно появляются.

Тогда модераторы точно ни при чем. Обратной дороги нет.

← →
Anatoly Podgoretsky (2003-07-30 21:02) [9]

Барабашка одназначно

← →
Anatoly Podgoretsky (2003-07-30 21:10) [10]

Если бы не ссылка на StebBy и StepIt я бы поверил, а так не очень верится, не может он быть таким длинным.

← →
Evg12 (2003-07-30 21:38) [11]

To: Anatoly Podgoretsky: Длинный длинный и еще какоооой.
В моем случае - вызов ProgressBar1.StepBy(1) - выполнение процедуры 4 секунды - что абсолютно не допустимо. (не успевает).
Если убрать строку - 0.1 секунды - что в пределах нормы, и даже с запасом. Вообще код очень времякритичный 80% на асемблере пришлось ваять. (управление внешним устройством у которого свой собственный протокол обмена). А без прогрессбара нельзя. В техзадании большими буквами ...

← →
Anatoly Podgoretsky (2003-07-30 21:51) [12]

Это у тебя что то с компьютером, с видео, перегрузка чего нибудь, здлюные потоки.
Ты представиь сколько нужно времени, что бы нарисовать весь экран, не то что узкую полоску. Значит это время у тебя есть что то другое. Вот если бы речь шла об Position, то ч бы еще поверил, там и вычисления, в том числе возможно и с плавающей запятой и возможность вызвать миллионы раз, а тут максимум 1000 вызовов, я надеюсь что у тебя мах менее ширины экрана, если нет то это ошибки алгоритма. На самом деле пробежаться по всей полоске займет доли секунды.
Так что приведи код, где ты устанавливаешь Max и где делаешь вызов StepBy

← →
Evg12 (2003-07-30 23:02) [13]

To Anatoly Podgoretsky: с компьютером, с видео все в порядке.

Кусок исходника:

unit uRuner;
=================
type
TfmRuner = class(TForm)
======================

var
Registers: array of LongWord;

=====================
Registers[$11]:=0;
fmProgress.ProgressBar1.Position := 0;
fmProgress.ProgressBar1.Max := length(buffer);
fmProgress.Show;
Application.ProcessMessages;
while Registers[$11] < length(Dat_buffer) do
begin
RunSection(SR_vibor);
case Last_Error of
02: break;
end;
fmProgress.ProgressBar1.StepBy(1);
inc (Registers [$11]);
end;
======================

Last_Error - общая переменная.
RunSection(SR_vibor); - Процедура - чистая математика, работа c array of LongWord и вывод в порт, если при выполнении, была ошибка обмена то Last_Error := 2. Все больше она ничего неделает.

Все просто.... Единственная проблема может быть в том что я вызываю ProgressBar1 другой формы.

← →
Evg12 (2003-07-30 23:18) [14]

Только что проверил - плевать на какой форме ProgressBar лежит. Скорость одинакова.

← →
Anatoly Podgoretsky (2003-07-30 23:35) [15]

Ты не указад какой размер имеет buffer, вероятно очень большой?
Нет смысла многократно перерисовывать прогресс на одном и томже месте, надо нормализовать его размер к MAX=WIDTH и перерисовывать только тогда, когда он смещается на следующий пиксел. И будет все очень быстро.
При том как странно, MAX ни как не связан с дальнейшими операциями, например с циклос while.
Так что проводи нормализаци и если у тебя ширина прогресса скажем 130 пикселей то и вызывать надо рисование только 130 раз, а не length(buffer) раз

← →
Evg12 (2003-07-31 02:05) [16]

buffer - Динамический от 32 до 500 байт (в принципе и больше может быть). В зависимости от того что нужно в устройство отправить. Но это не важно.
>>Нет смысла многократно перерисовывать прогресс.....
Есть смысл. Дело в том что так как ты описал будет происходить задержка, не постоянная, с которой еще можно бороться, а динамическая. Тоесть один раз, допустим, каждый 30 проход цикла. Я об этом всем думал много и долго. Синхронизация с устройством сбиться может, особенно на медленном компьютере.
По этому я вижу теоретический выход в вынесении fmProgress в отдельную задачу, которая будет следить за изменением одной из переменных основной задачи.
Но я этого никогда не делал. (Даже терменологию не особо знаю в этой области). Ну не приходилось никогда...

← →
Song (2003-07-31 08:34) [17]

With ProgressBar1 Do Progress:=Progress+1;

← →
Alex_*** (2003-07-31 09:26) [18]

Если такие проблемы с синхронизацией, то вынесение прогресса в отдельный поток не решит этой проблемы. А если система активизирует процесс с большим приоритетом? И никакой отдельный поток не спасет. На этом фоне задержками на каждые 30 итераций можно пренебречь, я думаю. Используй синхронизацию. Отрисовываться прогресс долго не может по определению(там отрисовывать практически нечего). На крайняк ставь Max=100 и наращивай каждые 5 или 10 позиций.Кстати может у тебя какие-то страшные глобальные Refresh"и стоят после приращения прогресса? Я делал в отдельном потоке чтение из порта, а он выкидывал данные в основную форму по запросу этой формы. И вся отрисовка была независима от чтения данных.

← →
dvp (2003-07-31 09:27) [19]

Делаешь у прогрессбара мах=100, в твоей цикле проверяешь, как прошел 1% вычислений и ТОЛЬКО ТОГДА StepBy(1);
Надеюсь понятно объяснил ......

← →
FoxBox (2003-07-31 09:44) [20]

Можно попробовать обновлять progressbar каждую секунду, установив прежде position (если progressbar1.MAX = длине буфера,
засовывай в position Registers[$11]). Юзверь несильно заметит, что БАР прорисовывается "скачками" в одну секунду...

← →
FoxBox (2003-07-31 09:48) [21]

Еще решение - смени компонент, для напримера GAUGE на панели SAMPLES. Может процедура перерисовки на этом компоненте веселее работает...

← →
Anatoly Podgoretsky (2003-07-31 09:54) [22]

Song © (31.07.03 08:34)
Это и делается через StepXXX
Его проблема не в прорисовке, она просто мгновенная, а или во множественных прорисовках или других частях программы, которые здесь не видны.
Вот в этой проверке, на 500 прорисовок, я не успеваю кнопку мышки отпустить, как она все пробежала.
Никакими 4 секундами не то что на иттерацию, а вообще и не пахнет, доли секунды.
Данная проверка на 1 000 000 прорисовок с наращицванием через StepIt, с шагом 1 показала

procedure TForm1.Button1Click(Sender: TObject); var I : Integer; begin ProgressBar1.Position := 0; ProgressBar1.Step := 1; ProgressBar1.Max := 1000000; for I := 1 to 1000000 do begin ProgressBar1.Stepit; Application.ProcessMessages; end; end;
Ширина линейки 500 пикселей.
Данный цикл выполнился за 185 секунд (5400 прорисовок в секунду)
И это на процессоре в 266 мгц с 64 мб памяти.

← →
dvp (2003-07-31 10:43) [23]

prbar.max:=100;
prbar.position:=0;
s:=0;

n:=100000000;
for i:=1 to n do
begin
s1:=(i div n *100);
if s<>s1 then
begin
s:=s1;
( 1) prbar.max:=100;
prbar.position:=0;
s:=0;

n:=100000000;
for i:=1 to n do
begin
s1:=(i div n *100);
if s<>s1 then
begin
s:=s1;
Prbar.stepby(1);
end;
end;

← →
Pentium 5 (2003-07-31 10:54) [24]

2Anatoly Podgoretsky

А у меня этот цикл выполнился за 310 секунд.
И это на процессоре 1800 МГц с 512 Мб памяти

← →
panov (2003-07-31 11:19) [25]

>Pentium 5 © (31.07.03 10:54)

Скорость зависит не только от процессора и памяти, но и от скорости графической подсистемы ПК.

← →
Плохиш (2003-07-31 11:22) [26]

>Pentium 5 ©
Пора выкидывать ;-)
Cel. 1,7 512 50 sek

>Evg12
Используй TGauge
т.с. < 1 sek!

← →
REP (2003-07-31 13:25) [27]

И правда, что:
Progressbar 40s
Gauge 0.3 s

← →
Anatoly Podgoretsky (2003-07-31 13:35) [28]

Даже в этом случае 3225/sec очень далеко от 0.25/sec
Для твоей самой крупной иерации в 500, время прорисовки будет всего 150 миллисекунд.

← →
Alex_*** (2003-07-31 16:44) [29]

Дискуссия по поводу обновления прогресса ))) Взрослые люди, блин... ))

← →
Fay (2003-07-31 16:51) [30]

А нафинг отображать прогресс продолжительность которого ~0.1 с???

← →
Плохиш (2003-07-31 16:57) [31]

>Alex_*** (31.07.03 16:44)
Что ж нам и расслабиться нельзя ;-)
Всё ж интереснее, чем про F1 по несколько раз на дню рассказывать
:-(

← →
Anatoly Podgoretsky (2003-07-31 16:57) [32]

и тратить на это 2000 секунд :-)

← →
Юрий Зотов (2003-07-31 16:57) [33]

> Alex_*** (31.07.03 16:44)

Хорошо, если Вы настаиваете, привожу работаюший пример. Но все же народ, похоже, прав, советую прислушаться.

====== Главная форма ========

unit uMain;

type
TfrmMain = class(TForm)
btnStart: TButton;
procedure btnStartClick(Sender: TObject);
end;

uses
uProgress;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
ShowProgress
end;

====== Форма с ProgressBar"ом ===========

unit uProgress;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, StdCtrls, uProgressThread;

const
UM_UPDATE = WM_USER + 100;

type
TUMUpdate = packed record
Msg: Cardinal;
Code: Longint; // 0 - начало, 1 - выполнение, 2 - завершение
Value: Longint; // При Code=0 - Max, при Code=1 - Position
Result: Longint
end;

TfrmProgress = class(TForm)
btnCancel: TButton;
ProgressBar1: TProgressBar;
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
FThread: TProgressThread;
procedure UMUpdate(var Message: TUMUpdate); message UM_UPDATE;
procedure OnTerminateHandler(Sender: TObject);
end;

function ShowProgress: boolean;

implementation

{$R *.DFM}

function ShowProgress: boolean;
begin
with TfrmProgress.Create(Application) do
try
Result := ShowModal = mrOK
finally
Free
end
end;

{ TfrmProgress }

procedure TfrmProgress.FormShow(Sender: TObject);
begin
FThread := TProgressThread.Create(Handle, OnTerminateHandler)
end;

procedure TfrmProgress.UMUpdate(var Message: TUMUpdate);
begin
with Message do
case Code of
0: ProgressBar1.Max := Value;
1: ProgressBar1.Position := Value;
2: ModalResult := mrOK
end
end;

procedure TfrmProgress.OnTerminateHandler(Sender: TObject);
begin
FThread := nil
end;

procedure TfrmProgress.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
const
Flags = MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2;
begin
CanClose := FThread = nil;
if not CanClose then
begin
FThread.Suspend;
CanClose := MessageBox(Handle, "Terminate?", "Comfirmation", Flags) = ID_YES;
FThread.Resume;
if CanClose then FThread.Terminate
end
end;

end.

========= Модуль с потоком =================

unit uProgressThread;

interface

uses
Windows, Classes;

type
TProgressThread = class(TThread)
private
FFormHandle: THandle;
procedure DoWork;
protected
procedure Execute; override;
public
constructor Create(FormHandle: THandle; OnTerminateHandler: TNotifyEvent); overload;
end;

implementation

uses
uProgress;

{ TProgressThread }

constructor TProgressThread.Create(FormHandle: THandle; OnTerminateHandler: TNotifyEvent);
begin
inherited Create(True);
FreeOnTerminate := True;
FFormHandle := FormHandle;
OnTerminate := OnTerminateHandler;
Resume
end;

procedure TProgressThread.DoWork;
begin
// Вместо этого оператора напишите Ваш код
Sleep(10)
end;

procedure TProgressThread.Execute;
const
Max = 200; // Количество шагов - установите нужное
var
i: integer;
begin
i := 0;
PostMessage(FFormHandle, UM_UPDATE, 0, Max);
while (i < Max) and not Terminated do
begin
DoWork;
Inc(i);
( FFormHandle, UM_UPDATE, 1, i) > Alex_*** (31.07.03 16:44)

Хорошо, если Вы настаиваете, привожу работаюший пример. Но все же народ, похоже, прав, советую прислушаться.

====== Главная форма ========

unit uMain;

type
TfrmMain = class(TForm)
btnStart: TButton;
procedure btnStartClick(Sender: TObject);
end;

uses
uProgress;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
ShowProgress
end;

====== Форма с ProgressBar"ом ===========

unit uProgress;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, StdCtrls, uProgressThread;

const
UM_UPDATE = WM_USER + 100;

type
TUMUpdate = packed record
Msg: Cardinal;
Code: Longint; // 0 - начало, 1 - выполнение, 2 - завершение
Value: Longint; // При Code=0 - Max, при Code=1 - Position
Result: Longint
end;

TfrmProgress = class(TForm)
btnCancel: TButton;
ProgressBar1: TProgressBar;
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
FThread: TProgressThread;
procedure UMUpdate(var Message: TUMUpdate); message UM_UPDATE;
procedure OnTerminateHandler(Sender: TObject);
end;

function ShowProgress: boolean;

implementation

{$R *.DFM}

function ShowProgress: boolean;
begin
with TfrmProgress.Create(Application) do
try
Result := ShowModal = mrOK
finally
Free
end
end;

{ TfrmProgress }

procedure TfrmProgress.FormShow(Sender: TObject);
begin
FThread := TProgressThread.Create(Handle, OnTerminateHandler)
end;

procedure TfrmProgress.UMUpdate(var Message: TUMUpdate);
begin
with Message do
case Code of
0: ProgressBar1.Max := Value;
1: ProgressBar1.Position := Value;
2: ModalResult := mrOK
end
end;

procedure TfrmProgress.OnTerminateHandler(Sender: TObject);
begin
FThread := nil
end;

procedure TfrmProgress.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
const
Flags = MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2;
begin
CanClose := FThread = nil;
if not CanClose then
begin
FThread.Suspend;
CanClose := MessageBox(Handle, "Terminate?", "Comfirmation", Flags) = ID_YES;
FThread.Resume;
if CanClose then FThread.Terminate
end
end;

end.

========= Модуль с потоком =================

unit uProgressThread;

interface

uses
Windows, Classes;

type
TProgressThread = class(TThread)
private
FFormHandle: THandle;
procedure DoWork;
protected
procedure Execute; override;
public
constructor Create(FormHandle: THandle; OnTerminateHandler: TNotifyEvent); overload;
end;

implementation

uses
uProgress;

{ TProgressThread }

constructor TProgressThread.Create(FormHandle: THandle; OnTerminateHandler: TNotifyEvent);
begin
inherited Create(True);
FreeOnTerminate := True;
FFormHandle := FormHandle;
OnTerminate := OnTerminateHandler;
Resume
end;

procedure TProgressThread.DoWork;
begin
// Вместо этого оператора напишите Ваш код
Sleep(10)
end;

procedure TProgressThread.Execute;
const
Max = 200; // Количество шагов - установите нужное
var
i: integer;
begin
i := 0;
PostMessage(FFormHandle, UM_UPDATE, 0, Max);
while (i < Max) and not Terminated do
begin
DoWork;
Inc(i);
PostMessage(FFormHandle, UM_UPDATE, 1, i)
end;
if not Terminated then PostMessage(FFormHandle, UM_UPDATE, 2, 0)
end;

end.

← →
Юрий Зотов (2003-07-31 16:59) [34]

> Alex_*** (31.07.03 16:44)

Сорри, по ошибке адресовал не автору, а Вам.

← →
BlackKing (2003-08-01 00:42) [35]

Nu i zachem ispol"zovat" etot tormoznutij ProgressBar, jesli jest" Gauge, kotorij vaashe ne tormozit? Razve objazatel"no, chto bi progress otobrazhalsja kvadratikami? Nu togda vzjat" i pokovirjaca v ishodnikah GAUGE i sdelat" prorisovku kvadratami.

← →
Zheks (2003-08-01 01:03) [36]

А расскажите лучше про F1.

← →
Evg12 (2003-08-01 20:26) [37]

Чтоб было известно GAUGE тормозит еще больше чем програессбар.
Проверено.
> Юрий Зотов: Код клевый. Разобрался. Спасибо огромное за пример. Не помог. Но благодаря ему и трассировке кода выяснил в чем причина тормоза.
На главной форме компонент лежит. Грузит Видео не слабо так. В этом и есть основная причина.
Пересмотрел исходник компонента, до сих пор понять не могу что там видео грузит. Но это не важно. Писать в место него свой я не буду. Очень много писанины, не успею.
Другой Вопрос - можно ли как-то Отключить полностью работу главной формы, "заткнуть", на время работы процедуры и вывода в форму прогреса.
Перепробовал все что знал, что-то не выходит.
Универсальный способ есть в природе?

← →
Юрий Зотов (2003-08-01 22:54) [38]

> Evg12 (01.08.03 20:26)

Попробуйте просто спрятать главную форму на это время. По идее, тогда она сама и ее контролы перестанут получать сообщения о перерисовке.

Application.MainForm.Hide
try
...
finally
Application.MainForm.Show
end;

← →
Evg12 (2003-08-01 23:12) [39]

Не Не... Этож очень некрасиво получается. Юзер видит как программа вдруг неодиданно исчезает. А потом появляется. Скорей всего посеит серьезную панику.
Другой способ есть?
Кстати я пробовал Делать Hide Самому компоненту - к желаемому результату не привело.

← →
Evg12 (2003-08-01 23:17) [40]

Проверил, ктати сегодня, это так для информации. Скорость процедур, в которые включено отображение хода с помощью прогресбаров, Gauge, на прямую и очень сильно зависят от типов установленных видеоадаптеров.

Уважаеые. Еще мысли какие-то есть по теме?

← →
Юрий Зотов (2003-08-01 23:29) [41]

> Evg12 (01.08.03 23:12)
> Юзер видит как программа вдруг неодиданно исчезает.

Не исчезает, потому что появляется форма с прогрессбаром. Юзер видит, что программа есть и что она работает.

← →
Evg12 (2003-08-01 23:38) [42]

Не важно. Только что попробовал сделать Application.MainForm.Hide;
Application.MainForm.Show;
Результат = 0. Скорость не изменилась никак.
Теперь уже не приложу, почему такой тормоз. И как его убрать.

← →
Юрий Зотов (2003-08-01 23:46) [43]

Значит, надо определить причину. Поможет Вам, видимо, профайлер.

← →
Evg12 (2003-08-02 03:37) [44]

Выяснил в чем причина. Рассмотрел дитально код компонента. Проблема не в нем, а всетаки в прогрессбаре.
Я тут пока состряпал кое-что. Взяв зв основу пример из пакета дельфей 7. Но т.к. не силен в потоках. Наверняка наделал ошибок.
Получилось цикл for i:=0 to 1000000000 c отображением в прогрессбаре через Position:=i на пне III - 700 длится примерно 10 сек.Не зависимо от установленного видеоадаптера.
Сам не особо понимаю как это у меня вышло.

Может кто-то привести его в приличный вид? (всетаки у меня это - первый блин).
Исходник могу слить.

← →
Evg12 (2003-08-02 03:40) [45]

Да забыл написать, Прогрессбар Пробовал растянуть на ширину всего экрана 1024 x 768 скорость не меняется никак.

← →
Anatoly Podgoretsky (2003-08-02 11:57) [46]

Evg12 (02.08.03 03:37)
Ну так великолепный результат 100 000 000 в секунду, хочешь еще быстрее делай не 1 миллиард отрисовок, а только тысячу, будет занимать всего 10 микросекунд + время расчета

← →
Evg12 (2003-08-03 02:39) [47]

Я имел в виду Чтоб на исходник глянули да сказали что я лишнего начудил. Может можно еще проще сделать. Я вот сам не понял до сих пор что делает inherited и еще кое что. И помогли решить еще одну проблему. - Как только форму с прогессбаром, когда выполняется цикл, начинаешь тягать мышкой по столу (под XP) весь процесс замедляется до 10% . Тоесть все нормально работает, пока не трогаешь.

← →
Плохиш (2003-08-03 02:58) [48]

> Evg12
Может алгоритм программы пересмотреть?

← →
Evg12 (2003-08-03 04:58) [49]

> Anatoly Podgoretsky
Корректонул код. Свел до 5 сек.
Да понимаешь, дело в том что у меня цикл for i:=0 to 1000000000 do i:=i; Примерно за 5 сек и исполняется.

>Плохиш
Да блин палка о двух концах и обе ударные получается.
Сделаеш без потока - используя mod (выше описано) - неравномерная задержка выходит. Сделаеш через поток, так к форме с прогресбаром дотронешся, или система запустит что-то с приоритетом выше и умирает все....

Еще мысли есть какие-то?

← →
BlackKing (2003-08-06 22:20) [50]

Nu ne znaju, vsegda ispol"zoval GAUGE i nikogda i nigde ne tormozilo, proverjal na raznih mashinah, s raznimi video, dazhe na ochen" slabih. No eto na Delphi3. Mozhet bit" v posledujushih versijah chto-to namudrili? no v D3 vsjo prosto letajet.

← →
Igor Popov (2003-08-07 03:36) [51]

используй Position

← →
Alibaba (2003-08-07 04:26) [52]

Я тоже использую Position - и вполне доволен жизнью :)

← →
Slym (2003-08-07 08:01) [53]

Попробуй DoubleBuffered...
var i:integer; begin ProgressBar1.DoubleBuffered:=true; ProgressBar1.Position := 0; ProgressBar1.Step := 1; ProgressBar1.Max := 1000000; for I := 1 to 1000000 do begin ProgressBar1.Stepit; Application.ProcessMessages; end; end;
Отрисовка должна ускорится...

Помогите решить проблему с ProgressBar Найти похожие ветки