unit TorteFct;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

const
  Colors: array[0..10] of TColor = (clRed, clGreen, clBlue, clYellow,
                                     clMaroon, clTeal, clNavy, clOlive,
                                     clPurple, clLime, clFuchsia);

var
  Form1: TForm1;
  
  valuecount: Integer;
  values: array[0..9] of Integer;

implementation

{$R *.dfm}

function Min(a,b: Integer): LongInt;
begin
  if a<=b then result:=a else result:=b;
end;

function Max(a,b: Integer): LongInt;
begin
  if a>b then result:=a else result:=b;
end;

function GetArcPoint(cPoint: TPoint; radius, angle: Extended): TPoint;
begin
  result.x:=Round(cPoint.x + radius * Cos(angle * 2 * pi / 360));
  result.y:=Round(cPoint.y - radius * Sin(angle * 2 * pi / 360));
end;

function GetCentrePoint(oRect: TRect): TPoint;
begin
  result.x:=oRect.left + (oRect.right-oRect.left) div 2;
  result.y:=oRect.top + (oRect.bottom-oRect.top) div 2;
end;

//

procedure DrawTorte(drwCanvas: TCanvas; drwRect: TRect; drwvalues: array of Integer; drwvaluecount: Integer);
var cv, vv, za, va, co, drwradius, drwangle, drwanglesum, drwvaluesum: Integer;
    drwangles: array[0..9] of Integer; //max. 10 Werte
    MiddlePoint, copypoint: TPoint;
    CirclePoints: array[0..365] of TPoint;
    
begin
  drwvaluesum:=0; for cv:=0 to drwvaluecount-1 do drwvaluesum:=drwvaluesum+drwvalues[cv];

  drwCanvas.Brush.Color:=clWhite;
  drwCanvas.FillRect(drwRect);

  drwCanvas.Pen.Color:=clBlack;

  drwradius:=(Min(Abs(drwRect.right-drwRect.left), Abs(drwRect.bottom-drwRect.top))-40) div 2;

  MiddlePoint:=GetCentrePoint(drwRect);

  //Werte in Winkel konv.
  for cv:=0 to drwvaluecount-1 do
     drwangles[cv]:=Round(drwvalues[cv]*360/drwvaluesum);

  //Tortenrand ausgeben
  za:=0; drwanglesum:=drwangles[0]; va:=1; co:=0;

  for drwangle:=0 to 360 do
  begin
     if drwangle<180 then
     begin
      if drwangle=drwanglesum then begin inc(co); drwanglesum:=drwanglesum+drwangles[va]; inc(va); end;
      Continue;
     end;

     CirclePoints[za]:=GetArcPoint(MiddlePoint, drwradius, drwangle);
     CirclePoints[za].y:=MiddlePoint.y-(MiddlePoint.y-CirclePoints[za].y) div 2 + drwradius div 5; //Tortenhoehe 20% des drwradius

     if (drwangle=drwanglesum) or (drwangle=360) then
     begin
        drwCanvas.Brush.Color:=Colors[co]; inc(co);

        copypoint:=CirclePoints[za];
        CirclePoints[za+1].x:=CirclePoints[za].x;
        CirclePoints[za+1].y:=MiddlePoint.y;
        CirclePoints[za+2].x:=CirclePoints[0].x;
        CirclePoints[za+2].y:=MiddlePoint.y;
        Polygon(drwCanvas.Handle, CirclePoints[0], za+3);
        CirclePoints[0]:=copypoint;

        drwanglesum:=drwanglesum+drwangles[va]; inc(va);

        za:=1;
        Continue;
     end;

     inc(za);
  end;

  //obere Tortenfläche ausgeben
  za:=0; drwanglesum:=drwangles[0]; va:=1; co:=0;

  for drwangle:=0 to 360 do
  begin
     CirclePoints[za]:=GetArcPoint(MiddlePoint, drwradius, drwangle);
     CirclePoints[za].y:=MiddlePoint.y-(MiddlePoint.y-CirclePoints[za].y) div 2;

     if (drwangle=drwanglesum) or (drwangle=360) then
     begin
        drwCanvas.Brush.Color:=Colors[co]; inc(co);

        copypoint:=CirclePoints[za];
        CirclePoints[za+1]:=MiddlePoint;
        Polygon(drwCanvas.Handle, CirclePoints[0], za+2);
        CirclePoints[0]:=copypoint;

        drwanglesum:=drwanglesum+drwangles[va]; inc(va);

        za:=1;
        Continue;
     end;

     inc(za);
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  values[0]:=15;
  values[1]:=25;
  values[2]:=20;
  values[3]:=15;
  values[4]:=15;
  valuecount:=5;

  DrawTorte(Canvas, ClientRect, values, valuecount);
end;

end.

Zurück