Сейчас на форуме: tyns777 (+4 невидимых)

 eXeL@B —› Программирование —› Пауза в Delphi
Посл.ответ Сообщение


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 00:47 · Поправил: Isaev
· Личное сообщение · #1

Невероятно странный вопрос, но всё же:
Каким образом организовать в Delphi паузу, чтобы при ожидании не грузила дико процесс и обрабатывались события (особенно на закрытие программы!)?
В сети куча советов, которые на деле не пашут.

Code:
  1. Procedure Delay(mSec:Cardinal);
  2. Var
  3.   TargetTime:Cardinal;
  4. Begin
  5.   TargetTime:=GetTickCount+mSec;
  6.   While TargetTime>GetTickCount Do
  7.     Application.ProcessMessages;
  8. End;


Вот это полная противоположность тому, что надо!

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh

Ранг: 18.8 (новичок), 21thx
Активность: 0.03↘0
Статус: Участник

 Создано: 29 сентября 2010 01:03
· Личное сообщение · #2

Юзай в цикле
procedure ProcessMessages;
var
Msg: TMsg;
function ProcessMsg(var Msg: TMsg): Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end
else
DispatchMessage(Msg);
end;
end;
begin
while ProcessMsg(Msg) do;
end;



Ранг: 18.8 (новичок), 21thx
Активность: 0.03↘0
Статус: Участник

 Создано: 29 сентября 2010 01:12
· Личное сообщение · #3

Само собой, что прога виснуть будет. Лучше создай отдельное окно, принимающее только данное сообщение и вышеуказаный код внеси в него, так менше ошибок будет




Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 01:29
· Личное сообщение · #4

т.е. так?

Code:
  1. ...
  2. While TargetTime>GetTickCount Do
  3.   While ProcessMsg(Msg) Do;
  4. ...


В общем то же самое, на закрытие формы не реагирует, пока не кончится пауза и загрузка проца 90%

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 111.1 (ветеран)
Активность: 0.04↘0
Статус: Участник

 Создано: 29 сентября 2010 01:57
· Личное сообщение · #5

Code:
  1. procedure Delay(ATimeout: Integer);
  2. var
  3.   t: Cardinal;
  4. begin
  5.   while ATimeout > 0 do
  6.   begin
  7.     t := GetTickCount;
  8.     case MsgWaitForMultipleObjects(0, nil^, False, ATimeOut, QS_ALLINPUT) of
  9.       WAIT_TIMEOUT: Break;
  10.       WAIT_FAILED: Exit;
  11.     else
  12.       Application.ProcessMessages;
  13.       if Application.Terminated then Exit;
  14.       dec(ATimeout, GetTickCount - t);
  15.     end;
  16.   end;
  17. end;

Попробуй так. На Delphi 7 пашет.

-----
The truth is out of there...


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 02:02 · Поправил: Isaev
· Личное сообщение · #6

Lumen Зашибись!

[added]
Рано обрадовался
ещё раз суть проблемы... на простейшем примере
Code:
  1.   For N:=1 To 100 Do
  2.     Begin
  3.       Memo1.Lines.Append(IntToStr(N));
  4.       Delay(5000);
  5.     End;

Вот хотелось бы, чтобы в процессе выполнения цикла:
1. можно было закрыть форму
2. процессор не грузился

Error13Tracer пишет:
Само собой, что прога виснуть будет.
А с чего она должна виснуть?
она должна отдыхать... Как таймер работает не грузя систему?

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 111.1 (ветеран)
Активность: 0.04↘0
Статус: Участник

 Создано: 29 сентября 2010 02:49 · Поправил: Lumen
· Личное сообщение · #7

Sleep(1) к примеру можно добавить. Тогда виснуть по идее не должно.
А чтобы можно было закрыть форму - добавить проверку на Application.Terminated.
Code:
  1. Procedure Delay(mSec:Cardinal);
  2. Var
  3.   TargetTime:Cardinal;
  4. Begin
  5.   TargetTime:=GetTickCount+mSec;
  6.   While TargetTime>GetTickCount Do
  7.     begin
  8.         Application.ProcessMessages;
  9.         Sleep(1);
  10.         If Application.Terminated then Exit;
  11.     end;
  12. End;


-----
The truth is out of there...


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 02:58 · Поправил: Isaev
· Личное сообщение · #8

В общем, удовлетворяет, спасибо!

только хотелось бы в подключаемый модуль сунуть, а Application.* не даёт

Если кто знает способ лучше, с удовольствием потестю

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 03:32 · Поправил: Isaev
· Личное сообщение · #9

Что-то на основе WaitableTimer хотелось бы сделать, но никак до конца не разберусь...
Code:
  1. Procedure Delay(mSec:Cardinal);
  2. Var
  3.   P:Int64;
  4.   Timer:Cardinal;
  5. Begin
  6.   Timer:=CreateWaitableTimer(Nil,False,Nil);
  7.   P:=-10*mSec;
  8.   SetWaitableTimer(Timer,P,0,Nil,Nil,False);
  9.   WaitForSingleObjectEx(Timer,INFINITE,True);
  10.   CloseHandle(Timer);
  11. End;

что тут не так?

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh

Ранг: 65.3 (постоянный), 10thx
Активность: 0.02↘0
Статус: Участник

 Создано: 29 сентября 2010 04:09
· Личное сообщение · #10

