2009. szeptember 1., kedd
How to draw a circle pixel by pixel
Problem/Question/Abstract:
How to draw a circle pixel by pixel
Answer:
{ ... }
implementation
{$R *.DFM}
uses
Math;
procedure DrawCircle(CenterX, CenterY, Radius: Integer; Canvas: TCanvas; Color:
TColor);
procedure PlotCircle(x, y, x1, y1: Integer);
begin
Canvas.Pixels[x + x1, y + y1] := Color;
Canvas.Pixels[x - x1, y + y1] := Color;
Canvas.Pixels[x + x1, y - y1] := Color;
Canvas.Pixels[x - x1, y - y1] := Color;
Canvas.Pixels[x + y1, y + x1] := Color;
Canvas.Pixels[x - y1, y + x1] := Color;
Canvas.Pixels[x + y1, y - x1] := Color;
Canvas.Pixels[x - y1, y - x1] := Color;
end;
var
x, y, r: Integer;
x1, y1, p: Integer;
begin
x := CenterX;
y := CenterY;
r := Radius;
x1 := 0;
y1 := r;
p := 3 - 2 * r;
while (x1 < y1) do
begin
plotcircle(x, y, x1, y1);
if (p < 0) then
p := p + 4 * x1 + 6
else
begin
p := p + 4 * (x1 - y1) + 10;
y1 := y1 - 1;
end;
x1 := x1 + 1;
end;
if (x1 = y1) then
plotcircle(x, y, x1, y1);
end;
Used like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawCircle(ClientWidth div 2, ClientHeight div 2, Min(ClientWidth div 2,
ClientHeight div 2), Canvas, clBlack);
{Add Math to the uses clause for the Min function}
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése