Code:
procedure DrawPixel(x, y: longint; color: TColor);
begin
form1.Canvas.Pixels[x, y]:=color;
end;
procedure DrawLine(x1, x2, y: longint; color: TColor);
var x: integer;
begin
for x:=x1 to x2 do
form1.Canvas.Pixels[x, y]:=color;
end;
procedure retro_circle(xc, yc, r: longint; color: TColor);
var x, y, d: longint;
begin
x:=0; y:=r;
d:=1 - r;
while x < y do begin
if d < 0 then
d:=d + 2*x + 3
else begin
d:=d + 2*x - 2*y + 5;
dec(y);
end;
DrawPixel(xc + x, yc - y, color); // Top
DrawPixel(xc - x, yc - y, color);
DrawPixel(xc + y, yc - x, color); // Upper middle
DrawPixel(xc - y, yc - x, color);
DrawPixel(xc + y, yc + x, color); // Lower middle
DrawPixel(xc - y, yc + x, color);
DrawPixel(xc + x, yc + y, color); // Bottom
DrawPixel(xc - x, yc + y, color);
inc(x);
end;
end;
procedure retro_fill_circle(xc, yc, r: longint; color: TColor);
var x, y, d: longint;
begin
x:=0; y:=r;
d:=1 - r;
while x < y do begin
if d < 0 then
d:=d + 2*x + 3
else begin
d:=d + 2*x - 2*y + 5;
dec(y);
end;
DrawLine(xc - x, xc + x, yc - y, color);
DrawLine(xc - y, xc + y, yc - x, color);
DrawLine(xc - y, xc + y, yc + x, color);
DrawLine(xc - x, xc + x, yc + y, color);
inc(x);
end;
end;
Also as far as i see, the fill function may draw some pixels overlapped. Not perfectly optimal this way.
Bookmarks