uses Vcl.Imaging.PngImage, UITypes; 
 
type 
  ao8i = array [0 .. 7] of Integer; 
 
const 
  Hell = $80FFFF; 
  Dunkel = $00B0B0; 
 
var 
  Rct: TRect; 
  IMG: TImage; 
  BMP: TBitmap; 
  PNG: TPngImage; 
  Durchmesser: Integer = 175; 
  UhrZeigerSinn: Boolean = True; 
  L, O, Links, Oben, Winkel, Start, Step: Integer; 
  Tabelle: ao8i = (10, 12, 18, 20, 30, 36, 60, 90); 
 
procedure DrawPie(Cnv: TCanvas; R: TRect; StartAngle, EndAngle: Integer); 
var 
  MX, MY, SA, EA, RD, P2: Single; 
  SX, SY, EX, EY: Integer; 
begin 
  RD := (R.Right - R.Left) / 2; 
  P2 := PI / 180; 
  MX := R.Left + RD; 
  MY := R.Top + RD; 
  SA := StartAngle * P2; 
  EA := EndAngle * P2; 
  SX := Round(MX + sin(SA) * RD); 
  SY := Round(MY - cos(SA) * RD); 
  EX := Round(MX + sin(EA) * RD); 
  EY := Round(MY - cos(EA) * RD); 
  Pie(Cnv.Handle, R.Left, R.Top, R.Right, R.Bottom, EX, EY, SX, SY); 
end; 
 
procedure Zeichnen; 
var 
  I: Integer; 
begin 
  I := 0; 
  while I < 360 do 
  begin 
    DrawPie(PNG.Canvas, Rct, Start + I, Start + I + Winkel); 
    inc(I, Winkel); 
    if PNG.Canvas.Brush.Color = Dunkel then 
      PNG.Canvas.Brush.Color := Hell 
    else 
      PNG.Canvas.Brush.Color := Dunkel; 
  end; 
end; 
 
function Weiter: Integer; 
begin 
  Result := ord(UhrZeigerSinn) * 4 - 2; 
end; 
 
procedure Vorbereitung; 
var 
  X, Y: Integer; 
  slf, sla: PByteArray; 
begin 
  Start := 0; 
  Winkel := Tabelle[4]; 
  BMP.Canvas.Brush.Color := clBlack; 
  BMP.Canvas.Pen.Style := psClear; 
  BMP.Canvas.Brush.Color := Hell; 
  if Durchmesser > BMP.Width then 
    Durchmesser := BMP.Width; 
  if Durchmesser > BMP.Height then 
    Durchmesser := BMP.Height; 
  PNG := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, Durchmesser, Durchmesser); 
  PNG.CreateAlpha; 
  Rct := Rect(0, 0, PNG.Width, PNG.Height); 
  With PNG.Canvas do 
  begin 
    Brush.Color := Hell; 
    Pen.Style := psClear; 
  end; 
  Zeichnen; 
  for Y := 0 to pred(PNG.Height) do 
  begin 
    sla := PNG.AlphaScanline[Y]; 
    slf := PNG.SCanline[Y]; 
    for X := 0 to pred(PNG.Width) do 
      if (slf^[X * 3] <> 0) or (slf^[X * 3 + 1] <> 0) or (slf^[X * 3 + 2] <> 0) 
      then 
        sla^[X] := 90; 
  end; 
  L := (BMP.Width - Durchmesser) div 2; 
  O := (BMP.Height - Durchmesser) div 2; 
  Step := Weiter; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  DoubleBuffered := True; 
  IMG := TImage.Create(Self); 
  BMP := TBitmap.Create; 
  BMP.LoadFromFile('D:\Bilder\DT.bmp'); // z.B. 
  Links := 100; 
  Oben := 50; 
  With IMG do 
  begin 
    Parent := Self; 
    Autosize := True; 
    Picture.Bitmap.Assign(BMP); 
    Left := Links; 
    Top := Oben; 
    Left := Links; 
    Top := Oben; 
  end; 
  Timer1.Enabled := False; 
  Timer1.Interval := 33; 
  Vorbereitung; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(IMG); 
  FreeAndNil(BMP); 
  FreeAndNil(PNG); 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  IMG.Picture.Bitmap.Canvas.draw(0, 0, BMP); 
  inc(Start, Step); 
  if abs(Start) = Winkel * 2 then 
    Start := 0; 
  Zeichnen; 
  IMG.Canvas.draw(L, O, PNG); 
end; 
 
 
 
// Beispielaufrufe 
 
// Start / Stopp 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if Timer1.Enabled then 
  begin 
    Timer1.Enabled := False; 
    IMG.Picture.Bitmap.Canvas.draw(0, 0, BMP); 
  end 
  else 
    Timer1.Enabled := True; 
end; 
 
// Drehrichtung 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  UhrZeigerSinn := not UhrZeigerSinn; 
  Step := Weiter; 
end;