paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 14:10:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

terminate threads upon form exit

Browse Source 
git-svn-id: trunk@6435 -
This commit is contained in:
micha 2004-12-30 14:50:01 +00:00
parent 8a7395aa69
commit d2d8cf5dd5
1 changed files with 48 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
examples/synchronize.pp
View File

@ -52,6 +52,7 @@ type
FTargetListBox: TListBox; FTargetListBox: TListBox;
FTargetProgress: TProgressBar; FTargetProgress: TProgressBar;
FTestStrings: TStrings; FTestStrings: TStrings;
procedure ExecDone;
procedure ShowStrings; procedure ShowStrings;
public public
constructor Create(CreateSuspended: boolean); constructor Create(CreateSuspended: boolean);
@ -79,6 +80,7 @@ type
Listbox2: TListBox; Listbox2: TListBox;
Thread1: TThread1; Thread1: TThread1;
Thread2: TThread2; Thread2: TThread2;
ThreadList: TList;
Button1: TButton; Button1: TButton;
Button2: TButton; Button2: TButton;
Button3: TButton; Button3: TButton;
@ -92,6 +94,7 @@ type
mnuFile: TMainMenu; mnuFile: TMainMenu;
itmFileQuit: TMenuItem; itmFileQuit: TMenuItem;
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadMainMenu; procedure LoadMainMenu;
procedure mnuQuitClicked(Sender : TObject); procedure mnuQuitClicked(Sender : TObject);
protected protected
@ -105,6 +108,7 @@ type
procedure Button8CLick(Sender : TObject); procedure Button8CLick(Sender : TObject);
procedure Button9CLick(Sender : TObject); procedure Button9CLick(Sender : TObject);
procedure Button10CLick(Sender : TObject); procedure Button10CLick(Sender : TObject);
function CloseQuery: boolean; override;
end; end;
threadvar threadvar
@ -124,9 +128,25 @@ end;
destructor TAThread.Destroy; destructor TAThread.Destroy;
begin begin
inherited;
FTestStrings.Free; FTestStrings.Free;
end; end;
procedure TAThread.ExecDone;
var
lPos: integer;
begin
Form1.ThreadList.Remove(Self);
FTargetListBox.Items.Insert(0, 'Thread terminated');
if Form1.ThreadList.Count = 0 then
begin
lPos := Pos('[', Form1.Caption);
if lPos > 0 then
Form1.Caption := Copy(Form1.Caption, 1, lPos - 1) + '[done, ready to exit]';
end;
end;
procedure TAThread.ShowStrings; procedure TAThread.ShowStrings;
var var
i: integer; i: integer;
@ -182,7 +202,9 @@ begin
DoCalculation; DoCalculation;
Synchronize(@ShowStrings); Synchronize(@ShowStrings);
threadvartest := 10; threadvartest := 10;
if Terminated then break;
end; end;
Synchronize(@ExecDone);
end; end;
constructor TThread2.Create; constructor TThread2.Create;
@ -209,7 +231,9 @@ begin
DoCalculation; DoCalculation;
if (i and $3) = $3 then if (i and $3) = $3 then
Synchronize(@ShowStrings); Synchronize(@ShowStrings);
if Terminated then break;
end; end;
Synchronize(@ExecDone);
end; end;
@ -217,9 +241,31 @@ constructor TForm1.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
Caption := 'Thread Synchronize Demo v0.1'; Caption := 'Thread Synchronize Demo v0.1';
ThreadList := TList.Create;
LoadMainMenu; LoadMainMenu;
end; end;
destructor TForm1.Destroy;
begin
inherited;
FreeAndNil(ThreadList);
end;
function TForm1.CloseQuery: boolean;
var
I: integer;
begin
if ThreadList.Count > 0 then
begin
Caption := Caption + ' [wait for threads termination]';
for I := 0 to ThreadList.Count - 1 do
TThread(ThreadList.Items[I]).Terminate;
Result := false;
end else
inherited;
end;
procedure TForm1.Button1Click(Sender : TObject); procedure TForm1.Button1Click(Sender : TObject);
Begin Begin
if assigned (progre3) then begin if assigned (progre3) then begin
@ -298,8 +344,9 @@ begin
threadvartest := 20; threadvartest := 20;
Thread1 := TThread1.Create; Thread1 := TThread1.Create;
Thread2 := TThread2.Create; Thread2 := TThread2.Create;
ThreadList.Add(Thread1);
ThreadList.Add(Thread2);
threadvartest := 20;
End; End;
procedure TForm1.Button9Click(Sender : TObject); procedure TForm1.Button9Click(Sender : TObject);