Kontinuierlich Schleife

[sirius]

mit Threads

Delphi-Quellcode:

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.