Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.09.14;
Скачать: [xml.tar.bz2];

Вниз

Окно - прогресс в отдельном потоке   Найти похожие ветки 

 
Дмитрий Белькевич ©   (2008-07-17 19:28) [0]

Нужно реализовать простую прогресс-форму с прогресс баром, небольшой картинкой и кнопкой прерывания процесса.
Нужно, что бы она работала в отдельном потоке.
То, что обычные формы работать в потоке не будут, знаю.
То что рекомендуют выносить код в поток знаю. Но не представляется возможным - прогресс применяется где-то в 25-30 местах и делать 30 разных потоков нецелесообразно.
Переделываю с обычной формы, так как применение processmessages не всегда допустимо, и при долгом процессе часто бывает, что форма прогресса не реагирует на вызов "hide", оставаясь "висеть".
Может быть кто-то видел готовое решение, скорее всего, как я понял, на API. Несколько часов гугленья не принесли результата.


 
Сергей М. ©   (2008-07-17 20:56) [1]


> Несколько часов гугленья не принесли результата


Значит ты не в тот огород гуглил)

Скажу больше - нет такого огорода.

Как ни гугли)

У тебя кошмарная каша в голове - "форму .. что бы она работала в отдельном потоке"


 
Сергей М. ©   (2008-07-17 20:57) [2]

Пойми, дружок, что форма - это в огороде бузина, а поток - это в Киеве дядька.


 
Loginov Dmitry ©   (2008-07-17 23:34) [3]


> Может быть кто-то видел готовое решение, скорее всего, как
> я понял, на API. Несколько часов гугленья не принесли результата.
>


http://matrix.kladovka.net.ru/index.php?page=downloads&categ=other&pagenum=1

только будь осторожен. Там используется окна типа topmost (поверх всех). После таких окон винда в некоторых случаях может передать фокус рандомно любому расположенному на рабочем столе окну. Но скорее всего у тебя этот эффект не проявится.


 
Игорь Шевченко ©   (2008-07-17 23:39) [4]


> После таких окон винда в некоторых случаях может передать
> фокус рандомно любому расположенному на рабочем столе окну.
>


сам понял, что написал ?


 
Loginov Dmitry ©   (2008-07-17 23:52) [5]


> сам понял, что написал ?


написано коряво, но суть надеюсь понятна.

Неприятный эффект может проявится например в следующем коде:
with TProgressViewer.Create(...) do
try
 Sleep(500);
finally
 Terminate;
end;

Form1.ShowModal;


в результате активным может оказаться любое окно на рабочем столе, а Form1 имеет шанс оказаться на заднем плане. В данном случае проблем больше из-за особенностей TProgressViewer, чем из-за винды.

Однако если сделать задержку >= 5 секунд, то Windows считает основной поток зависшим, и в некоторых случаях может передать фокус какому либо другому окну. Случаи же бывают разные.


 
Германн ©   (2008-07-18 00:14) [6]


> У тебя кошмарная каша в голове - "форму .. что бы она работала
> в отдельном потоке"

Целиком и полностью +


 
Amoeba ©   (2008-07-18 00:39) [7]

Выслал автору вопросу пару демок.


 
Дмитрий Белькевич ©   (2008-07-18 00:45) [8]

>У тебя кошмарная каша в голове - "форму .. что бы она работала в отдельном потоке"

Извиняюсь, окно... дальше по тексту.


 
Дмитрий Белькевич ©   (2008-07-18 00:55) [9]

Еще немного поискал.

Вот хочется нечто такое, только "с прогресс баром, небольшой картинкой и кнопкой прерывания процесса"


type
TT=class(TThread)
private
  FStopEvent:THandle;
  FWaitTime:DWORD;
protected
  procedure Execute;override;
  procedure Stop;
end;

implementation

var
Z:integer;

