unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
TShowStatusEvent = procedure(Status, Task: String) of Object;
{ TMyThread }
TMyThread = class(TThread)
private
fStatusText : string;
fTaskText : string;
FOnShowStatus: TShowStatusEvent;
procedure ShowStatus;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended : boolean);
property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
end;
{ TForm1 }
TForm1 = class(TForm)
btStart: TButton;
btStop: TButton;
laTask: TLabel;
laStatus: TLabel;
procedure btStartClick(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
MyThread: TMyThread;
procedure ShowStatus(Status, Task: string);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TMyThread }
procedure TMyThread.ShowStatus;
begin
if Assigned(FOnShowStatus) then begin
FOnShowStatus(fStatusText, fTaskText);
end;
end;
procedure TMyThread.Execute;
var i: Integer;
begin
fStatusText := 'TMyThread Starting...';
Synchronize(@ShowStatus);
fStatusText := 'TMyThread Running...';
while (not Terminated) do begin //repeat all tasks
for i:= 1 to 9 do begin
if Terminated then Break; //abort
fTaskText:='Task no '+i.ToString;
sleep(500);
if not Terminated then
Synchronize(@Showstatus);
end;
end;
end;
constructor TMyThread.Create(CreateSuspended: boolean);
begin
inherited Create(CreateSuspended);
end;
{ TForm1 }
procedure TForm1.btStartClick(Sender: TObject);
begin
btStart.Enabled:=False;
laStatus.Caption:='Started';
MyThread.Start;
btStop.Enabled:=True;
end;
procedure TForm1.btStopClick(Sender: TObject);
begin
btStop.Enabled:=False;
MyThread.Terminate;
MyThread.WaitFor;
laStatus.Caption:='Terminated';
btStart.Enabled:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
btStop.Enabled:=False;
MyThread := TMyThread.Create(true);
MyThread.FreeOnTerminate := False;
MyThread.OnShowStatus := @ShowStatus;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(MyThread) then begin
MyThread.Terminate;
MyThread.WaitFor;
end;
end;
procedure TForm1.ShowStatus(Status, Task: string);
begin
laStatus.Caption := Status;
laTask.Caption := Task;
end;
end.