[fpc-pascal]Easy graphics<

Michael Van Canneyt michael.vancanneyt at wisa.be
Fri Apr 23 09:22:43 CEST 2004


On Thu, 22 Apr 2004, Alan Mead wrote:

> Michael Van Canneyt <michael.vancanneyt at wisa.be> wrote:
>
> > Yes. You need at least 1.9.2.
> > The best would even be to download the latest CVS, as it supports
> > more formats.
> > Or you can try to download the FCL sources and recompile them with
> > FPC 1.0.10.
>
> I appreciate your help with this.  I installed 1.9.2 on my other
> machine and I see most of the units (the writejpg is not found)...
> you indicated that your code was only a rough sketch but I cannot get
> it to compile:

Here is some code from an existing CGI project:

{$mode objfpc}
{$h+}
unit utests;

interface

uses db,Classes,ftFont,fpimage,fpimgcanv,fpWritePng,fpcanvas;

Procedure TTestSuite.CreateRunPie;

Var
  I : TFPMemoryImage;
  M : TMemoryStream;

begin
  ftFont.InitEngine;
  FontMgr.SearchPath:='/usr/lib/X11/fonts/truetype';
  I:=TFPMemoryImage.Create(320,320);
  try
    If FRunCount=0 Then
      Raise Exception.Create('Invalid parameters passed to script: No total count');
    DoDrawPie(I,FRunSkipCount,FRunFailedCount,FRunCount);
    M:=TMemoryStream.Create;
    Try
      With TFPWriterPNG.Create do
        try
          UseAlpha:=True;
          ImageWrite(M,I);
        Finally
          Free;
        end;
      ContentType:='image/png';
      EmitContentType;
      M.Position:=0;
      Response.CopyFrom(M,M.Size);
    Finally
      M.Free;
    end;
  Finally
    I.Free;
  end;
end;

Procedure TTestSuite.DoDrawPie(Img : TFPCustomImage; Skipped,Failed,Total : Integer);

Var
  Cnv : TFPImageCanvas;
  W,H,FH,CR,ra : Integer;
  A1,A2,FR,SR,PR : Double;
  R : TRect;
  F : TFreeTypeFont;

  Procedure AddPie(X,Y,R : Integer; AStart,AStop : Double; Col : TFPColor);

  Var
    DX,Dy : Integer;

  begin
    DX:=Round(R*Cos(A1));
    DY:=Round(R*Sin(A1));
    Cnv.Line(X,Y,X+DX,Y-DY);
    DX:=Round(Ra*Cos(A2));
    DY:=Round(Ra*Sin(A2));
    Cnv.Line(X,Y,X+DX,Y-Dy);
    DX:=Round(R/2*Cos((A1+A2)/2));
    DY:=Round(R/2*Sin((A1+A2)/2));
    Cnv.Brush.Color:=Col;
    Cnv.FloodFill(X+DX,Y-DY);
  end;

  Function FractionAngle(F,T : Integer): Double;

  begin
    Result:=(2*Pi*(F/T))
  end;



begin
  F:=TFreeTypeFont.Create;
  With F do
    begin
    Name:='arial';
    FontIndex:=0;
    Size:=12;
    Color:=colred;
    AntiAliased:=False;
    Resolution:=96;
    end;
  Cnv:=TFPImageCanvas.Create(Img);
  W:=Img.Width;
  H:=Img.Height;
  cnv.Brush.Style:=bsSolid;
  cnv.Brush.Color:=colTransparent;
  cnv.Pen.Color:=colWhite;
  Cnv.Rectangle(0,0,W,H);
  Cnv.Font:=F;
  FH:=CNV.GetTextHeight('A');
  If FH=0 then
    FH:=14; // 3 * 14;
  Inc(FH,3);
  R.Top:=FH*4;
  R.Left:=0;
  R.Bottom:=H;
  CR:=H-(FH*4);
  If W>CR then
    R.Right:=CR
  else
    R.Right:=W;
  Ra:=CR div 2;
  Cnv.Pen.Color:=colBlack;
  cnv.brush.color:=colRed;
  Cnv.Ellipse(R);
  cnv.font.Color:=colred;
  Inc(FH,4);
  FR:=Failed/Total;
  SR:=Skipped/Total;
  PR:=1-(FR+SR);
  Cnv.Textout(1,FH,Format('%d Failed (%3.1f%%)',[Failed,Fr*100]));
  cnv.font.Color:=colYellow;
  Cnv.Textout(1,FH*2,Format('%d Skipped (%3.1f%%)',[Skipped,SR*100]));
  A1:=(Pi*2*(failed/total));
  A2:=A1+(Pi*2*(Skipped/Total));
  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColYellow);
  cnv.font.Color:=colGreen;
  A1:=A2;
  A2:=A1+(Pi*2*((Total-(Skipped+Failed))/Total));
  Cnv.Textout(1,FH*3,Format('%d Passed (%3.1f%%',[Total-Skipped-Failed,PR*100]));
  AddPie(Ra,R.Top+Ra,Ra,A1,A2,ColGreen);
end;


end.




More information about the fpc-pascal mailing list