function WndProc(wnd:HWND; msg:UINT; w:UINT; l:UINT):UINT;stdcall;
var
dc:HDC;
cr:TRect;
ps:PAINTSTRUCT;
str:string;
begin
case msg of
  WM_PAINT:
  begin
    BeginPaint(wnd,ps);
    GetClientRect(wnd,cr);
    str:=IntToStr(Z);
    DrawText(ps.hdc,PChar(str),Length(str),cr,DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    EndPaint(wnd,ps);
  end
  else
    Result:=DefWindowProc(wnd,msg,w,l);
end;
end;

procedure TT.Stop;
begin
SetEvent(FStopEvent);
WaitFor;
end;

procedure TT.Execute;
var
msg:TMsg;
wnd:HWND;
wc:WNDCLASS;
lastTick:DWORD;

procedure OnIdle;
begin
  if GetTickCount-LastTick>FWaitTime then
  begin
    LastTick:=GetTickCount;
    InterlockedIncrement(Z);
    InvalidateRect(wnd,nil,true);
  end;
end;

begin
wc.style:=0;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
wc.hInstance:=hInstance;
wc.hIcon:=0;
wc.hCursor:=0;
wc.hbrBackground:=GetStockObject(LTGRAY_BRUSH);
wc.lpszMenuName:=nil;
wc.lpszClassName:="TESTCLS";
wc.lpfnWndProc:=@WndProc;

Windows.RegisterClass(wc);
wnd:=CreateWindow("TESTCLS","Hello world",WS_CAPTION,CW_USEDEFAULT,CW_USEDEFAULT,200,80,HWND_DESKTOP,0,hInstance,ni l);
ShowWindow(wnd,SW_NORMAL);
UpdateWindow(wnd);

FStopEvent:=CreateEvent(nil,false,false,nil);
FWaitTime:=100;
lastTick:=GetTickCount;
while not Terminated do
begin
  OnIdle;
  case MsgWaitForMultipleObjects(1, FStopEvent, False, FWaitTime, QS_ALLEVENTS) of
    WAIT_OBJECT_0:Terminate;
    WAIT_OBJECT_0+1:
    while PeekMessage(msg, 0, 0, 0, PM_REMOVE) do
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
  end;
end;
DestroyWindow(wnd);
CloseHandle(FStopEvent);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with TT.Create(true) do
begin
  FreeOnTerminate:=true;
  Resume;
end;
end;


 
Дмитрий Белькевич ©   (2008-07-18 00:56) [10]


> Выслал автору вопросу пару демок.


Спасибо, но, к сожалению, ничего не получил...


 
Amoeba ©   (2008-07-18 01:08) [11]

Послал на contact@makhaon.com


 
Дмитрий Белькевич ©   (2008-07-18 01:16) [12]

Спасибо.


 
Дмитрий Белькевич ©   (2008-07-18 01:34) [13]

Посмотрел.
Окна - формы VCL. Для корректной отрисовки и реализвации реакции на кнопку,  ессно, им нужен Application.ProcessMessages. От ProcessMessages я, среди прочего, хочу избавится.


 
Германн ©   (2008-07-18 01:42) [14]


> Дмитрий Белькевич ©   (18.07.08 00:45) [8]
>
> >У тебя кошмарная каша в голове - "форму .. что бы она работала
> в отдельном потоке"
>
> Извиняюсь, окно... дальше по тексту.
>

Книжки читай.
Иначе так запорешь чушь, что вышеназванная тебя привлёчёт по суду.
:)


 
Германн ©   (2008-07-18 01:57) [15]


> Дмитрий Белькевич ©   (18.07.08 01:34) [13]
>
> Посмотрел.
> Окна - формы VCL. Для корректной отрисовки и реализвации
> реакции на кнопку,  ессно, им нужен Application.ProcessMessages.
>  От ProcessMessages я, среди прочего, хочу избавится.
>

Туда же. Ну почитай наконец книжки.
Ну какой смысл использовать доппоток в данном случае?


 
Дмитрий Белькевич ©   (2008-07-18 02:32) [16]

