Trotz Threads keine Reaktion

[Green]

Ich habe folgendes Beispiel aus einem Buch nachgeschrieben um Threads zu verstehen, doch es funktioniert meiner Meinung nach nicht richtig.

Wenn ich es starte dann zeichnet er zwar wie blöd drauflos, was ja gewollt ist, aber weder erscheinen die anderen Komponenten auf dem Bildschirm noch reagiert das Programm auf irgendwelche Befehle (Sanduhr...)

Ich habe es Buchstabe für Buchstabe abgetippt und bin mir sicher das es stimmt...

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, thread2;

type
  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Th1: TLineThread;
  Th2: TRectThread;
  Th3: TCircThread;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Th1 := TLineThread.Create(PaintBox1, tpNormal);
  Th2 := TRectThread.Create(PaintBox2, tpNormal);
  Th3 := TCircThread.Create(PaintBox3, tpNormal);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
var
  tH: TThread;
begin
  if Sender is TTrackBar then
    with TTrackBar(Sender) do begin
      case Tag of
        1: Th := Th1;
        2: Th := Th2;
        3: Th := Th3;
      end;
      case Position of
        1: Th.Priority := tpIdle;
        2: Th.Priority := tpLowest;
        3: Th.Priority := tpLower;
        4: Th.Priority := tpNormal;
        5: Th.Priority := tpHigher;
        6: Th.Priority := tpHighest;
        7: Th.Priority := tpTimeCritical;
      end;
    end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  Th: TThread;
begin
  if Sender is TCheckBox then
    with TCheckBox(Sender) do begin
      case Tag of
        1: Th := Th1;
        2: Th := Th2;
        3: Th := Th3;
      end;
      if Th.Suspended then Th.Resume else Th.Suspend;
    end;
end;

end.

Delphi-Quellcode:

unit thread2;

interface

uses Classes, ExtCtrls, Windows;

type
  TPaintThread = class(TThread)
  private
    fX1, fX2, fY1, fY2, fColor: Integer;
    fBox: TPaintBox;
  protected
    procedure Execute; override;
    procedure Paint(x1, y1, x2, y2, Color: Integer);
    procedure DoPaint; virtual; abstract;
  public
    constructor Create(Box: TPaintBox; ThreadPriority: TThreadPriority);
  end;

  TLineThread = class(TPaintThread)
  protected
    procedure DoPaint; override;
  end;

  TRectThread = class(TPaintThread)
  protected
    procedure DoPaint; override;
  end;

  TCircThread = class(TPaintThread)
  protected
    procedure DoPaint; override;
  end;

implementation

uses Graphics;

constructor TPaintThread.Create(Box: TPaintBox; ThreadPriority: TThreadPriority);
begin
  inherited Create(false);
  Priority := ThreadPriority;
  fColor := 0;
  fBox := Box;
  fX1 := 0;
  fX2 := 0;
  fY1 := 0;
  fY2 := 0;
end;

procedure TPaintThread.Execute;
begin
  randomize;
  while true do
    Paint(Random(200), Random(200), Random(200), Random(200), Random($FFFF));
end;

procedure TPaintThread.Paint(x1, y1, x2, y2, Color: Integer);
begin
  fX1 := x1;
  fX2 := x2;
  fY1 := y1;
  fY2 := y2;
  fColor := Color;
  Synchronize(DoPaint);
end;

procedure TLineThread.DoPaint;
begin
  with fBox.Canvas do
  begin
    Pen.Color := fColor;
    MoveTo(fX1, fY1);
    LineTo(fX2, fY2);
  end;
end;

procedure TRectThread.DoPaint;
begin
  with fBox.Canvas do
  begin
    Brush.Style := bsClear;
    Pen.Color := fColor;
    Rectangle(fX1, fY1, fX2, fY2);
  end;
end;

procedure TCircThread.DoPaint;
begin
  with fBox.Canvas do
  begin
    Brush.Style := bsClear;
    Pen.Color := fColor;
    Ellipse(fX1, fY1, fX2, fY2);
  end;
end;

end.

Bin mittlerweile am verzweifeln!! was ist falsch daran??