// Hiermit kann das kreisförmige Wartesymbol von Windows 7
// nachgebildet werden. Dazu laden sie bitte die Datei
// "kreis.zip" herunter, entpacken diese und stellen
// "kreis.fsn" in den Projekt-Pfad.
// Mittels der Variante "Border" in der Prozedur "LoadRing"
// kann der äußere Rand des Kreises bei Bedarf farblich
// an den Untergrund angepasst werden. Das geschieht
// automatisch, wenn "mix" den Wert "True" hat.



// Getestet mit D2010 unter Win7

type 
  PColor = ^TColor; 
 
  TForm2 = class(TForm) 
    Button1: TButton; 
    Timer1: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure LoadRing(Border: PColor; mix: boolean); 
  end; 
 
var 
  Form2: TForm2; 
 
implementation 
 
{$R *.dfm} 
 
const 
  mass = 32; 
 
var 
  cnv: TCanvas; 
  brshclr: TColor; 
  fs: TFilestream; 
  zr: array of TBitmap; 
  x, y, fase, step: integer; 
 
procedure TForm2.LoadRing(Border: PColor; mix: boolean); 
var 
  i: integer; 
  c: TColor; 
  function NewColor: TColor; 
  var 
    F: TColor; 
    r1, g1, b1, r2, g2, b2: Byte; 
  begin 
    F := ColorToRGB(c); 
    r1 := GetRValue(F); 
    g1 := GetGValue(F); 
    b1 := GetBValue(F); 
    r2 := (64 + r1) div 2; 
    g2 := (128 + g1) div 2; 
    b2 := (128 + b1) div 2; 
    result := RGB(r2, g2, b2); 
  end; 
 
begin 
  fs := TFilestream.create('kreis.fsn', fmopenread); 
  fs.readBuffer(fase, 4); 
  setlength(zr, fase + 1); 
  for i := 0 to fase do 
  begin 
    zr[i] := TBitmap.create; 
    zr[i].LoadFromStream(fs); 
    zr[i].Transparent := true; 
    if Border <> nil then 
    begin 
      c := Border^; 
      if mix then 
        c := NewColor; 
      if c = 1 then 
        dec(c); 
      with zr[i], canvas do 
      begin 
        brush.Style := bsclear; 
        pen.width := 1; 
        pen.Color := c; 
        ellipse(3, 3, width - 4, height - 4); 
        ellipse(8, 8, width - 9, height - 9); 
      end; 
    end; 
  end; 
end; 
 
procedure TForm2.FormCreate(Sender: TObject); 
var 
  c: TColor; 
begin 
  Timer1.Enabled := false; 
  Timer1.Interval := 33; 
  step := 0; 
  cnv := canvas; // z.B. 
  brshclr := cnv.brush.Color; 
 
  c := Color; 
  LoadRing(@c); 
  // --- oder auch: ---
  // LoadRing(nil, false);
  // ------------------
end; 
 
procedure TForm2.FormDestroy(Sender: TObject); 
var 
  i: integer; 
begin 
  for i := 0 to fase do 
    zr[i].free; 
  fs.free; 
end; 
 
procedure TForm2.Timer1Timer(Sender: TObject); 
begin 
  cnv.Draw(x, y, zr[step]); 
  inc(step); 
  if step > fase then 
    step := 0; 
end; 
 
 
 
// Beispielaufruf 
 
procedure TForm2.Button1Click(Sender: TObject); 
begin 
  x := 10; 
  y := 10; 
  if Timer1.Enabled then // stoppen 
  begin 
    Timer1.Enabled := false; 
    with cnv do 
    begin 
      brush.Color := brshclr; 
      fillrect(rect(x, y, x + mass, y + mass)); 
    end; 
  end 
  else 
    Timer1.Enabled := true; // starten 
end;