function DrawShapes(cnv: TCanvas; xCenter, yCenter: integer;
xRadius, yRadius, RotateAngle: single; Shape: byte;
Fill: Boolean = False): byte;
const
PNumbers: set of byte = [3 .. 10];
var
onset, ending, rotation, step, p2: single;
newx, newy: integer;
Procedure newpos(Angle: single; Out newx, newy: integer);
Var
x, y, th: single;
begin
th := Angle * p2;
x := xRadius * cos(-th);
y := yRadius * sin(-th);
newx := Round(xCenter + x * cos(-rotation) - y * sin(-rotation));
newy := Round(yCenter + x * sin(-rotation) + y * cos(-rotation));
End;
begin
if xRadius < 3 then
begin
result := 1;
exit;
end;
if yRadius < 3 then
begin
result := 2;
exit;
end;
if not(Shape in PNumbers) then
Shape := 50
else
begin
if xRadius <= Shape then
begin
result := 1;
exit;
end;
if yRadius <= Shape then
begin
result := 2;
exit;
end;
end;
try
p2 := Pi / 180;
onset := 0;
ending := 360;
rotation := RotateAngle * p2;
step := ending / Shape;
newpos(onset, newx, newy);
cnv.MoveTo(newx, newy);
onset := onset + step;
while onset < ending Do
begin
newpos(onset, newx, newy);
cnv.LineTo(newx, newy);
onset := onset + step;
end;
newpos(ending, newx, newy);
cnv.LineTo(newx, newy);
if Fill then
begin
cnv.Brush.color := cnv.pen.color;
cnv.FloodFill(xCenter, yCenter, cnv.pen.color, fsBorder);
end;
result := 0;
except
result := 255;
end;
end;
// Beispiel 1
procedure TForm2.Button1Click(Sender: TObject);
var
b, Shape: Byte;
s: string;
xRadius, yRadius, Angle: Single;
xCenter, yCenter: Integer;
begin
Shape := 0;
xRadius := 20;
yRadius := 45;
Angle := -45;
xCenter := 100;
yCenter := 100;
b := DrawShapes(canvas, xCenter, yCenter, xRadius, yRadius, Angle, Shape);
case b of
0:
s := '';
1:
s := 'Angegebene Breite zu Klein für die gefordete Darstellung';
2:
s := 'Angegebene Höhe zu Klein für die gefordete Darstellung';
else
s := 'Unerwarteter Fehler';
end;
if s <> '' then
showmessage(s);
end;
// Beispiel 2 (gefüllte Ellipse)
procedure TForm2.Button2Click(Sender: TObject);
begin
canvas.Brush.Color := clred;
DrawShapes(canvas, 100, 100, 20, 40, 45, 0, True);
end;