[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