{ 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 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, FImageTransparency: boolean; FNoFontEmbedding: boolean; FAddMetadata : Boolean; FSubsetFontEmbedding: 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; Result.Infos.KeyWords:='fcl-pdf demo PDF support Free Pascal'; lOpts := [poPageOriginAtTop]; if FSubsetFontEmbedding then Include(lOpts, poSubsetFont); if FNoFontEmbedding then begin Include(lOpts, poNoEmbeddedFonts); Exclude(lOpts, poSubsetFont); end; if FFontCompression then Include(lOpts, poCompressFonts); if FTextCompression then Include(lOpts,poCompressText); if FImageCompression then Include(lOpts,poCompressImages); if FImageTransparency then Include(lOpts,poUseImageTransparency); if FRawJPEG then Include(lOpts,poUseRawJPEG); if FAddMetadata then Include(lOpts,poMetadataEntry); 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: integer; FtWaterMark: 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'); FtWaterMark := D.AddFont('Helvetica-Bold'); { Page title } P.SetFont(FtTitle, 23); P.SetColor(clBlack, false); P.WriteText(25, 20, 'Sample Text'); P.SetFont(FtWaterMark, 120); P.SetColor(clWaterMark, false); P.WriteText(55, 190, 'Sample', 45); // ----------------------------------- // 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); // strike-through text P.WriteText(25, 64, 'Strike-Through text', 0, false, true); // underline text P.WriteText(65, 64, 'Underlined text', 0, true); // underline and strikethrough text P.WriteText(120, 64, 'Underlined and strikethrough text', 0, true, true); // 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(FtText1, 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.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, 1); lPt1.X := 30; lPt1.Y := 100; lPt2.X := 150; lPt2.Y := 150; P.DrawLine(lPt1, lPt2, 1); P.SetColor(clBlue, True); P.SetPenStyle(ppsDash, 1); lPt1.X := 50; lPt1.Y := 70; lPt2.X := 180; lPt2.Y := 100; P.DrawLine(lPt1, lPt2, 1); { we can also use coordinates directly, without TPDFCoord variables } P.SetColor(clRed, True); P.SetPenStyle(ppsDashDot, 1); P.DrawLine(40, 140, 160, 80, 1); P.SetColor(clBlack, True); P.SetPenStyle(ppsDashDotDot, 1); P.DrawLine(60, 50, 60, 120, 1); P.SetColor(clBlack, True); P.SetPenStyle(ppsDot, 1); P.DrawLine(10, 80, 130, 130, 1); 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(1, clBlack, ppsSolid); TsThinBlue := D.AddLineStyleDef(1, clBlue, ppsDash); TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot); TsThick := D.AddLineStyleDef(1, clBlack, ppsDashDotDot); TsThinBlackDot := D.AddLineStyleDef(1, 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, IDX_Diamond: 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)]'); P.WriteText(145, 95, '+alpha-transparent overlay (if enabled)'); IDX_Diamond := D.Images.AddFromFile('diamond.png',False); P.DrawImageRawSize(30, 125, D.Images[IDX_Diamond].Width, D.Images[IDX_Diamond].Height, IDX_Diamond); { 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; lDescenderHeight: 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'); lHeight := lFC.TextHeight(AText, APointSize, lDescenderHeight); { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. } lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI; lDescenderHeightInMM := (lDescenderHeight * 25.4) / gTTFontCache.DPI; lWidth := lFC.TextWidth(AText, APointSize); { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. } lTextWidthInMM := (lWidth * 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:nsm:', ''); 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', ''); FSubsetFontEmbedding := HasOption('s', ''); FFontCompression := BoolFlag('f',true); FTextCompression := BoolFlag('t',False); FImageCompression := BoolFlag('i',False); FImageTransparency := BoolFlag('t',False); FAddMetadata := BoolFlag('m',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 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(' -s If specified, subset TTF font embedding will occur.'); writeln(' -m <0|1> Toggle metadata generation.'); 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(' -t <0|1> Toggle image transparency support. A value of 0' + LineEnding + ' disables transparency. A value of 1 enables transparency.'); writeln(''); end; begin Randomize; Application := TPDFTestApp.Create(nil); Application.Title := 'fpPDF Test Application'; Application.Run; Application.Free; end.