// Es wird ein Kreis, der aus bunten Farbpunkten besteht, um einen Mittelpunkt
// mit einem angegebenen Radius gezeichnet. Dabei kann man eine immer
// wiederkehrende Farbfolge angeben, oder man kann die Farben zufällig
// generieren lassen.
// Siehe auch:
bunte Linien zeichnen

// Getestet mit D4 unter XP

procedure MultiColoredCircle(DC: HDC; Mittelpunkt: TPoint; Radius: Word; 
  clr: array of TColor); 
var 
  xx, ep, z, n: Integer; 
  f: TColor; 
  procedure farbe; 
  begin 
    if z > 0 then 
      f := clr[n] 
    else 
      f := random(1000000); 
  end; 
  procedure kreis(x1, y1, x2, y2: Integer); 
  begin 
    setpixel(dc, x1 + x2, y1 + y2, f); 
    setpixel(dc, x1 - x2, y1 + y2, f); 
    setpixel(dc, x1 + x2, y1 - y2, f); 
    setpixel(dc, x1 - x2, y1 - y2, f); 
    setpixel(dc, x1 + y2, y1 + x2, f); 
    setpixel(dc, x1 - y2, y1 + x2, f); 
    setpixel(dc, x1 + y2, y1 - x2, f); 
    setpixel(dc, x1 - y2, y1 - x2, f); 
    inc(n); 
    if n >= z then 
      n := 0; 
    farbe; 
  end; 
begin 
  z := length(clr); 
  n := 0; 
  farbe; 
  xx := 0; 
  ep := 3 - Radius shl 1; 
  while (xx < Radius) do 
  begin 
    kreis(Mittelpunkt.x, Mittelpunkt.y, xx, Radius); 
    if (ep < 0) then 
      ep := 6 + ep + xx shl 2 
    else 
    begin 
      ep := 10 + ep + (xx - Radius) shl 2; 
      dec(Radius); 
    end; 
    inc(xx); 
  end; 
  if (xx = Radius) then 
    kreis(Mittelpunkt.x, Mittelpunkt.y, xx, Radius); 
end; 
 
 
// bunter Kreis mit wiederkehrendem Muster 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  multicoloredcircle(canvas.handle, point(150, 100), 60, 
    [clred, clblack, clblue]); 
end; 
 
// bunter Kreis mit zufälliger Färbung 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  multicoloredcircle(canvas.handle, point(150, 100), 60, []); 
end; 



Zugriffe seit 6.9.2001 auf Delphi-Ecke