Объясню.
Доппоток нужен, что бы в основном потоке, где происходят различные продолжительные действия, не вызывать ProcessMessages.
Так как из-за этого иногда происходят некоторые неприятные спецеффекты.
То есть, что бы сообщения обрабатывал только дополнительный поток, а основной - работал бы не отвлекаясь на обработку сообщений, пока не закончатся эти самые продолжительные действия.
Но главное - даже не это. Иногда форма не прячется Hid"ом. То есть, я показываю форму, делаю некоторые действия, форма обновляется ProcessMessages"ом, в конце я делаю "Hide", и - ничего. Форма отсаётся "висеть" над приложением, не реагируя на кнопку "закрыть". Приложение приходится убивать.
Если со спецэффектами (читай - глюками) я еще как-то могу повоевать, то против отсутствия реакции на "Hide" я бессилен. В некоторых местах приложения пришлось вообще убрать прогресс-форму, так как она там висла почти в 100% случаев.


 
Eraser ©   (2008-07-18 02:44) [17]

> [16] Дмитрий Белькевич ©   (18.07.08 02:32)


> что бы в основном потоке, где происходят различные продолжительные
> действия

вообще то для различных продолжительных действий и придумали доп. потоки. а так все перевернуто с ног на голову и под это еще велосипед изобретается.


 
Дмитрий Белькевич ©   (2008-07-18 02:56) [18]

Объяснение выше. Сейчас имеется такая форма. Была надежда, что она будет работать хорошо. Однако, как показала практика, она работает с проблемами.
Форма уже использована где-то в тридцати местах разных программ. И сейчас писать 30 разных тредов - просто нереально, так как там и работа с VCL, и с базой, и с пересылкой данных по сети, много всякого, это потребует большой лишней обвязки.

А с проблемой что-то делать нужно.

Сделать одну форму (для любителей придираться к терминам - окно) в отдельном потоке - проше в 30 раз.


 
Eraser ©   (2008-07-18 03:06) [19]

> [18] Дмитрий Белькевич ©   (18.07.08 02:56)

1. уволить архитектора.
2.

> Сделать одну форму (для любителей придираться к терминам
> - окно) в отдельном потоке - проше в 30 раз.

так и навоять тогда отдельный поток и окошко на чистом API к нему, в чем проблемы то, примеров полно в сети )


 
Дмитрий Белькевич ©   (2008-07-18 03:25) [20]

>1. уволить архитектора.

Не представляется возможным ;)

>так и навоять тогда отдельный поток и окошко на чистом API к нему, в чем проблемы то, примеров полно в сети )

О! Читай первый пост ;) Мне нужен пример. В чистом API - не силён, к сожалению. Надеюсь на готовое прогресс-окно. Хорошо, хоть [9] нашел. Пока только это.


 
ЮЮ ©   (2008-07-18 06:28) [21]

Перенести прогресс с формы на StatusBar, который перерисовывается и без processmessages, достаточно StatusBar.Repaint там, где был Application.Processmessages.


 
Сергей М. ©   (2008-07-18 08:25) [22]


> Дмитрий Белькевич ©   (18.07.08 02:32) [16]


Все с ног на голову поставлено)

Алгоритм, который "не должен ни на что отвлекаться", следует реализовать в дополнительном, а не основном потоке.

Задача же основного потока в VCL-приложении (да и не только в VCL) - интерфейс взаимодействия с пользователем: обеспечение своевременной реакции на события пользовательского ввода/вывода.

Т.е. "тяжелая" бизнес-логика выносится в доп.поток[и], тем самым основной поток  освобождается от несвойственной ему работы. Его работа, как, например, в твоем случае - отрисовка прогресс-бара и прочих контролов, ожидание и элементарная обработка клавиатурных и мышиных событий, координация взаимодействия доп.потоков и т.п.


 
Дмитрий Белькевич ©   (2008-07-18 11:03) [23]


> Перенести прогресс с формы на StatusBar,


Думал. Тоже проблема - кнопка "Остановить" бывает нужна.


