// Es können Formen vom Dreieck bis hin zum 10-Eck, sowie schräge
// Ellipsen gezeichnet werden.


// Getestet mit D2010 unter Win7

Raute Dreieck Sechseck schräge Ellipse
Shape := 4;
xRadius := 50;
yRadius := 30;
Angle := 0;
Shape := 3;
xRadius := 40;
yRadius := 40;
Angle := 210;
Shape := 6;
xRadius := 40;
yRadius := 40;
Angle := 0;
Shape := 0;
xRadius := 20;
yRadius := 45;
Angle := -45;

 

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;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke