123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874 |
- { This program generates a multi-page PDF document and tests various
- functionality on each of the pages.
- You can also specify to generate single pages by using the -p <n>
- command line parameter.
- eg: testfppdf -p 1
- testfppdf -p 2
- Use -h to see more command line parameter options.
- }
- program testfppdf;
- {$mode objfpc}{$H+}
- {$codepage utf8}
- uses
- {$ifdef unix}cwstring,{$endif} // required for UnicodeString handling.
- classes,
- sysutils,
- custapp,
- fpimage,
- fpreadjpeg,
- fppdf,
- fpparsettf,
- fpttf,
- typinfo;
- type
- TPDFTestApp = class(TCustomApplication)
- private
- FPage: integer;
- FRawJPEG,
- FImageCompression,
- FTextCompression,
- FFontCompression: boolean;
- FNoFontEmbedding: boolean;
- FDoc: TPDFDocument;
- function SetUpDocument: TPDFDocument;
- procedure SaveDocument(D: TPDFDocument);
- procedure EmptyPage;
- procedure SimpleText(D: TPDFDocument; APage: integer);
- procedure SimpleLinesRaw(D: TPDFDocument; APage: integer);
- procedure SimpleLines(D: TPDFDocument; APage: integer);
- procedure SimpleImage(D: TPDFDocument; APage: integer);
- procedure SimpleShapes(D: TPDFDocument; APage: integer);
- procedure AdvancedShapes(D: TPDFDocument; APage: integer);
- procedure SampleMatrixTransform(D: TPDFDocument; APage: integer);
- procedure SampleLandscape(D: TPDFDocument; APage: integer);
- procedure TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer; const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
- protected
- procedure DoRun; override;
- public
- procedure WriteHelp;
- end;
- var
- Application: TPDFTestApp;
- const
- cPageCount: integer = 8;
- function TPDFTestApp.SetUpDocument: TPDFDocument;
- var
- P: TPDFPage;
- S: TPDFSection;
- i: integer;
- lPageCount: integer;
- lOpts: TPDFOptions;
- begin
- Result := TPDFDocument.Create(Nil);
- Result.Infos.Title := Application.Title;
- Result.Infos.Author := 'Graeme Geldenhuys';
- Result.Infos.Producer := 'fpGUI Toolkit 1.4.1';
- Result.Infos.ApplicationName := ApplicationName;
- Result.Infos.CreationDate := Now;
- lOpts := [poPageOriginAtTop];
- if FNoFontEmbedding then
- Include(lOpts, poNoEmbeddedFonts);
- if FFontCompression then
- Include(lOpts, poCompressFonts);
- if FTextCompression then
- Include(lOpts,poCompressText);
- if FImageCompression then
- Include(lOpts,poCompressImages);
- if FRawJPEG then
- Include(lOpts,poUseRawJPEG);
- Result.Options := lOpts;
- Result.StartDocument;
- S := Result.Sections.AddSection; // we always need at least one section
- lPageCount := cPageCount;
- if FPage <> -1 then
- lPageCount := 1;
- for i := 1 to lPageCount do
- begin
- P := Result.Pages.AddPage;
- P.PaperType := ptA4;
- P.UnitOfMeasure := uomMillimeters;
- S.AddPage(P); // Add the Page to the Section
- end;
- end;
- procedure TPDFTestApp.SaveDocument(D : TPDFDocument);
- var
- F: TFileStream;
- begin
- F := TFileStream.Create('test.pdf',fmCreate);
- try
- D.SaveToStream(F);
- Writeln('Document used ',D.ObjectCount,' PDF objects/commands');
- finally
- F.Free;
- end;
- end;
- procedure TPDFTestApp.EmptyPage;
- var
- D: TPDFDocument;
- begin
- D := SetupDocument;
- try
- SaveDocument(D);
- finally
- D.Free;
- end;
- end;
- { all units of measure are in millimeters }
- procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
- var
- P : TPDFPage;
- FtTitle, FtText1, FtText2, FtText3: integer;
- begin
- P := D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
- FtText2 := D.AddFont('Times-BoldItalic');
- // FtText3 := D.AddFont('arial.ttf', 'Arial');
- FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
- { Page title }
- P.SetFont(FtTitle, 23);
- P.SetColor(clBlack, false);
- P.WriteText(25, 20, 'Sample Text');
- // -----------------------------------
- // Write text using PDF standard fonts
- P.SetFont(FtTitle, 12);
- P.SetColor(clBlue, false);
- P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
- P.SetColor(clBlack, false);
- P.WriteText(25, 57, 'Click the URL: http://www.freepascal.org');
- P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
- // rotated text
- P.SetColor(clBlue, false);
- P.WriteText(25, 100, 'Rotated text at 30 degrees', 30);
- P.SetFont(ftText2,16);
- P.SetColor($C00000, false);
- P.WriteText(50, 100, '(50mm,100mm) Times-BoldItalic: Big text at absolute position');
- // -----------------------------------
- // TrueType testing purposes
- P.SetFont(ftText3, 13);
- P.SetColor(clBlack, false);
- P.WriteText(15, 120, 'Languages: English: Hello, World!');
- P.WriteText(40, 130, 'Greek: Γειά σου κόσμος');
- P.WriteText(40, 140, 'Polish: Witaj świecie');
- P.WriteText(40, 150, 'Portuguese: Olá mundo');
- P.WriteText(40, 160, 'Russian: Здравствуйте мир');
- P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
- P.SetFont(ftText1, 13);
- P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
- P.WriteText(15, 200, 'Typography: “What’s wrong?”');
- P.WriteText(40, 210, '£17.99 vs £17·99');
- P.WriteText(40, 220, '€17.99 vs €17·99');
- P.WriteText(40, 230, 'OK then… (êçèûÎÐð£¢ß) \\//{}()#<>');
- P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
- { draw a rectangle around the text }
- TextInABox(P, 25, 255, 23, clRed, 'FreeSans', '“Text in a Box gyj?”');
- { lets make a hyperlink more prominent }
- TextInABox(P, 100, 255, 12, clMagenta, 'FreeSans', 'http://www.freepascal.org');
- P.AddExternalLink(99, 255, 49, 5, 'http://www.freepascal.org', false);
- end;
- procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- lPt1, lPt2: TPDFCoord;
- begin
- P:=D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack, False);
- P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
- P.SetColor(clBlack, True);
- P.SetPenStyle(ppsSolid);
- lPt1.X := 30; lPt1.Y := 100;
- lPt2.X := 150; lPt2.Y := 150;
- P.DrawLine(lPt1, lPt2, 0.2);
- P.SetColor(clBlue, True);
- P.SetPenStyle(ppsDash);
- lPt1.X := 50; lPt1.Y := 70;
- lPt2.X := 180; lPt2.Y := 100;
- P.DrawLine(lPt1, lPt2, 0.1);
- { we can also use coordinates directly, without TPDFCoord variables }
- P.SetColor(clRed, True);
- P.SetPenStyle(ppsDashDot);
- P.DrawLine(40, 140, 160, 80, 1);
- P.SetColor(clBlack, True);
- P.SetPenStyle(ppsDashDotDot);
- P.DrawLine(60, 50, 60, 120, 1.5);
- P.SetColor(clBlack, True);
- P.SetPenStyle(ppsDot);
- P.DrawLine(10, 80, 130, 130, 0.5);
- end;
- procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- TsThinBlack, TsThinBlue, TsThick, TsThinRed, TsThinBlackDot: Integer;
- lPt1, lPt2: TPDFCoord;
- begin
- P:=D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack, false);
- P.WriteText(25, 20, 'Sample Line Drawing (DrawLineStyle)');
- // write the text at position 100 mm from left and 120 mm from top
- TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
- TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
- TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
- TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
- TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
- lPt1.X := 30; lPt1.Y := 100;
- lPt2.X := 150; lPt2.Y := 150;
- P.DrawLineStyle(lPt1, lPt2, tsThinBlack);
- lPt1.X := 50; lPt1.Y := 70;
- lPt2.X := 180; lPt2.Y := 100;
- P.DrawLineStyle(lPt1, lPt2, tsThinBlue);
- { we can also use coordinates directly, without TPDFCoord variables }
- P.DrawLineStyle(40, 140, 160, 80, tsThinRed);
- P.DrawLineStyle(60, 50, 60, 120, tsThick);
- P.DrawLineStyle(10, 80, 130, 130, tsThinBlackDot);
- end;
- procedure TPDFTestApp.SimpleImage(D: TPDFDocument; APage: integer);
- Var
- P: TPDFPage;
- FtTitle: integer;
- IDX: Integer;
- W, H: Integer;
- begin
- P := D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack, false);
- P.WriteText(25, 20, 'Sample Image Support');
- P.SetFont(FtTitle,10);
- P.SetColor(clBlack, false);
- IDX := D.Images.AddFromFile('poppy.jpg',False);
- W := D.Images[IDX].Width;
- H := D.Images[IDX].Height;
- { full size image }
- P.DrawImageRawSize(25, 130, W, H, IDX); // left-bottom coordinate of image
- P.WriteText(145, 90, '[Full size (defined in pixels)]');
- { quarter size image }
- P.DrawImageRawSize(25, 190, W shr 1, H shr 1, IDX); // could also have used: Integer(W div 2), Integer(H div 2)
- P.WriteText(85, 180, '[Quarter size (defined in pixels)]');
- { rotated image }
- P.DrawImageRawSize(150, 190, W shr 1, H shr 1, IDX, 30);
- { scalled image to 2x2 centimeters }
- P.DrawImage(25, 230, 20.0, 20.0, IDX); // left-bottom coordinate of image
- P.WriteText(50, 220, '[2x2 cm scaled image]');
- { rotatedd image }
- P.DrawImage(120, 230, 20.0, 20.0, IDX, 30);
- end;
- procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- lPt1: TPDFCoord;
- lPoints: array of TPDFCoord;
- i: integer;
- lLineWidth: TPDFFloat;
- begin
- P:=D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack);
- P.WriteText(25, 20, 'Basic Shapes');
- // ========== Rectangles ============
- { PDF origin coordinate is Bottom-Left. }
- lPt1.X := 30;
- lPt1.Y := 75;
- P.SetColor($c00000, true);
- P.SetColor(clLtGray, false);
- P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
- lPt1.X := 20;
- lPt1.Y := 65;
- P.SetColor(clBlue, true);
- P.SetColor($ffff80, false); // pastel yellow
- P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
- P.SetPenStyle(ppsDashDot);
- P.SetColor(clBlue, true);
- P.DrawRect(110, 75, 40, 20, 1, false, true);
- P.SetPenStyle(ppsDash);
- P.SetColor($37b344, true); // some green color
- P.DrawRect(100, 70, 40, 20, 2, false, true);
- P.SetPenStyle(ppsSolid);
- P.SetColor($c00000, true);
- P.DrawRect(90, 65, 40, 20, 4, false, true);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, true);
- P.DrawRect(170, 75, 30, 15, 1, false, true, 30);
- // ========== Rounded Rectangle ===========
- lPt1.X := 30;
- lPt1.Y := 120;
- P.SetColor($c00000, true);
- P.SetColor(clLtGray, false);
- P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 5, 2, true, true);
- lPt1.X := 20;
- lPt1.Y := 110;
- P.SetColor(clBlue, true);
- P.SetColor($ffff80, false); // pastel yellow
- P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 2.4, 1, true, true);
- P.SetPenStyle(ppsDashDot);
- P.SetColor(clBlue, true);
- P.DrawRoundedRect(110, 120, 40, 20, 1.5, 1, false, true);
- P.SetPenStyle(ppsDash);
- P.SetColor($37b344, true); // some green color
- P.DrawRoundedRect(100, 115, 40, 20, 3, 2, false, true);
- P.SetPenStyle(ppsSolid);
- P.SetColor($c00000, true);
- P.DrawRoundedRect(90, 110, 40, 20, 5, 3, false, true);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, true);
- P.DrawRoundedRect(170, 120, 30, 15, 5, 1, false, true, 30);
- // ========== Ellipses ============
- P.SetPenStyle(ppsSolid);
- P.SetColor($c00000, True);
- P.DrawEllipse(60, 150, -40, 20, 3, False, True);
- lPt1.X := 60;
- lPt1.Y := 150;
- P.SetColor(clBlue, true);
- P.SetColor($ffff80, false); // pastel yellow
- P.DrawEllipse(lPt1, 10, 10, 1, True, True);
- P.SetPenStyle(ppsDashDot);
- P.SetColor($b737b3, True);
- P.DrawEllipse(73, 150, 10, 20, 1, False, True);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, True);
- P.DrawEllipse(170, 150, 30, 15, 1, False, True, 30);
- // ========== Lines Pen Styles ============
- lLineWidth := 1;
- P.SetPenStyle(ppsSolid, lLineWidth);
- P.SetColor(clBlack, True);
- P.DrawLine(30, 170, 70, 170, lLineWidth);
- P.SetPenStyle(ppsDash, lLineWidth);
- P.SetColor(clBlack, True);
- P.DrawLine(30, 175, 70, 175, lLineWidth);
- P.SetPenStyle(ppsDot, lLineWidth);
- P.SetColor(clBlack, True);
- P.DrawLine(30, 180, 70, 180, lLineWidth);
- P.SetPenStyle(ppsDashDot, lLineWidth);
- P.SetColor(clBlack, True);
- P.DrawLine(30, 185, 70, 185, lLineWidth);
- P.SetPenStyle(ppsDashDotDot, lLineWidth);
- P.SetColor(clBlack, True);
- P.DrawLine(30, 190, 70, 190, lLineWidth);
- // ========== Line Attribute ============
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, True);
- P.DrawLine(100, 170, 140, 170, 0.2);
- P.DrawLine(100, 175, 140, 175, 0.3);
- P.DrawLine(100, 180, 140, 180, 0.5);
- P.DrawLine(100, 185, 140, 185, 1);
- P.SetColor(clRed, True);
- P.DrawLine(100, 190, 140, 190, 2);
- P.SetColor($37b344, True);
- P.DrawLine(100, 195, 140, 195, 3);
- P.SetColor(clBlue, True);
- P.DrawLine(100, 200, 140, 200, 4);
- P.SetColor($b737b3, True);
- P.DrawLine(100, 205, 140, 205, 5);
- // ========== PolyLines and Polygons ============
- P.Matrix.SetYTranslation(70);
- P.Matrix.SetXTranslation(20);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, true);
- P.DrawRect(0, 10, 50, -50, 1, false, true);
- P.SetColor($c00000, true);
- P.ResetPath;
- SetLength(lPoints, 10);
- for i := 0 to 9 do
- begin
- lPoints[i].X := Random(50);
- lPoints[i].Y := Random(50) + 10.5;
- end;
- P.DrawPolyLine(lPoints, 1);
- P.StrokePath;
- P.Matrix.SetXTranslation(80);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, true);
- P.DrawRect(0, 10, 50, -50, 1, false, true);
- P.SetColor($ffff80, false); // pastel yellow
- P.SetColor(clBlue, true);
- P.ResetPath;
- P.DrawPolygon(lPoints, 1);
- P.FillStrokePath;
- p.SetPenStyle(ppsSolid);
- P.SetFont(FtTitle, 8);
- P.SetColor(clBlack, false);
- P.WriteText(0, 8, 'Fill using the nonzero winding number rule');
- P.Matrix.SetXTranslation(140);
- P.SetPenStyle(ppsSolid);
- P.SetColor(clBlack, true);
- P.DrawRect(0, 10, 50, -50, 1, false, true);
- P.SetColor($ffff80, false); // pastel yellow
- P.SetColor(clBlue, true);
- P.ResetPath;
- P.DrawPolygon(lPoints, 1);
- P.FillEvenOddStrokePath;
- p.SetPenStyle(ppsSolid);
- P.SetFont(FtTitle, 8);
- P.SetColor(clBlack, false);
- P.WriteText(0, 8, 'Fill using the even-odd rule');
- end;
- { Each curve uses the exact same four coordinates, just with different CubicCurveToXXX
- method calls. I also use the page Maxtix Y-Translation to adjust the coordinate
- system before I draw each curve. I could also refactor each curves drawing
- code into a single parametised procedure - simply to show that each of the
- curves really do use the same code and coordinates. }
- procedure TPDFTestApp.AdvancedShapes(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- lPt1, lPt2, lPt3, lPt4: TPDFCoord;
- begin
- P:=D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack);
- P.WriteText(25, 20, 'Advanced Drawing');
- // ========== Cubic Bezier curve ===========
- // PDF c operator curve ===========
- lPt1 := PDFCoord(75, 70);
- lPt2 := PDFCoord(78, 40);
- lPt3 := PDFCoord(100, 35);
- lPt4 := PDFCoord(140, 60);
- p.SetColor(clBlack, true);
- p.SetPenStyle(ppsSolid);
- p.MoveTo(lPt1);
- p.CubicCurveTo(lPt2, lPt3, lPt4, 1);
- // for fun, lets draw the control points as well
- P.SetColor(clLtGray, True);
- P.SetColor(clLtGray, false);
- P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
- P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
- P.SetPenStyle(ppsDot);
- P.DrawLine(lPt1, lPt2, 1);
- P.DrawLine(lPt3, lPt4, 1);
- p.SetPenStyle(ppsSolid);
- P.SetFont(FtTitle, 8);
- P.SetColor(clBlack, false);
- P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
- p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
- p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
- p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
- P.SetFont(FtTitle, 10);
- P.WriteText(20, 50, 'CubicCurveTo(...)');
- // PDF v operator curve ===========
- P.Matrix.SetYTranslation(220);
- p.SetColor(clBlack, true);
- p.SetPenStyle(ppsSolid);
- p.MoveTo(lPt1);
- p.CubicCurveToV(lPt3, lPt4, 1);
- // for fun, lets draw the control points as well
- P.SetColor(clLtGray, True);
- P.SetColor(clLtGray, false);
- P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
- P.SetPenStyle(ppsDot);
- P.DrawLine(lPt3, lPt4, 1);
- p.SetPenStyle(ppsSolid);
- P.SetFont(FtTitle,8);
- P.SetColor(clBlack, false);
- P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
- p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
- p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
- P.SetFont(FtTitle, 10);
- P.WriteText(20, 50, 'CubicCurveToV(...)');
- // PDF y operator curve ===========
- P.Matrix.SetYTranslation(140);
- p.SetColor(clBlack, true);
- p.SetPenStyle(ppsSolid);
- p.MoveTo(lPt1);
- p.CubicCurveToY(lPt2, lPt4, 1);
- // for fun, lets draw the control points as well
- P.SetColor(clLtGray, True);
- P.SetColor(clLtGray, false);
- P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
- P.SetPenStyle(ppsDot);
- P.DrawLine(lPt1, lPt2, 1);
- p.SetPenStyle(ppsSolid);
- P.SetFont(FtTitle,8);
- P.SetColor(clBlack, false);
- P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
- p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
- p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
- P.SetFont(FtTitle, 10);
- P.WriteText(20, 50, 'CubicCurveToY(...)');
- end;
- procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- procedure OutputSample;
- var
- b: boolean;
- begin
- b := P.Matrix._11 = -1;
- P.SetFont(FtTitle, 10);
- P.WriteText(10, 10, 'Matrix transform: ' + BoolToStr(b, True));
- P.DrawLine(0, 0, 100, 100, 1);
- P.WriteText(100, 100, '(line end point)');
- end;
- begin
- P:=D.Pages[APage];
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack);
- P.WriteText(75, 20, 'Matrix Transform');
- OutputSample;
- // enables Cartesian coordinate system for the page
- P.Matrix.SetYScalation(1);
- P.Matrix.SetYTranslation(0);
- OutputSample;
- end;
- procedure TPDFTestApp.SampleLandscape(D: TPDFDocument; APage: integer);
- var
- P: TPDFPage;
- FtTitle: integer;
- function PaperTypeToString(AEnum: TPDFPaperType): string;
- begin
- result := GetEnumName(TypeInfo(TPDFPaperType), Ord(AEnum));
- end;
- function PixelsToMM(AValue: integer): integer;
- begin
- Result := Round((AValue / 72) * 25.4);
- end;
- begin
- P:=D.Pages[APage];
- P.Orientation := ppoLandscape;
- // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
- FtTitle := D.AddFont('Helvetica');
- { Page title }
- P.SetFont(FtTitle,23);
- P.SetColor(clBlack);
- P.WriteText(25, 20, 'Landscape Page');
- P.SetFont(FtTitle, 12);
- P.WriteText(100, 80, 'Page PaperType:');
- P.WriteText(145, 80, PaperTypeToString(P.PaperType));
- P.WriteText(100, 90, 'Page Size:');
- P.WriteText(145, 90, Format('%d x %d (pixels)', [P.Paper.W, P.Paper.H]));
- P.WriteText(145, 95, Format('%d x %d (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
- end;
- procedure TPDFTestApp.TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer;
- const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
- var
- lFontIdx: integer;
- lFC: TFPFontCacheItem;
- lHeight: single;
- lTextHeightInMM: single;
- lWidth: single;
- lTextWidthInMM: single;
- lDescenderHeightInMM: single;
- i: integer;
- begin
- for i := 0 to APage.Document.Fonts.Count-1 do
- begin
- if APage.Document.Fonts[i].Name = AFontName then
- begin
- lFontIdx := i;
- break;
- end;
- end;
- APage.SetFont(lFontIdx, APointSize);
- APage.SetColor(clBlack, false);
- APage.WriteText(AX, AY, AText);
- lFC := gTTFontCache.Find(AFontName, False, False);
- if not Assigned(lFC) then
- raise Exception.Create(AFontName + ' font not found');
- { result is in pixels }
- lHeight := lFC.FontData.CapHeight * APointSize * gTTFontCache.DPI / (72 * lFC.FontData.Head.UnitsPerEm);
- { convert pixels to mm as our PDFPage.UnitOfMeasure is set to mm. }
- lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
- lWidth := lFC.TextWidth(AText, APointSize);
- { convert the Font Units to Millimeters }
- lTextWidthInMM := (lWidth * 25.4) / gTTFontCache.DPI;
- { result is in pixels }
- lHeight := Abs(lFC.FontData.Descender) * APointSize * gTTFontCache.DPI /
- (72 * lFC.FontData.Head.UnitsPerEm);
- { convert pixels to mm as you PDFPage.UnitOfMeasure is set to mm. }
- lDescenderHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
- { adjust the Y coordinate for the font Descender, because
- WriteText() draws on the baseline. Also adjust the TextHeight
- because CapHeight doesn't take into account the Descender. }
- APage.SetColor(ABoxColor, true);
- APage.DrawRect(AX, AY+lDescenderHeightInMM, lTextWidthInMM,
- lTextHeightInMM+lDescenderHeightInMM, 1, false, true);
- end;
- { TPDFTestApp }
- procedure TPDFTestApp.DoRun;
- Function BoolFlag(C : Char;ADefault : Boolean) : Boolean;
- Var
- V : Integer;
- begin
- Result:=ADefault;
- if HasOption(C, '') then
- begin
- v := StrToIntDef(GetOptionValue(C,''),-1);
- if Not (V in [0,1]) then
- Raise Exception.Create('Error in -'+C+' parameter. Valid range is 0-1.');
- Result:=(v=1);
- end
- end;
- var
- ErrorMsg: String;
- begin
- StopOnException:=True;
- inherited DoRun;
- // quick check parameters
- ErrorMsg := CheckOptions('hp:f:t:i:j:n', '');
- if ErrorMsg <> '' then
- begin
- WriteLn('ERROR: ' + ErrorMsg);
- Writeln('');
- Terminate;
- Exit;
- end;
- // parse parameters
- if HasOption('h', '') then
- begin
- WriteHelp;
- Terminate;
- Exit;
- end;
- FPage := -1;
- if HasOption('p', '') then
- begin
- FPage := StrToInt(GetOptionValue('p', ''));
- if (FPage < 1) or (FPage > cPageCount) then
- begin
- Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
- Writeln('');
- Terminate;
- Exit;
- end;
- end;
- FNoFontEmbedding := HasOption('n', '');
- FFontCompression := BoolFlag('f',true);
- FTextCompression := BoolFlag('t',False);
- FImageCompression := BoolFlag('i',False);
- FRawJPEG:=BoolFlag('j',False);
- gTTFontCache.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
- gTTFontCache.BuildFontCache;
- FDoc := SetupDocument;
- try
- FDoc.FontDirectory := 'fonts';
- if FPage = -1 then
- begin
- SimpleText(FDoc, 0);
- SimpleShapes(FDoc, 1);
- AdvancedShapes(FDoc, 2);
- SimpleLines(FDoc, 3);
- SimpleLinesRaw(FDoc, 4);
- SimpleImage(FDoc, 5);
- SampleMatrixTransform(FDoc, 6);
- SampleLandscape(FDoc, 7);
- end
- else
- begin
- case FPage of
- 1: SimpleText(FDoc, 0);
- 2: SimpleShapes(FDoc, 0);
- 3: AdvancedShapes(FDoc, 0);
- 4: SimpleLines(FDoc, 0);
- 5: SimpleLinesRaw(FDoc, 0);
- 6: SimpleImage(FDoc, 0);
- 7: SampleMatrixTransform(FDoc, 0);
- 8: SampleLandscape(FDoc, 0);
- end;
- end;
- SaveDocument(FDoc);
- finally
- FDoc.Free;
- end;
- // stop program loop
- Terminate;
- end;
- procedure TPDFTestApp.WriteHelp;
- begin
- writeln('Usage:');
- writeln(' -h Show this help.');
- writeln(Format(
- ' -p <n> Generate only one page. Valid range is 1-%d.' + LineEnding +
- ' If this option is not specified, then all %0:d pages are' + LineEnding +
- ' generated.', [cPageCount]));
- writeln(' -n If specified, no fonts will be embedded.');
- writeln(' -f <0|1> Toggle embedded font compression. A value of 0' + LineEnding +
- ' disables compression. A value of 1 enables compression.' + LineEnding +
- ' If -n is specified, this option is ignored.');
- writeln(' -t <0|1> Toggle text compression. A value of 0' + LineEnding +
- ' disables compression. A value of 1 enables compression.');
- writeln(' -i <0|1> Toggle image compression. A value of 0' + LineEnding +
- ' disables compression. A value of 1 enables compression.');
- writeln(' -j <0|1> Toggle use of JPEG. A value of 0' + LineEnding +
- ' disables use of JPEG images. A value of 1 writes jpeg file as-is');
- writeln('');
- end;
- begin
- Randomize;
- Application := TPDFTestApp.Create(nil);
- Application.Title := 'fpPDF Test Application';
- Application.Run;
- Application.Free;
- end.
|