> Алгоритм, который "не должен ни на что отвлекаться", следует
> реализовать в дополнительном, а не основном потоке.


Я не спорю.

Часть тяжеловесной по времени логики уже вынесено в потоки, к потокам написаны соответствующие обёртки для определения их состояния, готовности, остановки, повтора действия итд.
Но часть логики выносить в потоки не было смысла, так как юзер должен по логике работы приложений либо обязательно дождаться конца какой-то продолжительной его части, либо нажать кнопку "отмена".

Весь код уже написан, и достаточно хорошо работают. За исключением некоторых случаев. Сейчас стоит задача переделать окно - прогресс с минимальным изменением проектов. Согласитесь, что сделать одно окно проще, чем 30 разных потоков. Сейчас, правда, начнут обвинять, что больше на форуме сижу, чем делаю ;). Но. Я уже всё решил, делать буду именно так.


 
Сергей М. ©   (2008-07-18 11:11) [24]


> юзер должен по логике работы приложений либо обязательно
> дождаться конца какой-то продолжительной его части, либо
> нажать кнопку "отмена"


Если основной поток занят и не реагирует ("не отвлекается") ни на какие сигналы, то каим образом ты собираешься просигнализировать ему о нажатии юзером кнопки "Отмена", даже если события этой кнопки ты успешно обработаешь в окне того самого доп.потока, о котором ты завел речь ?


 
Dennis I. Komarov ©   (2008-07-18 11:18) [25]

> Весь код уже написан, и достаточно хорошо работают.

ну-ну


 
Дмитрий Белькевич ©   (2008-07-18 11:19) [26]

В окне будет флаг - отменено. Основной поток будет периодически его проверять. Изначально, при открытии окна флаг сбрасывается, юзер нажал кнопку - флаг устанавливается. Собственно, оно у меня и сейчас так же с формой работает.


 
Dennis I. Komarov ©   (2008-07-18 11:19) [27]

> делать буду именно так.

ну тогда делай как решил, и не грузи мозг.

Потом переделывать больше придется...


 
Дмитрий Белькевич ©   (2008-07-18 11:23) [28]


>  Основной поток будет периодически его проверять.


По терминологии. Это не следует считать "отвлечением". Отвлечение - это выполнение очереди событий основным потоком с помощью ProcessMessages. В моём случае.


 
Дмитрий Белькевич ©   (2008-07-18 11:23) [29]


> ну-ну


Собака лает, караван идёт (с) народная мудрость.


 
Сергей М. ©   (2008-07-18 13:19) [30]


> Отвлечение - это выполнение очереди событий основным потоком
> с помощью ProcessMessages


Вызов этого метода - не единственный и не лучший способ реакции на сообщения.


> По терминологии. Это не следует считать "отвлечением"


Ну если ты изобретатель собственной терминологии, то продолжай в том же духе, караванщик)


 
Игорь Шевченко ©   (2008-07-18 13:39) [31]

У меня к автору вопрос - каким образом будет определяться, что на форме с прогрессом нажата кнопка "Остановить" ?


 
Дмитрий Белькевич ©   (2008-07-18 13:49) [32]

>Вызов этого метода - не единственный и не лучший способ реакции на сообщения.

Как можно обработать нажатие кнопки на форме - прогрессе, и её передвижение, не "прокручивая" всю очередь?

>Ну если ты изобретатель собственной терминологии

Хорошо, пусть это будет отвелчение общего потока. Оно мне, думаю, не критично.


 
Дмитрий Белькевич ©   (2008-07-18 13:51) [33]


> У меня к автору вопрос - каким образом будет определяться,
>  что на форме с прогрессом нажата кнопка "Остановить" ?


В [26]:

В окне будет флаг - отменено. Основной поток будет периодически его проверять. Изначально, при открытии окна флаг сбрасывается, юзер нажал кнопку - флаг устанавливается. Собственно, оно у меня и сейчас так же с формой работает.


 
Игорь Шевченко ©   (2008-07-18 14:11) [34]

