unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type TSchleife=class(TThread)
constructor create(Memo:TMemo;speed:integer;
index:integer);
reintroduce;
protected
procedure execute;
override;
private
FMemo:TMemo;
FSpeed:integer;
FIndex:integer;
FsyncText:
string;
procedure syncVCL;
end;
type
TForm1 =
class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private-Deklarationen }
Schleifen:
array of TSchleife;
procedure StopSchleifen;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TSchleife.create(Memo:TMemo;speed:integer;
index:integer);
begin
freeonterminate:=true;
FMemo:=memo;
Fspeed:=speed;
FIndex:=index;
inherited create(false);
end;
procedure TSchleife.execute;
var wait:integer;
begin
while not terminated
do //die Schleife
begin
//Ausgabe eines Textes über synchronize
FsyncText:='
Thread '+inttostr(FIndex)+'
: Speed '+inttostr(FSpeed);
synchronize(syncVCL);
//Verzögerung
wait:=FSpeed;
while (
not terminated)
and(wait>0)
do
begin
sleep(10);
dec(wait);
end;
end;
end;
procedure TSchleife.syncVCL;
begin
Fmemo.Lines.Add(FSyncText);
end;
procedure TForm1.Button1Click(Sender: TObject);
var pos:integer;
begin
//starten einer neuen Schleife
pos:=length(Schleifen);
setlength(schleifen,pos+1);
Schleifen[pos]:=TSchleife.create(Memo1,random(100)+10,pos+1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//Alle Schleifen beenden
StopSchleifen;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
randseed:=5000;
end;
procedure TForm1.StopSchleifen;
var i:integer;
begin
for i:=0
to high(Schleifen)
do Schleifen[i].Terminate;
finalize(Schleifen);
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
stopSchleifen;
end;
end.