Может, стоит делать GetMessage(), после установки себе же таймера, потом перепосылать себе это сообщение (PostMessage), спать немного и делать Application.ProcessMessages?
А если не использовать Application.*... Не проще ли таймер сделать?




Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 04:12
· Личное сообщение · #11

tomac пишет:
Не проще ли таймер сделать?
к нему и пришёл, см выше, но пока не разобрался до конца

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 324.3 (мудрец), 222thx
Активность: 0.48↘0.37
Статус: Участник

 Создано: 29 сентября 2010 06:53
· Личное сообщение · #12

Code:
  1. BOOL WINAPI SetWaitableTimer(
  2.   __in          HANDLE hTimer,
  3.   __in          const LARGE_INTEGER* pDueTime,
  4.   __in          LONG lPeriod,
  5.   __in          PTIMERAPCROUTINE pfnCompletionRoutine,
  6.   __in          LPVOID lpArgToCompletionRoutine,
  7.   __in          BOOL fResume
  8. );


1) P должен быть указателем на Int64;
2) lPeriod = 0, таймер сигнализирует однажды.

-----
IZ.RU


Ранг: 793.4 (! !), 568thx
Активность: 0.74↘0
Статус: Участник
Шаман

 Создано: 29 сентября 2010 08:44
· Личное сообщение · #13

Application.ProcessMessages был создан программистами борланда как временное решление проблемы мультипоточности в Delphi а потом оставлен для совместимости. Если вы его используете, значит код написан в корне неправильно. В GUI приложении на Delphi паузы не может быть в принципе, т.к. в основной нити идет выборка и обработка оконнных сообщений, останавливать которую нельзя. Для таких дел есть класс TThread, создающий отдельную нить. В примере с заполнением цикла можно сделать так:

Code:
  1.   TForm1 = class(TForm)
  2.     Memo1: TMemo;
  3.     Button1: TButton;
  4.     procedure Button1Click(Sender: TObject);
  5.   private
  6.     { Private declarations }
  7.   public
  8.     { Public declarations }
  9.   end;
  10.  
  11.   TThreadListFill = class(TThread)
  12.     procedure Execute; override;
  13.   private
  14.     FValue : String;
  15.     procedure AddValue();
  16.   end;
  17.  
  18. var
  19.   Form1: TForm1;
  20.  
  21. implementation
  22.  
  23. {$R *.dfm}
  24.  
  25. { TThreadListFill }
  26.  
  27. procedure TThreadListFill.AddValue;
  28. begin
  29.   Form1.Memo1.Lines.Append(FValue);
  30. end;
  31.  
  32. procedure TThreadListFill.Execute;
  33. var
  34.   i : Integer;
  35. begin
  36.   for i := 1 to 100 do
  37.   begin
  38.     FValue := IntToStr(i);
  39.     Synchronize(AddValue); // VCL hack by Borland
  40.     Sleep(5000);
  41.     if Terminated then Break;
  42.   end;
  43. end;
  44.  
  45. procedure TForm1.Button1Click(Sender: TObject);
  46. var
  47.   FillList : TThreadListFill;
  48. begin
  49.   FillList := TThreadListFill.Create(True);
  50.   FillList.FreeOnTerminate := True;
  51.   FillList.Resume;
  52. end;


Абсолютно не грузит систему, стоит задержка, т.к. отдельная нить, то работа не мешает обработчику сообщений.

-----
Yann Tiersen best and do not fuck


Ранг: 324.3 (мудрец), 222thx
Активность: 0.48↘0.37
Статус: Участник

 Создано: 29 сентября 2010 10:09
· Личное сообщение · #14

PE_Kill
+ 100

Добавлю, что увеличить производительность может буферизованное добавление. Я делал так:

В другом потоке расширял и заполнял буфер (за концом строки указатель на следующую), при накапливании текста осуществлялась проверка, не истекло ли 20 мс (GetTickCount).
Если истекло, считал длину накопленного текста, упаковывал в буфер и оттуда уже в текстовый контрол. Такой алгоритм избавляет от избыточной очереди сообщений.

-----
IZ.RU


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 17:04
· Личное сообщение · #15

PE_Kill нить это конечно хорошо, но что же в неё всю программу вешать, а основной оставить только обработку сообщений?

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh


Ранг: 793.4 (! !), 568thx
Активность: 0.74↘0
Статус: Участник
Шаман

 Создано: 29 сентября 2010 19:04
· Личное сообщение · #16

Isaev почитай основы Win32 программирования. Именно так и советуют поступать. Если действия по времени продолжительные и мешают нормальному функционированию менеджеру сообщений, то да, пихай всё это в отдельный Thread.

У меня есть проект, насчитывающий более 10 000 строк кода и всё это запихано в отдельную нить, а основная как раз и отвечает только за обработку оконных сообщений.

Просто есть задачи, которые ты хоть как извратись, не сделаешь в основной нити, т.к. не можешь управлять очередью сообщений: блокирующие сокеты, Debug API, Events и многое многое другое. Поэтому стоит изначально правильно строить код, чтобы в последствие не переписывать всё с нуля.

-----
Yann Tiersen best and do not fuck


Ранг: 756.3 (! !), 113thx
Активность: 0.61↘0.05
Статус: Участник
Student

 Создано: 29 сентября 2010 20:35
· Личное сообщение · #17

Ясненько, спасибо всем

-----
z+Dw7uLu5+jqLCDq7vLu8PvpIPHs7uMh
 eXeL@B —› Программирование —› Пауза в Delphi
Эта тема закрыта. Ответы больше не принимаются.
   Для печати Для печати