Дмитрий Белькевич ©   (18.07.08 13:51) [33]

Насколько я понимаю, основной поток (который выполняет некую работу) будет оповещать поток с формой отображения каким-то образом о собственно прогрессе (например, вызывая PostThreadMessage) или передавая потоку адрес переменной, где находится значение прогресса, а поток с окном, скажем, по таймеру, будет читать эту переменную и отображать прогресс. Это понятно.
А вот как основной поток узнает, что ему надо остановить длинный режим ?


 
Сергей М. ©   (2008-07-18 14:20) [35]


> Как можно обработать нажатие кнопки на форме - прогрессе,
>  и её передвижение, не "прокручивая" всю очередь?


А причем здесь Application.ProcessMessages ?
Использование оного по твоему же условию невозможно - окно с прогресс-баром должно быть создано в контексте дополнительного потока...


 
Сергей М. ©   (2008-07-18 14:22) [36]


> как основной поток узнает, что ему надо остановить длинный
> режим ?


Он же говорит - осн.поток будет опрашивать флаг.


 
Сергей М. ©   (2008-07-18 14:24) [37]


> будет оповещать поток с формой отображения каким-то образом
> о собственно прогрессе


Поди тоже через переменные, раз ему "отвлекаться" нельзя)

А форма с прогрессом будет, наверно, по таймеру опрашивать эти переменные)

Жесть !)


 
Игорь Шевченко ©   (2008-07-18 14:30) [38]

Я делал где-то так:

основная форма:

unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls, StdCtrls, ProgressThread;

type
 TfMain = class(TForm)
   Button: TButton;
   Timer: TTimer;
   procedure ButtonClick(Sender: TObject);
   procedure TimerTimer(Sender: TObject);
 private
   FProgressThread: TProgressThread;
   procedure LongProcessStarted;
   procedure LongProcessCompleted;
 end;

var
 fMain: TfMain;

implementation

{$R *.DFM}

procedure TfMain.ButtonClick(Sender: TObject);
begin
 LongProcessStarted;
 Timer.Enabled := true;
end;

procedure TfMain.LongProcessCompleted;
begin
 FProgressThread.Terminate;
 FProgressThread.WaitFor;
 FProgressThread.Free;
end;

procedure TfMain.LongProcessStarted;
begin
 FProgressThread := TProgressThread.Create (Self);
end;

procedure TfMain.TimerTimer(Sender: TObject);
begin
 LongProcessCompleted;
end;

end.


поток с окном (дочерним по отношению к основной форме)

unit ProgressThread;

interface

uses
 Windows, Forms, Classes;

type
 TProgressThread = class(TThread)
 private
   FTop, FLeft: Integer;
   FParentWidth, FParentHeight: Integer;
   FWindow: HWND;
   FParentWindow: HWND;
   function InitProgressThread: Boolean;
 protected
   procedure Execute; override;
 public
   constructor Create (ParentForm: TForm);
   destructor Destroy; override;
 end;

implementation
uses
 SysUtils, Messages;

function ThreadWndProc (Wnd: HWND; Message: UINT; wParam: WPARAM;
 lParam: LPARAM): LRESULT; stdcall;
var
 ps: PAINTSTRUCT;
 rctext: TRect;
begin
 case Message of
 WM_TIMER:
   begin
     if wParam = 1000 then begin
       InvalidateRect (Wnd, nil, false);
       Result := 0;
     end else
       Result := DefWindowProc (Wnd, Message, wParam, lParam);
   end;
 WM_DESTROY:
   begin
     KillTimer(Wnd, 1000);
     PostQuitMessage(0);
     Result := 0;
   end;
 WM_PAINT:
   begin
     BeginPaint(Wnd, ps);
     SetTextColor(ps.hdc, 0);
     GetClientRect(Wnd, rctext);
     DrawText (ps.hdc, PChar(Format("running %d", [GetTickCount])), -1,
       rctext, DT_CENTER or DT_VCENTER);
     EndPaint(Wnd, ps);
     Result := 0;
   end;
 else
   Result := DefWindowProc (Wnd, Message, wParam, lParam);
 end;
