Thread Unit:
// VCL Thread Demo - Demo-Thread
// Michael Puff [http://www.michael-puff.de]
unit DemoThread;
interface
uses
Windows, Classes;
type
TDemoThread = class(TThread)
private
Counter: Integer;
procedure UpdateStaus;
procedure Finished;
procedure Abort;
protected
procedure Execute; override;
end;
implementation
uses
main;
procedure TDemoThread.Abort;
begin
frmMain.Abort;
end;
procedure TDemoThread.Execute;
var
i: Integer;
begin
Counter := 0;
for i := 0 to 9 do
begin
if Self.Terminated then
begin
Synchronize(Abort);
Exit;
end;
Counter := i;
Synchronize(UpdateStaus);
Sleep(500);
end;
Synchronize(Finished);
end;
procedure TDemoThread.Finished;
begin
frmMain.Finished;
end;
procedure TDemoThread.UpdateStaus;
begin
frmMain.UpdateStatus(Counter);
end;
end.
Formular Unit:
// VCL Thread Demo
// Michael Puff [http://www.michael-puff.de]
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DemoThread;
type
TfrmMain = class(TForm)
Label1: TLabel;
btnStart: TButton;
btnAbort: TButton;
procedure btnAbortClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
private
Thread: TDemoThread;
public
procedure UpdateStatus(Counter: Integer);
procedure Finished;
procedure Abort;
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.Abort;
begin
Label1.Caption := 'Abbruch durch Benutzer';
end;
procedure TfrmMain.btnAbortClick(Sender: TObject);
begin
Thread.Terminate;
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
Thread := TDemoThread.Create(True);
Thread.FreeOnTerminate := True;
Thread.Resume;
end;
procedure TfrmMain.Finished;
begin
Label1.Caption := 'Thread fertig';
end;
procedure TfrmMain.UpdateStatus(Counter: Integer);
begin
Label1.Caption := IntToStr(Counter);
end;
end.