type 
 
  Punkte = array[0..361] of TPoint; 
 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormPaint(Sender: TObject); 
  private 
    procedure MakeRegion(wP: Integer); 
    function GetPoint(P: TPoint; radius, winkel: Integer): TPoint; 
    procedure doit; 
    procedure loop; 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 

const
  Anzahl = 5;

var 
  oben: integer = 10; 
  links: integer = 10; 
  welchesBild: integer = 1; 
  pause: byte = 20; 
  Grad_Schritt: byte = 9; 
  Uhrzeigersinn: boolean = true; 
  Innenkreis: boolean = false; 
  bm: array[0..Anzahl - 1] of TBitmap; 
  wm, sm: integer; 
  Pkt: Punkte; 
 
procedure TForm1.loop; 
begin 
  inc(welchesBild); 
  if welchesBild = Anzahl then welchesBild := 0; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  inc(Grad_Schritt, ord(Grad_Schritt = 0)); 
  while frac(360 / Grad_Schritt) <> 0 do dec(Grad_Schritt); 
  for x := 0 to Anzahl - 1 do begin 
    bm[x] := TBitmap.create; 
    bm[x].loadfromfile('baum' + inttostr(x + 1) + '.bmp'); 
  end; 
  wm := links + bm[0].width div 2; 
  sm := oben + bm[0].height div 2; 
  Pkt[0] := Point(wm, sm); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  for x := 0 to Anzahl - 1 do bm[x].free; 
end; 
 
function TForm1.GetPoint(P: TPoint; radius, winkel: Integer): TPoint; 
begin 
  result.x := Round(P.x + radius * Cos(winkel * pi / 180)); 
  result.y := Round(P.y - radius * Sin(winkel * pi / 180)); 
end; 
 
procedure TForm1.MakeRegion(wP: Integer); 
var 
  Region: HRGN; 
begin 
  Region := CreatePolygonRGN(Pkt, wP, WINDING); 
  if Region <> 0 then begin 
    SelectClipRgn(Canvas.handle, Region); 
    Canvas.Draw(links, oben, bm[welchesBild]); 
    SelectClipRgn(Canvas.handle, 0); 
    DeleteObject(Region); 
  end; 
end; 
 
procedure TForm1.doit; 
var 
  radius, x: Integer; 
  zeit: cardinal; 
begin 
  radius := Round(Sqrt(Sqr(wm) 
    + Sqr(sm)) / (ord(Innenkreis) + 1) - 1); 
  for x := 0 to 360 do 
    Pkt[x + 1] := GetPoint(Pkt[0], radius, 
      x * (ord(not Uhrzeigersinn) * 2 - 1) + 90); 
  for x := 0 to 360 do 
    if x mod Grad_Schritt = 0 then 
    begin 
      zeit := gettickcount + pause; 
      while gettickcount < zeit do begin 
        Application.ProcessMessages; 
        if application.terminated then exit; 
      end; 
      MakeRegion(x + 2); 
    end; 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
var 
  i: integer; 
begin 
  if welchesBild = 0 then i := Anzahl - 1 else i := welchesBild - 1; 
  canvas.draw(links, oben, bm[i]); 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if Anzahl < 2 then 
    raise exception.create('Es müssen mindestens zwei Bilder vorhanden sein'); 
  Button1.enabled := false;
  doit; 
  loop; 
  Button1.enabled := true;
end;