Сейчас пишу приложение, которое время от времени, ( достаточно редко, причём наиболее долго -- самый первый раз; все остальные разы существенно короче ), выполняет довольно длительные вычисления в безоконном классе, т.е. в чисто расчётном модуле. Начал под линуксом ( Ubuntu 10.04 + Lazarus 0.9.30 ), затем возникла надобность перенести сделанное под винду ( Win7 Starter + Lazarus 0.9.31 ). В процессе перенесения возникла трудность : если запускать не под отладкой, а в stand-alone режиме, то во время этих самых длительных вычислений под виндой тестовая форма теряет фокус ( например, если переключиться на другое окно ), то она перестаёт реагировать на внешние события вообще и "выцветает", пока длительные вычисления не завершатся. В диспетчере задач видно, что программа никуда не делась, не повисла, и работает. Под линуксом такой неприятности почему-то не возникает.
Попробовал бороться с напастью путём создания в расчётном модуле "пользовательского события", которое по идее должно периодически сообщать форме ( или другому безоконному расчётному модулю ) о завершении некоторого промежуточного этапа вычислений. Копал много и долго, однако всё время нарывался на рецепты и примеры именно для графики ( сообщения и пр. ) и многопоточной модели ( класс TThread ), пока не нашёл вот это : http://www.delphisources.ru/forum/showt ... 5%EA%F2%E0 , показавшееся мне близким к тому, что я хочу сделать. Пользовательское событие создать по этим рекомендациям создать вроде бы получилось, но теперь другая проблема -- как его правильно использовать.
Вот что получилось в имитации длительных расчётов :расчётный модуль-имитация :
- Код: Выделить всё
unit FooClass;
//
{$mode objfpc}{$H+}
//
interface
//
uses
Classes, SysUtils;
//
type
TUserEvent = procedure ( Sender : TObject ) of object;
//
TFooClass = class ( TObject )
//
private
{ private declarations }
NDim : integer;
//
fCalcDone : TUserEvent;
//
procedure FireUserEvent ( Sender : TObject );
//
protected
{ protected declarations }
//
public
{ public declarations }
constructor Create ( ndim_ : integer );
//
destructor Destroy; override;
//
function FooMethod ( ) : double;
//
property CalcDone : TUserEvent read fCalcDone;
end;
//
implementation
//
procedure TFooClass.FireUserEvent ( Sender : TObject );
begin
if ( Assigned ( fCalcDone ) ) then fCalcDone ( Self );
end;
//
constructor TFooClass.Create ( ndim_ : integer );
begin
inherited Create;
//
NDim := ndim_;
if ( NDim < 1 ) then NDim := 1;
end;
//
destructor TFooClass.Destroy;
begin
//
inherited Destroy;
end;
//
function TFooClass.FooMethod ( ) : double;
var
i, j, k, l : integer;
summ, rnum : double;
begin
summ := 0;
//
for i := 0 to NDim - 1 do
begin
for j := 0 to NDim - 1 do
begin
for k := 0 to NDim - 1 do
begin
for l := 0 to NDim - 1 do
begin
rnum := 2.0 * Random - 1.0;
summ := summ + ln ( exp ( rnum ) );
end;
// Fire User Event
FireUserEvent ( Self );
end;
end;
end;
//
summ := ln ( abs ( summ + 1.0 ) );
//
Result := summ;
end;
end.
тестовая форма :
- Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, FooClass;
type
{ TForm1 }
TForm1 = class ( TForm )
Button1: TButton;
Button2: TButton;
//
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
//
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
procedure OnEvent ( fUserEvent : TUserEvent );
public
{ public declarations }
end;
//
var
Form1: TForm1;
//
mFC : TFooClass;
fCalcDone : TUserEvent;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if ( Assigned ( mFC ) ) then FreeAndNil ( mFC );
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, ndim, code : integer;
begin
Val ( Edit1.Text, ndim, code );
//
if ( code <> 0 ) then
begin
ndim := 1;
Edit1.Text := IntToStr ( ndim );
end;
//
mFC := TFooClass.Create ( ndim );
//
Edit2.Text := 'n/a';
Edit3.Text := 'n/a';
//
Edit1.Enabled := false;
Edit2.Enabled := false;
Edit3.Enabled := false;
//
Form1.Repaint;
//
for i := 1 to ndim do
begin
Edit3.Text := FloatToStr ( mFC.FooMethod ( ) );
Edit2.Text := IntToStr ( i );
//
Form1.OnEvent ( fCalcDone );
//
Form1.Repaint;
end;
//
FreeAndNil ( mFC );
//
Edit1.Enabled := true;
Edit2.Enabled := true;
Edit3.Enabled := true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption := '&Start';
Button2.Caption := '&Close';
//
Edit1.Text := '10';
Edit2.Text := 'n/a';
Edit3.Text := 'n/a';
end;
procedure TForm1.OnEvent ( fUserEvent : TUserEvent );
begin
Self.Repaint; // при возникновении события форма должна перерисоваться
end;
end.
Компилируется и работает без ошибок, но ... ничего не происходит.
Как правильно связать пользовательское событие в модуле FooClass с соответствующей процедурой в модуле формы ? Буду признателен за помощь. Ещё раз хотел бы подчеркнуть, что о многопоточности речь не идёт, по крайней мере, пока. Кстати, пока копал, нашёл интересный пример многопоточной программы без использования класса TThread : http://wiki.lazarus.freepascal.org/thre ... _project_1 .