end;

function TProgressThread.InitProgressThread: Boolean;
const
 Height = 100;
 Width = 200;
var
 wc: WNDCLASS;
begin
 FillChar (wc, SizeOf(wc), 0);
 wc.lpfnWndProc := @ThreadWndProc;
 wc.lpszClassName := "HSProgressWindowClass";
 wc.hInstance := HInstance;
 wc.hbrBackground := GetStockObject(WHITE_BRUSH);
 Result := Windows.RegisterClass(wc) <> 0;
 if not Result then
   Exit;
 FWindow := CreateWindowEx (0, "HSProgressWindowClass", "ProgressWindow",
   WS_CHILD or WS_VISIBLE or WS_BORDER, (FParentWidth - Width) div 2,
     (FParentHeight - Height) div 2, Width, Height, FParentWindow, 1,
     HInstance, Self);
 Result := IsWindow(FWindow);
 if not Result then
   Exit;
 SetTimer(FWindow, 1000, 500, nil);
 UpdateWindow(FWindow);
end;

{ TProgressThread }

constructor TProgressThread.Create(ParentForm: TForm);
begin
 FreeOnTerminate := false;
 FLeft := ParentForm.Left;
 FTop := ParentForm.Top;
 FParentWidth := ParentForm.Width;
 FParentHeight := ParentForm.Height;
 FParentWindow := ParentForm.Handle;
 inherited Create (false);
end;

procedure TProgressThread.Execute;
var
 Msg: TMsg;
begin
 if not InitProgressThread then
   Exit;
 while GetMessage(Msg, FWindow, 0, 0) and not Terminated do begin
   TranslateMessage(Msg);
   DispatchMessage(Msg);
 end;
 if Terminated then
   DestroyWindow(FWindow);
end;

destructor TProgressThread.Destroy;
begin
 Windows.UnregisterClass("HSProgressWindowClass", HInstance);
 inherited;
end;

end.


 
Дмитрий Белькевич ©   (2008-07-18 14:37) [39]

>А форма с прогрессом будет, наверно, по таймеру опрашивать эти переменные)

Таймер - лишнее, конечно. PostThreadMessage.

>А причем здесь Application.ProcessMessages ?
Использование оного по твоему же условию невозможно - окно с прогресс-баром должно быть создано в контексте дополнительного потока...

Я думал, что от это вот было сказано по поводу работы с VCL, без доролнительных потоков:

>Вызов этого метода - не единственный и не лучший способ реакции на сообщения.

И спросил - какой способ лучше?

Так как в отдельном потоке - конечно, Application.ProcessMessages не нужен, от него и избавляемся.


 
Сергей М. ©   (2008-07-18 14:40) [40]

Я вообще не понимаю, зачем при данных условиях нужен доп.поток и почему осн.поток не должен "отвлекаться" .. Ведь пока осн.поток занят , GUI мертв ! Ни форму двинуть, ни приложение терминировать, ни картинку перерисовать  .."Живое" окно доп.потока с прогресс-баром и кнопкой "Отмена" в расчет не берем - это, конечно, тоже GUI, но совершенно бестолковый, "корове седло")



Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.09.14;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.59 MB
Время: 0.059 c
15-1216971984
Lamerenok
2008-07-25 11:46
2008.09.14
Как установить Fastnet пакет ?


4-1196339588
sergen
2007-11-29 15:33
2008.09.14
Нужен help


2-1217424279
@!!ex
2008-07-30 17:24
2008.09.14
Рабочая папка процесса.


15-1216726494
Zhekson
2008-07-22 15:34
2008.09.14
qtintf70.dll - кто-нибудь знает, что это за бибилиотека ?


15-1216644223
oldman
2008-07-21 16:43
2008.09.14
Банковский кредитный кризис (как будто опрос)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский