unit Unit1; 
 
interface 
 
uses Windows, Classes, Graphics, Controls, Forms, StdCtrls, Dialogs; 
 
type 
  durchmesser = 15..120; 
  anzahl = 5..20; 
  pc = ^TColor; 
 
  TMyThread = class(TThread) 
  private 
    { Private-Deklarationen } 
  protected 
    procedure Execute; override; 
    procedure build; 
  end; 
 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    function go(x, y: integer; von, bis: TColor; offs: shortint): boolean; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  kd, fase, mx, my, zm: integer; 
  gestartet: boolean = false; 
  p18, rd, winkel: single; 
  arr: array of TColor; 
  MyThread: TMyThread; 
  durchm: durchmesser; 
  lauf: integer = 0; 
  cnv: TCanvas; 
  zahl: anzahl; 
  pause: word; 
  c: TColor; 
  rand: pc; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  MyThread := TMyThread.create(true); 
  MyThread.FreeOnTerminate := true; 
  MyThread.Priority := tpLower; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  MyThread.Terminate; 
  setlength(arr, 0); 
end; 
 
procedure TMyThread.build; 
var 
  l, o: integer; 
  krs, pk: single; 
begin 
  krs := 360; 
  fase := zm - lauf; 
  inc(lauf); 
  if lauf = zahl then lauf := 0; 
  while krs >= winkel do begin 
    application.processmessages; 
    if application.terminated or suspended then break; 
    if fase < 0 then fase := zm; 
    cnv.brush.color := arr[fase]; 
    if rand <> nil then 
      cnv.pen.color := rand^ else 
      cnv.pen.color := arr[fase]; 
    pk := p18 * krs; 
    l := round(cos(pk) * rd + mx); 
    o := round(sin(pk) * rd + my); 
    cnv.lock; 
    cnv.ellipse(l, o, l + kd, o + kd); 
    cnv.unlock; 
    dec(fase); 
    krs := krs - winkel; 
  end; 
end; 
 
procedure TMyThread.Execute; 
begin 
  repeat 
    build; 
    sleep(pause); 
  until terminated; 
end; 
 
function TForm1.go(x, y: integer; von, bis: TColor; offs: shortint): boolean; 
var 
  i: integer; 
  diff: TColor; 
  rv, gv, bv, rb, gb, bb: byte; 
  function rech(b1, b2: byte): byte; 
  var 
    d: integer; 
  begin 
    d := trunc((b1 - b2) / zm); 
    if d < 0 then inc(d, 255); 
    result := d; 
  end; 
begin 
  cnv.pen.style := psSolid; 
  cnv.brush.style := bsSolid; 
  zm := pred(zahl); 
  winkel := 360 / zahl; 
  setlength(arr, zahl); 
  von := colorToRGB(von); 
  bis := colorToRGB(bis); 
  rv := getRvalue(von); 
  gv := getGvalue(von); 
  bv := getBvalue(von); 
  rb := getRvalue(bis); 
  gb := getGvalue(bis); 
  bb := getBvalue(bis); 
  diff := rgb(rech(rb, rv), rech(gb, gv), rech(bb, bv)); 
  arr[zm] := von; 
  for i := zm - 1 downto 1 do 
    arr[i] := (arr[i + 1] + diff) and $FFFFFF; 
  arr[0] := bis; 
  mx := x + durchm div 2; 
  my := y + durchm div 2; 
  kd := trunc(durchm * pi / zahl) + offs; 
  if kd < 4 then begin 
    result := true; 
    kd := 4; 
    durchm := round(kd * zahl / pi); 
  end else 
    result := false; 
  rd := -durchm / 2; 
  p18 := pi / 180; 
  MyThread.Resume; 
end; 
 
// --- Beispielaufruf --- 
 
// starten 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if gestartet then exit; 
  gestartet := true; 
  rand := nil; 
//  c := clWhite; 
//  rand := @c; 
  cnv := Canvas; 
  pause := 100; 
  durchm := 18; 
  zahl := 10; 
  if go(50, 20, clBlue, clBtnFace, -1) then 
    showmessage('Durchmesser musste korrigiert werden'); 
end; 
 
// stoppen 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if MyThread.Suspended then exit; 
  MyThread.Suspend; 
  repeat 
    application.processmessages; 
  until MyThread.Suspended; 
  refresh; 
  gestartet := false; 
end; 
 
end.