Browse Source

* Further fixes/improvements from Graeme Geldenhuys:
pdf test app: Implements DrawPolyLine() example on page 2.
pdf: implements Page.DrawPolyLine() method.
pdf: TPDFLineSegment now has an option Stroke parameter. So too does Page.DrawLine().
All part of improving the path related drawing in PDF.
pdf: introduced a new PDFStrokePath class and Page.StrokePath method.
pdf: removes empty constructors.
pdf: Adds optional Stroke paramater to all CubicCurveToXXX() methods.
This allows us more control when we do custom path based drawing.
pdf: introduced new ResetPath() and ClosePath() methods for TPDFPage.
pdf test app: Implement Bezier Curve drawing in Advanced Shapes page.
pdf test app: tidy up the layout of page 2.
pdf test app: tidy up the layout of page 1.
pdf test app: adds a new "advanced shapes" page.
pdf test app: Renamed field variable to a more logical name.
pdf: Introduced CubicCurveToY() and CubicCurveToY() methods.
The code comments explain the difference.
pdf: introduced a new overloaded Page.CubicCurveTo() method.
pdf: introduced a new overloaded Page.MoveTo() method.
pdf: Gave Page.CurveToC() more meaningful parameter names.
pdf: Gave TPDFCurveC parameters and field variables more meaningful names.
pdf test app: updated the test app to show the Cubic Bezier curve in action.
pdf: introduced a cubic bezier curve method to TPDFPage.
pdf: introduced a new Page.MoveTo() method.
pdf: implements a more consistent class hierarchy.
Many classes take a Document as parameter in the constructor, yet
don't descend from TPDFDocumentObject - which defines a property
to get hold of that Document information again.
pdf test app: updated the app to show Rounded Rectangles in action.
pdf: introduced a new Page.DrawRoundedRect() method.
pdf: improved the Ellipse code with a more accurate curve magic number.
pdf: introduced a new overloaded LineSegment.Command() function.
pdf test app: Adds parameter option to embed fonts or not.
pdf: implements contents string/stream compression.
ttf unit tests: resolve failing Created/Modified datetime tests.
pdf demo: extend the sample app to draw text in a box.

git-svn-id: trunk@34767 -

michael 8 years ago
parent
commit
c81b645291

+ 272 - 48
packages/fcl-pdf/examples/testfppdf.lpr

@@ -22,17 +22,19 @@ uses
   fpreadjpeg,
   fpreadjpeg,
   fppdf,
   fppdf,
   fpparsettf,
   fpparsettf,
+  fpttf,
   typinfo;
   typinfo;
 
 
 type
 type
 
 
   TPDFTestApp = class(TCustomApplication)
   TPDFTestApp = class(TCustomApplication)
   private
   private
-    Fpg: integer;
+    FPage: integer;
     FRawJPEG,
     FRawJPEG,
     FImageCompression,
     FImageCompression,
     FTextCompression,
     FTextCompression,
     FFontCompression: boolean;
     FFontCompression: boolean;
+    FNoFontEmbedding: boolean;
     FDoc: TPDFDocument;
     FDoc: TPDFDocument;
     function    SetUpDocument: TPDFDocument;
     function    SetUpDocument: TPDFDocument;
     procedure   SaveDocument(D: TPDFDocument);
     procedure   SaveDocument(D: TPDFDocument);
@@ -42,8 +44,10 @@ type
     procedure   SimpleLines(D: TPDFDocument; APage: integer);
     procedure   SimpleLines(D: TPDFDocument; APage: integer);
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
+    procedure   AdvancedShapes(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
     procedure   SampleLandscape(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
   protected
     procedure   DoRun; override;
     procedure   DoRun; override;
   public
   public
@@ -55,7 +59,7 @@ var
   Application: TPDFTestApp;
   Application: TPDFTestApp;
 
 
 const
 const
-  cPageCount: integer = 7;
+  cPageCount: integer = 8;
 
 
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 var
 var
@@ -68,11 +72,13 @@ begin
   Result := TPDFDocument.Create(Nil);
   Result := TPDFDocument.Create(Nil);
   Result.Infos.Title := Application.Title;
   Result.Infos.Title := Application.Title;
   Result.Infos.Author := 'Graeme Geldenhuys';
   Result.Infos.Author := 'Graeme Geldenhuys';
-  Result.Infos.Producer := 'fpGUI Toolkit 0.8';
+  Result.Infos.Producer := 'fpGUI Toolkit 1.4.1';
   Result.Infos.ApplicationName := ApplicationName;
   Result.Infos.ApplicationName := ApplicationName;
   Result.Infos.CreationDate := Now;
   Result.Infos.CreationDate := Now;
 
 
   lOpts := [];
   lOpts := [];
+  if FNoFontEmbedding then
+    Include(lOpts, poNoEmbeddedFonts);
   if FFontCompression then
   if FFontCompression then
     Include(lOpts, poCompressFonts);
     Include(lOpts, poCompressFonts);
   if FTextCompression then
   if FTextCompression then
@@ -86,7 +92,7 @@ begin
   Result.StartDocument;
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
   S := Result.Sections.AddSection; // we always need at least one section
   lPageCount := cPageCount;
   lPageCount := cPageCount;
-  if Fpg <> -1 then
+  if FPage <> -1 then
     lPageCount := 1;
     lPageCount := 1;
   for i := 1 to lPageCount do
   for i := 1 to lPageCount do
   begin
   begin
@@ -132,9 +138,9 @@ begin
 
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
   FtTitle := D.AddFont('Helvetica');
   FtTitle := D.AddFont('Helvetica');
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans'); // TODO: this color value means nothing - not used at all
+  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
   FtText2 := D.AddFont('Times-BoldItalic');
   FtText2 := D.AddFont('Times-BoldItalic');
-  // FtText3 := D.AddFont('arial.ttf', 'Arial', clBlack);
+  // FtText3 := D.AddFont('arial.ttf', 'Arial');
   FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
   FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
 
 
   { Page title }
   { Page title }
@@ -153,7 +159,7 @@ begin
 
 
   P.SetFont(ftText2,16);
   P.SetFont(ftText2,16);
   P.SetColor($C00000, false);
   P.SetColor($C00000, false);
-  P.WriteText(60, 100, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
+  P.WriteText(50, 100, '(50mm,100mm) Times-BoldItalic: Big text at absolute position');
 
 
   // -----------------------------------
   // -----------------------------------
   // TrueType testing purposes
   // TrueType testing purposes
@@ -176,6 +182,13 @@ begin
   P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
   P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
 
 
   P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
   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;
 end;
 
 
 procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
 procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
@@ -298,6 +311,8 @@ var
   P: TPDFPage;
   P: TPDFPage;
   FtTitle: integer;
   FtTitle: integer;
   lPt1: TPDFCoord;
   lPt1: TPDFCoord;
+  lPoints: array of TPDFCoord;
+  i: integer;
 begin
 begin
   P:=D.Pages[APage];
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
@@ -310,30 +325,56 @@ begin
 
 
   // ========== Rectangles ============
   // ========== Rectangles ============
 
 
-  { PDF origin coordinate is Bottom-Left, and we want to use Image Coordinate of Top-Left }
+  { PDF origin coordinate is Bottom-Left. }
   lPt1.X := 30;
   lPt1.X := 30;
-  lPt1.Y := 60+20; // origin + height
-  P.SetColor(clRed, true);
-  P.SetColor($37b344, false); // some green color
+  lPt1.Y := 75;
+  P.SetColor($c00000, true);
+  P.SetColor(clLtGray, false);
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
 
 
   lPt1.X := 20;
   lPt1.X := 20;
-  lPt1.Y := 50+20; // origin + height
+  lPt1.Y := 65;
   P.SetColor(clBlue, true);
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
 
 
   P.SetPenStyle(ppsDashDot);
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlue, true);
   P.SetColor(clBlue, true);
-  P.DrawRect(110, 70+20 {origin+height}, 40, 20, 1, false, true);
+  P.DrawRect(110, 75, 40, 20, 1, false, true);
 
 
   P.SetPenStyle(ppsDash);
   P.SetPenStyle(ppsDash);
   P.SetColor($37b344, true);  // some green color
   P.SetColor($37b344, true);  // some green color
-  P.DrawRect(100, 60+20 {origin+height}, 40, 20, 2, false, true);
+  P.DrawRect(100, 70, 40, 20, 2, false, true);
 
 
   P.SetPenStyle(ppsSolid);
   P.SetPenStyle(ppsSolid);
-  P.SetColor($b737b3, true);  // some purple color
-  P.DrawRect(90, 50+20 {origin+height}, 40, 20, 4, false, true);
+  P.SetColor($c00000, true);
+  P.DrawRect(90, 65, 40, 20, 4, false, true);
+
+
+  // ========== 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);
 
 
 
 
   // ========== Ellipses ============
   // ========== Ellipses ============
@@ -345,35 +386,35 @@ begin
   lPt1.X := 60;
   lPt1.X := 60;
   lPt1.Y := 150;
   lPt1.Y := 150;
   P.SetColor(clBlue, true);
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawEllipse(lPt1, 10, 10, 1, True, True);
   P.DrawEllipse(lPt1, 10, 10, 1, True, True);
 
 
   P.SetPenStyle(ppsDashDot);
   P.SetPenStyle(ppsDashDot);
   P.SetColor($b737b3, True);
   P.SetColor($b737b3, True);
-  P.DrawEllipse(140, 150, 35, 20, 1, False, True);
+  P.DrawEllipse(73, 150, 10, 20, 1, False, True);
 
 
 
 
   // ========== Lines Pen Styles ============
   // ========== Lines Pen Styles ============
 
 
   P.SetPenStyle(ppsSolid);
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 200, 70, 200, 1);
+  P.DrawLine(30, 170, 70, 170, 1);
 
 
   P.SetPenStyle(ppsDash);
   P.SetPenStyle(ppsDash);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 210, 70, 210, 1);
+  P.DrawLine(30, 175, 70, 175, 1);
 
 
   P.SetPenStyle(ppsDot);
   P.SetPenStyle(ppsDot);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 220, 70, 220, 1);
+  P.DrawLine(30, 180, 70, 180, 1);
 
 
   P.SetPenStyle(ppsDashDot);
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 230, 70, 230, 1);
+  P.DrawLine(30, 185, 70, 185, 1);
 
 
   P.SetPenStyle(ppsDashDotDot);
   P.SetPenStyle(ppsDashDotDot);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 240, 70, 240, 1);
+  P.DrawLine(30, 190, 70, 190, 1);
 
 
 
 
   // ========== Line Attribute ============
   // ========== Line Attribute ============
@@ -381,21 +422,144 @@ begin
   P.SetPenStyle(ppsSolid);
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
   P.SetColor(clBlack, True);
   P.DrawLine(100, 170, 140, 170, 0.2);
   P.DrawLine(100, 170, 140, 170, 0.2);
-  P.DrawLine(100, 180, 140, 180, 0.3);
-  P.DrawLine(100, 190, 140, 190, 0.5);
-  P.DrawLine(100, 200, 140, 200, 1);
+  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.SetColor(clRed, True);
-  P.DrawLine(100, 210, 140, 210, 2);
+  P.DrawLine(100, 190, 140, 190, 2);
 
 
   P.SetColor($37b344, True);
   P.SetColor($37b344, True);
-  P.DrawLine(100, 220, 140, 220, 3);
+  P.DrawLine(100, 195, 140, 195, 3);
 
 
   P.SetColor(clBlue, True);
   P.SetColor(clBlue, True);
-  P.DrawLine(100, 230, 140, 230, 4);
+  P.DrawLine(100, 200, 140, 200, 4);
 
 
   P.SetColor($b737b3, True);
   P.SetColor($b737b3, True);
-  P.DrawLine(100, 240, 140, 240, 5);
+  P.DrawLine(100, 205, 140, 205, 5);
+
+
+  // ========== PolyLines ============
+  P.Matrix.SetYTranslation(60);
+  P.Matrix.SetXTranslation(20);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 0, 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);
+  end;
+  P.DrawPolyLine(lPoints, 1);
+  P.StrokePath;
+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;
 end;
 
 
 procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
 procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
@@ -469,6 +633,57 @@ begin
   P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
   P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
 end;
 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 }
 { TPDFTestApp }
 
 
 procedure TPDFTestApp.DoRun;
 procedure TPDFTestApp.DoRun;
@@ -496,7 +711,7 @@ begin
   StopOnException:=True;
   StopOnException:=True;
   inherited DoRun;
   inherited DoRun;
   // quick check parameters
   // quick check parameters
-  ErrorMsg := CheckOptions('hp:f:t:i:j:', '');
+  ErrorMsg := CheckOptions('hp:f:t:i:j:n', '');
   if ErrorMsg <> '' then
   if ErrorMsg <> '' then
   begin
   begin
     WriteLn('ERROR:  ' + ErrorMsg);
     WriteLn('ERROR:  ' + ErrorMsg);
@@ -513,11 +728,11 @@ begin
     Exit;
     Exit;
   end;
   end;
 
 
-  Fpg := -1;
+  FPage := -1;
   if HasOption('p', '') then
   if HasOption('p', '') then
   begin
   begin
-    Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > cPageCount) then
+    FPage := StrToInt(GetOptionValue('p', ''));
+    if (FPage < 1) or (FPage > cPageCount) then
     begin
     begin
       Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
       Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
       Writeln('');
       Writeln('');
@@ -526,35 +741,41 @@ begin
     end;
     end;
   end;
   end;
 
 
+  FNoFontEmbedding := HasOption('n', '');
   FFontCompression := BoolFlag('f',true);
   FFontCompression := BoolFlag('f',true);
   FTextCompression := BoolFlag('t',False);
   FTextCompression := BoolFlag('t',False);
   FImageCompression := BoolFlag('i',False);
   FImageCompression := BoolFlag('i',False);
   FRawJPEG:=BoolFlag('j',False);
   FRawJPEG:=BoolFlag('j',False);
 
 
+  gTTFontCache.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
+  gTTFontCache.BuildFontCache;
+
   FDoc := SetupDocument;
   FDoc := SetupDocument;
   try
   try
     FDoc.FontDirectory := 'fonts';
     FDoc.FontDirectory := 'fonts';
 
 
-    if Fpg = -1 then
+    if FPage = -1 then
     begin
     begin
       SimpleText(FDoc, 0);
       SimpleText(FDoc, 0);
       SimpleShapes(FDoc, 1);
       SimpleShapes(FDoc, 1);
-      SimpleLines(FDoc, 2);
-      SimpleLinesRaw(FDoc, 3);
-      SimpleImage(FDoc, 4);
-      SampleMatrixTransform(FDoc, 5);
-      SampleLandscape(FDoc, 6);
+      AdvancedShapes(FDoc, 2);
+      SimpleLines(FDoc, 3);
+      SimpleLinesRaw(FDoc, 4);
+      SimpleImage(FDoc, 5);
+      SampleMatrixTransform(FDoc, 6);
+      SampleLandscape(FDoc, 7);
     end
     end
     else
     else
     begin
     begin
-      case Fpg of
+      case FPage of
         1:  SimpleText(FDoc, 0);
         1:  SimpleText(FDoc, 0);
         2:  SimpleShapes(FDoc, 0);
         2:  SimpleShapes(FDoc, 0);
-        3:  SimpleLines(FDoc, 0);
-        4:  SimpleLinesRaw(FDoc, 0);
-        5:  SimpleImage(FDoc, 0);
-        6:  SampleMatrixTransform(FDoc, 0);
-        7:  SampleLandscape(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;
     end;
     end;
 
 
@@ -575,8 +796,10 @@ begin
           '    -p <n>      Generate only one page. Valid range is 1-%d.' + LineEnding +
           '    -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 +
           '                If this option is not specified, then all %0:d pages are' + LineEnding +
           '                generated.', [cPageCount]));
           '                generated.', [cPageCount]));
+  writeln('    -n          If specified, no fonts will be embedded.');
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
-          '                disables compression. A value of 1 enables compression.');
+          '                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 +
   writeln('    -t <0|1>    Toggle text compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');
           '                disables compression. A value of 1 enables compression.');
   writeln('    -i <0|1>    Toggle image compression. A value of 0' + LineEnding +
   writeln('    -i <0|1>    Toggle image compression. A value of 0' + LineEnding +
@@ -589,6 +812,7 @@ end;
 
 
 
 
 begin
 begin
+  Randomize;
   Application := TPDFTestApp.Create(nil);
   Application := TPDFTestApp.Create(nil);
   Application.Title := 'fpPDF Test Application';
   Application.Title := 'fpPDF Test Application';
   Application.Run;
   Application.Run;

+ 161 - 159
packages/fcl-pdf/src/fpparsettf.pp

@@ -29,7 +29,7 @@ type
   ETTF = Class(Exception);
   ETTF = Class(Exception);
 
 
   // Tables recognized in this unit.
   // Tables recognized in this unit.
-  TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost);
+  TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost {,ttglyph});
 
 
   TSmallintArray = Packed Array of Int16;
   TSmallintArray = Packed Array of Int16;
   TWordArray = Packed Array of UInt16;
   TWordArray = Packed Array of UInt16;
@@ -39,177 +39,177 @@ type
 
 
   TFixedVersionRec = packed record
   TFixedVersionRec = packed record
     case Integer of
     case Integer of
-      0:  (Minor, Major: Word);
-      1:  (Version: Cardinal);
+      0:  (Minor, Major: UInt16);
+      1:  (Version: UInt32);
   end;
   end;
 
 
   TTableDirectory = Packed Record
   TTableDirectory = Packed Record
-    FontVersion : TFixedVersionRec;
-    Numtables : Word;
-    SearchRange : Word;
-    EntrySelector : Word;
-    RangeShift : Word;
+    FontVersion : TFixedVersionRec; { UInt32}
+    Numtables : UInt16;
+    SearchRange : UInt16;
+    EntrySelector : UInt16;
+    RangeShift : UInt16;
   end;
   end;
 
 
   TTableDirectoryEntry = Packed Record
   TTableDirectoryEntry = Packed Record
-    Tag: Array[1..4] of char;
-    checkSum : Cardinal;
-    offset : Cardinal;
-    Length : Cardinal;
+    Tag: Array[1..4] of AnsiChar;
+    checkSum : UInt32;
+    offset : UInt32;
+    Length : UInt32;
   end;
   end;
   TTableDirectoryEntries = Array of TTableDirectoryEntry;
   TTableDirectoryEntries = Array of TTableDirectoryEntry;
 
 
   TLongHorMetric = Packed record
   TLongHorMetric = Packed record
-    AdvanceWidth : Word;
-    LSB: Smallint;              { leftSideBearing }
+    AdvanceWidth : UInt16;
+    LSB: Int16;              { leftSideBearing }
   end;
   end;
   TLongHorMetrics = Packed Array of TLongHorMetric;
   TLongHorMetrics = Packed Array of TLongHorMetric;
 
 
 Type
 Type
   TPostScript = Packed Record
   TPostScript = Packed Record
-    Format : TFixedVersionRec;
-    ItalicAngle : TF16Dot16;
-    UnderlinePosition : SmallInt;
-    underlineThickness : SmallInt;
-    isFixedPitch : Cardinal;
-    minMemType42 : Cardinal;
-    maxMemType42 : Cardinal;
-    minMemType1 : Cardinal;
-    maxMemType1 : Cardinal;
+    Format : TFixedVersionRec;  { UInt32 }
+    ItalicAngle : TF16Dot16;  { Int32 }
+    UnderlinePosition : Int16;
+    underlineThickness : Int16;
+    isFixedPitch : UInt32;
+    minMemType42 : UInt32;
+    maxMemType42 : UInt32;
+    minMemType1 : UInt32;
+    maxMemType1 : UInt32;
   end;
   end;
 
 
   TMaxP = Packed Record
   TMaxP = Packed Record
-    VersionNumber : TFixedVersionRec;
-    numGlyphs : Word;
-    maxPoints : Word;
-    maxContours : Word;
-    maxCompositePoints : word;
-    maxCompositeContours : word;
-    maxZones : Word;
-    maxTwilightPoints : word;
-    maxStorage : Word;
-    maxFunctionDefs : Word;
-    maxInstructionDefs : Word;
-    maxStackElements : Word;
-    maxSizeOfInstructions : word;
-    maxComponentElements : Word;
-    maxComponentDepth : Word;
+    VersionNumber : TFixedVersionRec;  { UInt32 }
+    numGlyphs : UInt16;
+    maxPoints : UInt16;
+    maxContours : UInt16;
+    maxCompositePoints : UInt16;
+    maxCompositeContours : UInt16;
+    maxZones : UInt16;
+    maxTwilightPoints : UInt16;
+    maxStorage : UInt16;
+    maxFunctionDefs : UInt16;
+    maxInstructionDefs : UInt16;
+    maxStackElements : UInt16;
+    maxSizeOfInstructions : UInt16;
+    maxComponentElements : UInt16;
+    maxComponentDepth : UInt16;
   end;
   end;
 
 
   TOS2Data = Packed Record
   TOS2Data = Packed Record
-    version : Word;
-    xAvgCharWidth : SmallInt;
-    usWeightClass : Word;
-    usWidthClass : Word;
-    fsType : SmallInt;
-    ySubscriptXSize : SmallInt;
-    ySubscriptYSize : SmallInt;
-    ySubscriptXOffset : SmallInt;
-    ySubscriptYOffset : Smallint;
-    ySuperscriptXSize : Smallint;
-    ySuperscriptYSize : Smallint;
-    ySuperscriptXOffset : Smallint;
-    ySuperscriptYOffset : Smallint;
-    yStrikeoutSize : SmallInt;
-    yStrikeoutPosition : Smallint;
-    sFamilyClass : SmallInt;    // we could split this into a record of Class & SubClass values.
+    version : UInt16;
+    xAvgCharWidth : Int16;
+    usWeightClass : UInt16;
+    usWidthClass : UInt16;
+    fsType : Int16;
+    ySubscriptXSize : Int16;
+    ySubscriptYSize : Int16;
+    ySubscriptXOffset : Int16;
+    ySubscriptYOffset : Int16;
+    ySuperscriptXSize : Int16;
+    ySuperscriptYSize : Int16;
+    ySuperscriptXOffset : Int16;
+    ySuperscriptYOffset : Int16;
+    yStrikeoutSize : Int16;
+    yStrikeoutPosition : Int16;
+    sFamilyClass : Int16;    // we could split this into a record of Class & SubClass values.
     panose : Array[0..9] of byte;
     panose : Array[0..9] of byte;
-    ulUnicodeRange1 : Cardinal;
-    ulUnicodeRange2 : Cardinal;
-    ulUnicodeRange3 : Cardinal;
-    ulUnicodeRange4 : Cardinal;
-    achVendID : Array[0..3] of char;
-    fsSelection : word;
-    usFirstCharIndex : Word;
-    usLastCharIndex : Word;
-    sTypoAscender: Smallint;
-    sTypoDescender : Smallint;
-    sTypoLineGap : Smallint;
-    usWinAscent : Word;
-    usWinDescent : Word;
-    ulCodePageRange1 : Cardinal;
-    ulCodePageRange2 : Cardinal;
-    sxHeight : smallint;
-    sCapHeight : smallint;
-    usDefaultChar : word;
-    usBreakChar : word;
-    usMaxContext  : word;
+    ulUnicodeRange1 : UInt32;
+    ulUnicodeRange2 : UInt32;
+    ulUnicodeRange3 : UInt32;
+    ulUnicodeRange4 : UInt32;
+    achVendID : Array[0..3] of AnsiChar;
+    fsSelection : UInt16;
+    usFirstCharIndex : UInt16;
+    usLastCharIndex : UInt16;
+    sTypoAscender: Int16;
+    sTypoDescender : Int16;
+    sTypoLineGap : Int16;
+    usWinAscent : UInt16;
+    usWinDescent : UInt16;
+    ulCodePageRange1 : UInt32;
+    ulCodePageRange2 : UInt32;
+    sxHeight : Int16;
+    sCapHeight : Int16;
+    usDefaultChar : UInt16;
+    usBreakChar : UInt16;
+    usMaxContext  : UInt16;
   end;
   end;
 
 
   { Nicely described at [https://www.microsoft.com/typography/otspec/head.htm] }
   { Nicely described at [https://www.microsoft.com/typography/otspec/head.htm] }
   THead = Packed record
   THead = Packed record
-    FileVersion : TFixedVersionRec;
-    FontRevision : TFixedVersionRec;
-    CheckSumAdjustment : Cardinal;
-    MagicNumber : Cardinal;
-    Flags : Word;
-    UnitsPerEm: word;
+    FileVersion : TFixedVersionRec;  { UInt32 }
+    FontRevision : TFixedVersionRec;  { UInt32 }
+    CheckSumAdjustment : UInt32;
+    MagicNumber : UInt32;
+    Flags : UInt16;
+    UnitsPerEm: UInt16;
     Created : Int64;
     Created : Int64;
     Modified : Int64;
     Modified : Int64;
-    BBox: Packed array[0..3] of Smallint;
-    MacStyle : word;
-    LowestRecPPEM : word;
-    FontDirectionHint : smallint;
-    IndexToLocFormat : Smallint;
-    glyphDataFormat : Smallint;
+    BBox: Packed array[0..3] of Int16;
+    MacStyle : UInt16;
+    LowestRecPPEM : UInt16;
+    FontDirectionHint : Int16;
+    IndexToLocFormat : Int16;
+    glyphDataFormat : Int16;
   end;
   end;
 
 
   { structure described at [https://www.microsoft.com/typography/otspec/hhea.htm] }
   { structure described at [https://www.microsoft.com/typography/otspec/hhea.htm] }
   THHead = packed record
   THHead = packed record
-    TableVersion : TFixedVersionRec;
-    Ascender : Smallint;
-    Descender : Smallint;
-    LineGap : Smallint;
-    AdvanceWidthMax : Word;
-    MinLeftSideBearing : Smallint;
-    MinRightSideBearing : Smallint;
-    XMaxExtent : Smallint;
-    CaretSlopeRise : Smallint;
-    CaretSlopeRun : Smallint;
-    Reserved : Array[0..4] of Smallint;
-    metricDataFormat : Smallint;
-    numberOfHMetrics : Word;
+    TableVersion : TFixedVersionRec;  { UInt32 }
+    Ascender : Int16;
+    Descender : Int16;
+    LineGap : Int16;
+    AdvanceWidthMax : UInt16;
+    MinLeftSideBearing : Int16;
+    MinRightSideBearing : Int16;
+    XMaxExtent : Int16;
+    CaretSlopeRise : Int16;
+    CaretSlopeRun : Int16;
+    Reserved : Array[0..4] of Int16;
+    metricDataFormat : Int16;
+    numberOfHMetrics : UInt16;
   end;
   end;
 
 
   { Character to glyph mapping
   { Character to glyph mapping
     Structure described at [https://www.microsoft.com/typography/otspec/cmap.htm] }
     Structure described at [https://www.microsoft.com/typography/otspec/cmap.htm] }
   TCmapHeader = packed record
   TCmapHeader = packed record
-    Version: word;
-    SubTableCount: word;
+    Version: UInt16;
+    SubTableCount: UInt16;
   end;
   end;
 
 
   TCmapSubTableEntry = packed record
   TCmapSubTableEntry = packed record
-    PlatformID: word;
-    EncodingID: word;
-    Offset: Cardinal;
+    PlatformID: UInt16;
+    EncodingID: UInt16;
+    Offset: UInt32;
   end;
   end;
   TCmapSubTables = Array of TCmapSubTableEntry;
   TCmapSubTables = Array of TCmapSubTableEntry;
 
 
   TCmapFmt4 = packed record
   TCmapFmt4 = packed record
-    Format: word;
-    Length: word;
-    LanguageID: word;
-    SegmentCount2: word;
-    SearchRange: word;
-    EntrySelector: word;
-    RangeShift: word;
+    Format: UInt16;
+    Length: UInt16;
+    LanguageID: UInt16;
+    SegmentCount2: UInt16;
+    SearchRange: UInt16;
+    EntrySelector: UInt16;
+    RangeShift: UInt16;
   end;
   end;
 
 
   TUnicodeMapSegment = Packed Record
   TUnicodeMapSegment = Packed Record
-    StartCode : Word;
-    EndCode : Word;
-    IDDelta : Smallint;
-    IDRangeOffset : Word;
+    StartCode : UInt16;
+    EndCode : UInt16;
+    IDDelta : Int16;
+    IDRangeOffset : UInt16;
   end;
   end;
   TUnicodeMapSegmentArray = Array of TUnicodeMapSegment;
   TUnicodeMapSegmentArray = Array of TUnicodeMapSegment;
 
 
   TNameRecord = Packed Record
   TNameRecord = Packed Record
-    PlatformID : Word;
-    EncodingID : Word;
-    LanguageID : Word;
-    NameID : Word;
-    StringLength : Word;
-    StringOffset : Word;
+    PlatformID : UInt16;
+    EncodingID : UInt16;
+    LanguageID : UInt16;
+    NameID : UInt16;
+    StringLength : UInt16;
+    StringOffset : UInt16;
   end;
   end;
 
 
   TNameEntry = Packed Record
   TNameEntry = Packed Record
@@ -242,11 +242,11 @@ Type
     function FixMinorVersion(const AMinor: word): word;
     function FixMinorVersion(const AMinor: word): word;
     function GetMissingWidth: integer;
     function GetMissingWidth: integer;
   Protected
   Protected
-    // Stream reading functions.
     Function IsNativeData : Boolean; virtual;
     Function IsNativeData : Boolean; virtual;
-    function ReadShort(AStream: TStream): Smallint; inline;
-    function ReadULong(AStream: TStream): Longword; inline;
-    function ReadUShort(AStream: TStream): Word; inline;
+    // Stream reading functions.
+    function ReadInt16(AStream: TStream): Int16; inline;
+    function ReadUInt32(AStream: TStream): UInt32; inline;
+    function ReadUInt16(AStream: TStream): UInt16; inline;
     // Parse the various well-known tables
     // Parse the various well-known tables
     procedure ParseHead(AStream : TStream); virtual;
     procedure ParseHead(AStream : TStream); virtual;
     procedure ParseHhea(AStream : TStream); virtual;
     procedure ParseHhea(AStream : TStream); virtual;
@@ -359,7 +359,6 @@ implementation
 
 
 resourcestring
 resourcestring
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
-  rsErrNoFormat4MapTable = 'No Format 4 map (unicode) table found <%s - %s>';
   rsErrUnexpectedUnicodeSubtable = 'Unexpected unicode subtable format, expected 4, got %s';
   rsErrUnexpectedUnicodeSubtable = 'Unexpected unicode subtable format, expected 4, got %s';
 
 
 Function GetTableType(Const AName : String) : TTTFTableType;
 Function GetTableType(Const AName : String) : TTTFTableType;
@@ -390,7 +389,7 @@ begin
   FillChar(Dest^, Size, Data);
   FillChar(Dest^, Size, Data);
 end;
 end;
 
 
-function TTFFileInfo.ReadULong(AStream: TStream): Longword;inline;
+function TTFFileInfo.ReadUInt32(AStream: TStream): UInt32;
 begin
 begin
   Result:=0;
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
   AStream.ReadBuffer(Result,SizeOf(Result));
@@ -398,7 +397,7 @@ begin
     Result:=BEtoN(Result);
     Result:=BEtoN(Result);
 end;
 end;
 
 
-function TTFFileInfo.ReadUShort(AStream: TStream): Word;inline;
+function TTFFileInfo.ReadUInt16(AStream: TStream): UInt16;
 begin
 begin
   Result:=0;
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
   AStream.ReadBuffer(Result,SizeOf(Result));
@@ -406,9 +405,9 @@ begin
     Result:=BEtoN(Result);
     Result:=BEtoN(Result);
 end;
 end;
 
 
-function TTFFileInfo.ReadShort(AStream: TStream): Smallint;inline;
+function TTFFileInfo.ReadInt16(AStream: TStream): Int16;
 begin
 begin
-  Result:=SmallInt(ReadUShort(AStream));
+  Result:=Int16(ReadUInt16(AStream));
 end;
 end;
 
 
 procedure TTFFileInfo.ParseHead(AStream : TStream);
 procedure TTFFileInfo.ParseHead(AStream : TStream);
@@ -514,52 +513,55 @@ var
 
 
 begin
 begin
   TableStartPos:=AStream.Position;
   TableStartPos:=AStream.Position;
-  FCMapH.Version:=ReadUShort(AStream);
-  FCMapH.SubtableCount:=ReadUShort(AStream);
+  FCMapH.Version:=ReadUInt16(AStream);
+  FCMapH.SubtableCount:=ReadUInt16(AStream);
   SetLength(FSubtables,CMapH.SubtableCount);
   SetLength(FSubtables,CMapH.SubtableCount);
   for I:= 0 to FCMapH.SubtableCount-1 do
   for I:= 0 to FCMapH.SubtableCount-1 do
     begin
     begin
-    FSubtables[i].PlatformID:=ReadUShort(AStream);
-    FSubtables[i].EncodingID:=ReadUShort(AStream);
-    FSubtables[i].Offset:=ReadULong(AStream); // 4 bytes - Offset of subtable
+    FSubtables[i].PlatformID:=ReadUInt16(AStream);
+    FSubtables[i].EncodingID:=ReadUInt16(AStream);
+    FSubtables[i].Offset:=ReadUInt32(AStream); // 4 bytes - Offset of subtable
     end;
     end;
   UE:=FCMapH.SubtableCount-1;
   UE:=FCMapH.SubtableCount-1;
+  if UE=0 then
+    // No CMap subtable entries, this is not an error, just exit.
+    exit;
   While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do
   While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do
     Dec(UE);
     Dec(UE);
   if (UE=-1) then
   if (UE=-1) then
-    Raise ETTF.CreateFmt(rsErrNoFormat4MapTable, [FFileName, PostScriptName]);
+    exit;
   TT:=TableStartPos+FSubtables[UE].Offset;
   TT:=TableStartPos+FSubtables[UE].Offset;
   AStream.Position:=TT;
   AStream.Position:=TT;
-  FUnicodeMap.Format:= ReadUShort(AStream);               // 2 bytes - Format of subtable
+  FUnicodeMap.Format:= ReadUInt16(AStream);               // 2 bytes - Format of subtable
   if (FUnicodeMap.Format<>4) then
   if (FUnicodeMap.Format<>4) then
     Raise ETTF.CreateFmt(rsErrUnexpectedUnicodeSubtable, [FUnicodeMap.Format]);
     Raise ETTF.CreateFmt(rsErrUnexpectedUnicodeSubtable, [FUnicodeMap.Format]);
-  FUnicodeMap.Length:=ReadUShort(AStream);
+  FUnicodeMap.Length:=ReadUInt16(AStream);
   S:=TMemoryStream.Create;
   S:=TMemoryStream.Create;
   try
   try
     // Speed up the process, read everything in a single mem block.
     // Speed up the process, read everything in a single mem block.
     S.CopyFrom(AStream,Int64(FUnicodeMap.Length)-4);
     S.CopyFrom(AStream,Int64(FUnicodeMap.Length)-4);
     S.Position:=0;
     S.Position:=0;
-    FUnicodeMap.LanguageID:=ReadUShort(S);
-    FUnicodeMap.SegmentCount2:=ReadUShort(S);            // 2 bytes - Segments count
-    FUnicodeMap.SearchRange:=ReadUShort(S);
-    FUnicodeMap.EntrySelector:=ReadUShort(S);
-    FUnicodeMap.RangeShift:=ReadUShort(S);
+    FUnicodeMap.LanguageID:=ReadUInt16(S);
+    FUnicodeMap.SegmentCount2:=ReadUInt16(S);            // 2 bytes - Segments count
+    FUnicodeMap.SearchRange:=ReadUInt16(S);
+    FUnicodeMap.EntrySelector:=ReadUInt16(S);
+    FUnicodeMap.RangeShift:=ReadUInt16(S);
     SegCount:=FUnicodeMap.SegmentCount2 div 2;
     SegCount:=FUnicodeMap.SegmentCount2 div 2;
     SetLength(FUnicodeMapSegments,SegCount);
     SetLength(FUnicodeMapSegments,SegCount);
     for i:=0 to SegCount-1 do
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].EndCode:=ReadUShort(S);
-    ReadUShort(S);
+      FUnicodeMapSegments[i].EndCode:=ReadUInt16(S);
+    ReadUInt16(S);
     for i:=0 to SegCount-1 do
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].StartCode:=ReadUShort(S);
+      FUnicodeMapSegments[i].StartCode:=ReadUInt16(S);
     for i:=0 to SegCount-1 do
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDDelta:=ReadShort(S);
+      FUnicodeMapSegments[i].IDDelta:=ReadInt16(S);
     for i:=0 to SegCount-1 do
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDRangeOffset:=ReadUShort(S);
+      FUnicodeMapSegments[i].IDRangeOffset:=ReadUInt16(S);
     UE:=S.Position;
     UE:=S.Position;
     UE:=(S.Size-UE) div 2;
     UE:=(S.Size-UE) div 2;
     SetLength(GlyphIDArray,UE);
     SetLength(GlyphIDArray,UE);
     For J:=0 to UE-1 do
     For J:=0 to UE-1 do
-      GlyphIDArray[J]:=ReadUShort(S);
+      GlyphIDArray[J]:=ReadUInt16(S);
     J:=0;
     J:=0;
     for i:=0 to SegCount-1 do
     for i:=0 to SegCount-1 do
       With FUnicodeMapSegments[i] do
       With FUnicodeMapSegments[i] do
@@ -606,9 +608,9 @@ var
 
 
 begin
 begin
   TableStartPos:= AStream.Position;                   // memorize Table start position
   TableStartPos:= AStream.Position;                   // memorize Table start position
-  ReadUShort(AStream);                  // skip 2 bytes - Format
-  Count:=ReadUShort(AStream);                        // 2 bytes
-  StringOffset:=ReadUShort(AStream);                 // 2 bytes
+  ReadUInt16(AStream);                  // skip 2 bytes - Format
+  Count:=ReadUInt16(AStream);                        // 2 bytes
+  StringOffset:=ReadUInt16(AStream);                 // 2 bytes
   E := FNameEntries;
   E := FNameEntries;
   SetLength(E,Count);
   SetLength(E,Count);
   FillMem(@N, SizeOf(TNameRecord), 0);
   FillMem(@N, SizeOf(TNameRecord), 0);
@@ -706,16 +708,16 @@ begin
     // Read remaining 7 fields' data depending on version
     // Read remaining 7 fields' data depending on version
     if Version>=1 then
     if Version>=1 then
       begin
       begin
-      ulCodePageRange1:=ReadULong(AStream);
-      ulCodePageRange2:=ReadULong(AStream);
+      ulCodePageRange1:=ReadUInt32(AStream);
+      ulCodePageRange2:=ReadUInt32(AStream);
       end;
       end;
     if Version>=2 then
     if Version>=2 then
       begin
       begin
-      sxHeight:=ReadShort(AStream);
-      sCapHeight:=ReadShort(AStream);
-      usDefaultChar:=ReadUShort(AStream);
-      usBreakChar:=ReadUShort(AStream);
-      usMaxContext:=ReadUShort(AStream);
+      sxHeight:=ReadInt16(AStream);
+      sCapHeight:=ReadInt16(AStream);
+      usDefaultChar:=ReadUInt16(AStream);
+      usBreakChar:=ReadUInt16(AStream);
+      usMaxContext:=ReadUInt16(AStream);
       end;
       end;
     end;
     end;
 end;
 end;

+ 382 - 80
packages/fcl-pdf/src/fppdf.pp

@@ -141,7 +141,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFBoolean = class(TPDFObject)
+  TPDFBoolean = class(TPDFDocumentObject)
   private
   private
     FValue: Boolean;
     FValue: Boolean;
   protected
   protected
@@ -151,7 +151,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFMoveTo = class(TPDFObject)
+  TPDFMoveTo = class(TPDFDocumentObject)
   private
   private
     FPos : TPDFCoord;
     FPos : TPDFCoord;
   protected
   protected
@@ -164,7 +164,31 @@ type
   end;
   end;
 
 
 
 
-  TPDFInteger = class(TPDFObject)
+  TPDFResetPath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFClosePath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFStrokePath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFInteger = class(TPDFDocumentObject)
   private
   private
     FInt: integer;
     FInt: integer;
   protected
   protected
@@ -176,7 +200,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFReference = class(TPDFObject)
+  TPDFReference = class(TPDFDocumentObject)
   private
   private
     FValue: integer;
     FValue: integer;
   protected
   protected
@@ -187,7 +211,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFName = class(TPDFObject)
+  TPDFName = class(TPDFDocumentObject)
   private
   private
     FName : string;
     FName : string;
     FMustEscape: boolean;
     FMustEscape: boolean;
@@ -260,7 +284,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFStream = class(TPDFObject)
+  TPDFStream = class(TPDFDocumentObject)
   private
   private
     FItems: TFPObjectList;
     FItems: TFPObjectList;
   protected
   protected
@@ -272,7 +296,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFEmbeddedFont = class(TPDFObject)
+  TPDFEmbeddedFont = class(TPDFDocumentObject)
   private
   private
     FTxtFont: integer;
     FTxtFont: integer;
     FTxtSize: string;
     FTxtSize: string;
@@ -284,7 +308,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFText = class(TPDFObject)
+  TPDFText = class(TPDFDocumentObject)
   private
   private
     FX: TPDFFloat;
     FX: TPDFFloat;
     FY: TPDFFloat;
     FY: TPDFFloat;
@@ -302,7 +326,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFUTF8Text = class(TPDFObject)
+  TPDFUTF8Text = class(TPDFDocumentObject)
   private
   private
     FX: TPDFFloat;
     FX: TPDFFloat;
     FY: TPDFFloat;
     FY: TPDFFloat;
@@ -323,13 +347,15 @@ type
   TPDFLineSegment = class(TPDFDocumentObject)
   TPDFLineSegment = class(TPDFDocumentObject)
   private
   private
     FWidth: TPDFFloat;
     FWidth: TPDFFloat;
+    FStroke: boolean;
     P1, p2: TPDFCoord;
     P1, p2: TPDFCoord;
   protected
   protected
     procedure Write(const AStream: TStream); override;
     procedure Write(const AStream: TStream); override;
   public
   public
-    Class Function Command(APos : TPDFCoord) : String;
-    Class Function Command(APos1,APos2 : TPDFCoord) : String;
-    constructor Create(Const ADocument : TPDFDocument; const AWidth, X1,Y1, X2,Y2: TPDFFloat);overload;
+    Class Function Command(APos : TPDFCoord) : String; overload;
+    Class Function Command(x1, y1 : TPDFFloat) : String; overload;
+    Class Function Command(APos1, APos2 : TPDFCoord) : String; overload;
+    constructor Create(Const ADocument : TPDFDocument; const AWidth, X1,Y1, X2,Y2: TPDFFloat; const AStroke: Boolean = True); overload;
   end;
   end;
 
 
 
 
@@ -347,18 +373,33 @@ type
   end;
   end;
 
 
 
 
+  TPDFRoundedRectangle = class(TPDFDocumentObject)
+  private
+    FWidth: TPDFFloat;
+    FBottomLeft: TPDFCoord;
+    FDimensions: TPDFCoord;
+    FFill: Boolean;
+    FStroke: Boolean;
+    FRadius: TPDFFloat;
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; const APosX, APosY, AWidth, AHeight, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);overload;
+  end;
+
+
   TPDFCurveC = class(TPDFDocumentObject)
   TPDFCurveC = class(TPDFDocumentObject)
   private
   private
-    FP1,FP2,FP3: TPDFCoord;
+    FCtrl1, FCtrl2, FTo: TPDFCoord;
     FWidth: TPDFFloat;
     FWidth: TPDFFloat;
     FStroke: Boolean;
     FStroke: Boolean;
   protected
   protected
-    Class Function Command(Const X1,Y1,X2,Y2,X3,Y3 : TPDFFloat) : String; overload;
-    Class Function Command(Const AP1,AP2,AP3: TPDFCoord) : String; overload;
+    Class Function Command(Const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo: TPDFFloat): String; overload;
+    Class Function Command(Const ACtrl1, ACtrl2, ATo3: TPDFCoord): String; overload;
     procedure Write(const AStream: TStream); override;
     procedure Write(const AStream: TStream); override;
   public
   public
-    constructor Create(Const ADocument : TPDFDocument; const X1,Y1,X2,Y2,X3,Y3,AWidth : TPDFFloat;AStroke: Boolean = True);overload;
-    constructor Create(Const ADocument : TPDFDocument; const AP1,AP2,AP3 : TPDFCoord; AWidth: TPDFFloat; AStroke: Boolean = True);overload;
+    constructor Create(Const ADocument : TPDFDocument; const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, AWidth: TPDFFloat; AStroke: Boolean = True);overload;
+    constructor Create(Const ADocument : TPDFDocument; const ACtrl1, ACtrl2, ATo3: TPDFCoord; AWidth: TPDFFloat; AStroke: Boolean = True);overload;
   end;
   end;
 
 
 
 
@@ -402,7 +443,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFSurface = class(TPDFObject)
+  TPDFSurface = class(TPDFDocumentObject)
   private
   private
     FPoints: TPDFCoordArray;
     FPoints: TPDFCoordArray;
     FFill : Boolean;
     FFill : Boolean;
@@ -426,7 +467,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFLineStyle = class(TPDFObject)
+  TPDFLineStyle = class(TPDFDocumentObject)
   private
   private
     FStyle: TPDFPenStyle;
     FStyle: TPDFPenStyle;
     FPhase: integer;
     FPhase: integer;
@@ -450,7 +491,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFDictionaryItem = class(TPDFObject)
+  TPDFDictionaryItem = class(TPDFDocumentObject)
   private
   private
     FKey: TPDFName;
     FKey: TPDFName;
     FObj: TPDFObject;
     FObj: TPDFObject;
@@ -493,7 +534,7 @@ type
   end;
   end;
 
 
 
 
-  TPDFXRef = class(TPDFObject)
+  TPDFXRef = class(TPDFDocumentObject)
   private
   private
     FOffset: integer;
     FOffset: integer;
     FDict: TPDFDictionary;
     FDict: TPDFDictionary;
@@ -562,13 +603,15 @@ type
     { output coordinate is the font baseline. }
     { output coordinate is the font baseline. }
     Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String); overload;
     Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String); overload;
     Procedure WriteText(APos: TPDFCoord; AText : UTF8String); overload;
     Procedure WriteText(APos: TPDFCoord; AText : UTF8String); overload;
-    procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat); overload;
-    procedure DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat); overload;
+    procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat; const AStroke: Boolean = True); overload;
+    procedure DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat; const AStroke: Boolean = True); overload;
     Procedure DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer); overload;
     Procedure DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer); overload;
     Procedure DrawLineStyle(APos1: TPDFCoord; APos2: TPDFCoord; AStyle: Integer); overload;
     Procedure DrawLineStyle(APos1: TPDFCoord; APos2: TPDFCoord; AStyle: Integer); overload;
     { X, Y coordinates are the bottom-left coordinate of the rectangle. The W and H parameters are in the UnitOfMeasure units. }
     { X, Y coordinates are the bottom-left coordinate of the rectangle. The W and H parameters are in the UnitOfMeasure units. }
     Procedure DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
     Procedure DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
     Procedure DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
     Procedure DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
+    { X, Y coordinates are the bottom-left coordinate of the rectangle. The W and H parameters are in the UnitOfMeasure units. }
+    procedure DrawRoundedRect(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean);
     { X, Y coordinates are the bottom-left coordinate of the image. AWidth and AHeight are in image pixels. }
     { X, Y coordinates are the bottom-left coordinate of the image. AWidth and AHeight are in image pixels. }
     Procedure DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer); overload;
     Procedure DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer); overload;
     Procedure DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer); overload;
     Procedure DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer); overload;
@@ -580,6 +623,34 @@ type
       cause the ellpise to draw to the left of the origin point. }
       cause the ellpise to draw to the left of the origin point. }
     Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
     Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
     Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
     Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
+    procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+    { start a new subpath }
+    procedure ResetPath;
+    { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
+    procedure ClosePath;
+    { render the actual path }
+    procedure StrokePath;
+    { Move the current drawing position to (x, y) }
+    procedure MoveTo(x, y: TPDFFloat); overload;
+    procedure MoveTo(APos: TPDFCoord); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using (xCtrl1, yCtrl1) and (xCtrl2, yCtrl2) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveTo(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveTo(ACtrl1, ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using the current point and (xCtrl2, yCtrl2) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveToV(xCtrl2, yCtrl2, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveToV(ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using (xCtrl1, yCtrl1) and (xTo, yTo) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveToY(xCtrl1, yCtrl1, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveToY(ACtrl1, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
     { Define a rectangle that becomes a clickable hotspot, referencing the URI argument. }
     { Define a rectangle that becomes a clickable hotspot, referencing the URI argument. }
     Procedure AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const AURI: string; ABorder: boolean = false);
     Procedure AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const AURI: string; ABorder: boolean = false);
     { This returns the paper height, converted to whatever UnitOfMeasure is set too }
     { This returns the paper height, converted to whatever UnitOfMeasure is set too }
@@ -914,6 +985,7 @@ type
     Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFontIndex: integer) : TPDFText; overload;
     Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFontIndex: integer) : TPDFText; overload;
     Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer) : TPDFUTF8Text; overload;
     Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer) : TPDFUTF8Text; overload;
     Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
     Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
+    function CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRoundedRectangle;
     Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
     Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
     Function CreateBoolean(AValue : Boolean) : TPDFBoolean;
     Function CreateBoolean(AValue : Boolean) : TPDFBoolean;
     Function CreateInteger(AValue : Integer) : TPDFInteger;
     Function CreateInteger(AValue : Integer) : TPDFInteger;
@@ -1037,6 +1109,10 @@ const
   // pixels = (mm * dpi) / 25.4
   // pixels = (mm * dpi) / 25.4
   // cm = ((pixels * 25.4) / dpi) / 10
   // cm = ((pixels * 25.4) / dpi) / 10
 
 
+const
+  // see http://paste.lisp.org/display/1105
+  BEZIER: single = 0.5522847498; // = 4/3 * (sqrt(2) - 1);
+
 
 
 function DateToPdfDate(const ADate: TDateTime): string;
 function DateToPdfDate(const ADate: TDateTime): string;
 begin
 begin
@@ -1396,6 +1472,43 @@ begin
   FPos:=APos;
   FPos:=APos;
 end;
 end;
 
 
+{ TPDFResetPath }
+
+procedure TPDFResetPath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFResetPath.Command: string;
+begin
+  Result := 'n' + CRLF;
+end;
+
+{ TPDFClosePath }
+
+procedure TPDFClosePath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFClosePath.Command: string;
+begin
+  Result := 'h' + CRLF;
+end;
+
+{ TPDFStrokePath }
+
+procedure TPDFStrokePath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFStrokePath.Command: string;
+begin
+  Result := 'S' + CRLF;
+end;
+
+
 { TPDFEllipse }
 { TPDFEllipse }
 
 
 procedure TPDFEllipse.Write(const AStream: TStream);
 procedure TPDFEllipse.Write(const AStream: TStream);
@@ -1409,8 +1522,8 @@ begin
   Y:=FCenter.Y;
   Y:=FCenter.Y;
   W2:=FDimensions.X/2;
   W2:=FDimensions.X/2;
   H2:=FDimensions.Y/2;
   H2:=FDimensions.Y/2;
-  WS:=W2*11/20;
-  HS:=H2*11/20;
+  WS:=W2*BEZIER;
+  HS:=H2*BEZIER;
   // Starting point
   // Starting point
   WriteString(TPDFMoveTo.Command(X,Y+H2),AStream);
   WriteString(TPDFMoveTo.Command(X,Y+H2),AStream);
   WriteString(TPDFCurveC.Command(X, Y+H2-HS, X+W2-WS, Y, X+W2, Y),AStream);
   WriteString(TPDFCurveC.Command(X, Y+H2-HS, X+W2-WS, Y, X+W2, Y),AStream);
@@ -1517,49 +1630,50 @@ end;
 
 
 { TPDFCurveC }
 { TPDFCurveC }
 
 
-class function TPDFCurveC.Command(const X1, Y1, X2, Y2, X3, Y3: TPDFFloat
-  ): String;
+class function TPDFCurveC.Command(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo: TPDFFloat): String;
 begin
 begin
-  Result:=FloatStr(X1)+' '+FloatStr(Y1)+' '+
-          FloatStr(X2)+' '+FloatStr(Y2)+' '+
-          FloatStr(X3)+' '+FloatStr(Y3)+' c'+CRLF
+  Result:=FloatStr(xCtrl1)+' '+FloatStr(yCtrl1)+' '+
+          FloatStr(xCtrl2)+' '+FloatStr(yCtrl2)+' '+
+          FloatStr(xTo)+' '+FloatStr(yTo)+' c'+CRLF
 end;
 end;
 
 
-class function TPDFCurveC.Command(const AP1, AP2, AP3: TPDFCoord): String;
+class function TPDFCurveC.Command(const ACtrl1, ACtrl2, ATo3: TPDFCoord): String;
 begin
 begin
-  Result:=Command(AP1.X,AP1.Y,AP2.X,AP2.Y,AP3.X,AP3.Y);
+  Result := Command(ACtrl1.X, ACtrl1.Y, ACtrl2.X, ACtrl2.Y, ATo3.X, ATo3.Y);
 end;
 end;
 
 
 procedure TPDFCurveC.Write(const AStream: TStream);
 procedure TPDFCurveC.Write(const AStream: TStream);
 begin
 begin
   if FStroke then
   if FStroke then
-    SetWidth(FWidth,AStream);
-  WriteString(Command(FP1,FP2,FP3),AStream);
+    SetWidth(FWidth, AStream);
+  WriteString(Command(FCtrl1, FCtrl2, FTo), AStream);
   if FStroke then
   if FStroke then
     WriteString('S'+CRLF, AStream);
     WriteString('S'+CRLF, AStream);
 end;
 end;
 
 
-constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const X1, Y1, X2, Y2, X3, Y3,AWidth: TPDFFloat;AStroke: Boolean = True);
+constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo,
+  AWidth: TPDFFloat; AStroke: Boolean);
 begin
 begin
   Inherited Create(ADocument);
   Inherited Create(ADocument);
-  FP1.X:=X1;
-  FP1.Y:=Y1;
-  FP2.X:=X2;
-  FP2.Y:=Y2;
-  FP3.X:=X3;
-  FP3.Y:=Y3;
-  FWidth:=AWidth;
-  FStroke:=AStroke;
+  FCtrl1.X := xCtrl1;
+  FCtrl1.Y := yCtrl1;
+  FCtrl2.X := xCtrl2;
+  FCtrl2.Y := yCtrl2;
+  FTo.X := xTo;
+  FTo.Y := yTo;
+  FWidth := AWidth;
+  FStroke := AStroke;
 end;
 end;
 
 
-constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const AP1, AP2, AP3: TPDFCoord; AWidth: TPDFFloat;AStroke: Boolean = True);
+constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const ACtrl1, ACtrl2, ATo3: TPDFCoord;
+    AWidth: TPDFFloat; AStroke: Boolean);
 begin
 begin
   Inherited Create(ADocument);
   Inherited Create(ADocument);
-  FP1:=AP1;
-  FP2:=AP2;
-  FP3:=AP3;
-  FWidth:=AWidth;
-  FStroke:=AStroke;
+  FCtrl1 := ACtrl1;
+  FCtrl2 := ACtrl2;
+  FTo := ATo3;
+  FWidth := AWidth;
+  FStroke := AStroke;
 end;
 end;
 
 
 { TPDFLineStyleDefs }
 { TPDFLineStyleDefs }
@@ -1878,7 +1992,7 @@ begin
   WriteText(APos.X, APos.Y, AText);
   WriteText(APos.X, APos.Y, AText);
 end;
 end;
 
 
-procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat);
+procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat; const AStroke: Boolean = True);
 var
 var
   L : TPDFLineSegment;
   L : TPDFLineSegment;
   p1, p2: TPDFCoord;
   p1, p2: TPDFCoord;
@@ -1887,13 +2001,13 @@ begin
   p2 := Matrix.Transform(X2, Y2);
   p2 := Matrix.Transform(X2, Y2);
   DoUnitConversion(p1);
   DoUnitConversion(p1);
   DoUnitConversion(p2);
   DoUnitConversion(p2);
-  L := TPDFLineSegment.Create(Document, ALineWidth, p1.X, p1.Y, p2.X, p2.Y);
+  L := TPDFLineSegment.Create(Document, ALineWidth, p1.X, p1.Y, p2.X, p2.Y, AStroke);
   AddObject(L);
   AddObject(L);
 end;
 end;
 
 
-procedure TPDFPage.DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat);
+procedure TPDFPage.DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat; const AStroke: Boolean = True);
 begin
 begin
-  DrawLine(APos1.X, APos1.Y, APos2.X, APos2.Y, ALineWidth);
+  DrawLine(APos1.X, APos1.Y, APos2.X, APos2.Y, ALineWidth, AStroke);
 end;
 end;
 
 
 procedure TPDFPage.DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer);
 procedure TPDFPage.DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer);
@@ -1930,6 +2044,23 @@ begin
   DrawRect(APos.X, APos.Y, W, H, ALineWidth, AFill, AStroke);
   DrawRect(APos.X, APos.Y, W, H, ALineWidth, AFill, AStroke);
 end;
 end;
 
 
+procedure TPDFPage.DrawRoundedRect(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);
+var
+  R: TPDFRoundedRectangle;
+  p1, p2, p3: TPDFCoord;
+begin
+  p1 := Matrix.Transform(X, Y);
+  DoUnitConversion(p1);
+  p2.X := W;
+  p2.Y := H;
+  DoUnitConversion(p2);
+  p3.X := ARadius;
+  p3.Y := 0;
+  DoUnitConversion(p3);
+  R := Document.CreateRoundedRectangle(p1.X, p1.Y, p2.X, p2.Y, p3.X, ALineWidth, AFill, AStroke);
+  AddObject(R);
+end;
+
 procedure TPDFPage.DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer);
 procedure TPDFPage.DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer);
 var
 var
   p1: TPDFCoord;
   p1: TPDFCoord;
@@ -1980,6 +2111,95 @@ begin
   DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke);
   DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke);
 end;
 end;
 
 
+procedure TPDFPage.DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+var
+  i: integer;
+begin
+  if Length(APoints) < 2 then
+    Exit; { not enough points to draw a line. Should this raise an exception? }
+  for i := Low(APoints)+1 to High(APoints) do
+    DrawLine(APoints[i-1].X, APoints[i-1].Y, APoints[i].X, APoints[i].Y, ALineWidth, False);
+end;
+
+procedure TPDFPage.ResetPath;
+begin
+  AddObject(TPDFResetPath.Create(Document));
+end;
+
+procedure TPDFPage.ClosePath;
+begin
+  AddObject(TPDFClosePath.Create(Document));
+end;
+
+procedure TPDFPage.StrokePath;
+begin
+  AddObject(TPDFStrokePath.Create(Document));
+end;
+
+procedure TPDFPage.MoveTo(x, y: TPDFFloat);
+var
+  p1: TPDFCoord;
+begin
+  p1 := Matrix.Transform(x, y);
+  DoUnitConversion(p1);
+  AddObject(TPDFMoveTo.Create(Document, p1.x, p1.y));
+end;
+
+procedure TPDFPage.MoveTo(APos: TPDFCoord);
+begin
+  MoveTo(APos.X, APos.Y);
+end;
+
+procedure TPDFPage.CubicCurveTo(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p1, p2, p3: TPDFCoord;
+begin
+  p1 := Matrix.Transform(xCtrl1, yCtrl1);
+  DoUnitConversion(p1);
+  p2 := Matrix.Transform(xCtrl2, yCtrl2);
+  DoUnitConversion(p2);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveC.Create(Document, p1.x, p1.y, p2.x, p2.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveTo(ACtrl1, ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveTo(ACtrl1.X, ACtrl1.Y, ACtrl2.X, ACtrl2.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
+procedure TPDFPage.CubicCurveToV(xCtrl2, yCtrl2, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p2, p3: TPDFCoord;
+begin
+  p2 := Matrix.Transform(xCtrl2, yCtrl2);
+  DoUnitConversion(p2);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveV.Create(Document, p2.x, p2.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveToV(ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveToV(ACtrl2.X, ACtrl2.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
+procedure TPDFPage.CubicCurveToY(xCtrl1, yCtrl1, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p1, p3: TPDFCoord;
+begin
+  p1 := Matrix.Transform(xCtrl1, yCtrl1);
+  DoUnitConversion(p1);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveY.Create(Document, p1.x, p1.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveToY(ACtrl1, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveToY(ACtrl1.X, ACtrl1.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
 procedure TPDFPage.AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat;
 procedure TPDFPage.AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat;
     const AURI: string; ABorder: boolean);
     const AURI: string; ABorder: boolean);
 var
 var
@@ -2558,13 +2778,7 @@ var
   s: AnsiString;
   s: AnsiString;
 begin
 begin
   s := Utf8ToAnsi(FValue);
   s := Utf8ToAnsi(FValue);
-  if poCompressText in Document.Options then
-  begin
-    // TODO: Implement text compression
-    WriteString('('+s+')', AStream);
-  end
-  else
-    WriteString('('+s+')', AStream);
+  WriteString('('+s+')', AStream);
 end;
 end;
 
 
 constructor TPDFString.Create(Const ADocument : TPDFDocument; const AValue: string);
 constructor TPDFString.Create(Const ADocument : TPDFDocument; const AValue: string);
@@ -2587,13 +2801,7 @@ end;
 
 
 procedure TPDFUTF8String.Write(const AStream: TStream);
 procedure TPDFUTF8String.Write(const AStream: TStream);
 begin
 begin
-  if poCompressText in Document.Options then
-  begin
-    // TODO: Implement text compression
-    WriteString('<'+RemapedText+'>', AStream)
-  end
-  else
-    WriteString('<'+RemapedText+'>', AStream);
+  WriteString('<'+RemapedText+'>', AStream);
 end;
 end;
 
 
 constructor TPDFUTF8String.Create(const ADocument: TPDFDocument; const AValue: UTF8String; const AFontIndex: integer);
 constructor TPDFUTF8String.Create(const ADocument: TPDFDocument; const AValue: UTF8String; const AFontIndex: integer);
@@ -2800,7 +3008,8 @@ begin
   SetWidth(FWidth,AStream);
   SetWidth(FWidth,AStream);
   WriteString(TPDFMoveTo.Command(P1), AStream);
   WriteString(TPDFMoveTo.Command(P1), AStream);
   WriteString(Command(P2),AStream);
   WriteString(Command(P2),AStream);
-  WriteString('S'+CRLF, AStream);
+  if FStroke then
+    WriteString('S'+CRLF, AStream);
 end;
 end;
 
 
 class function TPDFLineSegment.Command(APos: TPDFCoord): String;
 class function TPDFLineSegment.Command(APos: TPDFCoord): String;
@@ -2808,13 +3017,18 @@ begin
   Result:=FloatStr(APos.X)+' '+FloatStr(APos.Y)+' l'+CRLF
   Result:=FloatStr(APos.X)+' '+FloatStr(APos.Y)+' l'+CRLF
 end;
 end;
 
 
+class function TPDFLineSegment.Command(x1, y1: TPDFFloat): String;
+begin
+  Result := FloatStr(x1)+' '+FloatStr(y1)+' l'+CRLF
+end;
+
 class function TPDFLineSegment.Command(APos1, APos2: TPDFCoord): String;
 class function TPDFLineSegment.Command(APos1, APos2: TPDFCoord): String;
 begin
 begin
   Result:=TPDFMoveTo.Command(APos1)+Command(APos2);
   Result:=TPDFMoveTo.Command(APos1)+Command(APos2);
 end;
 end;
 
 
-constructor TPDFLineSegment.Create(const ADocument: TPDFDocument; const AWidth,
-  X1, Y1, X2, Y2: TPDFFloat);
+constructor TPDFLineSegment.Create(const ADocument: TPDFDocument; const AWidth, X1, Y1, X2, Y2: TPDFFloat;
+  const AStroke: Boolean);
 begin
 begin
   inherited Create(ADocument);
   inherited Create(ADocument);
   FWidth:=AWidth;
   FWidth:=AWidth;
@@ -2822,8 +3036,11 @@ begin
   P1.Y:=Y1;
   P1.Y:=Y1;
   P2.X:=X2;
   P2.X:=X2;
   P2.Y:=Y2;
   P2.Y:=Y2;
+  FStroke := AStroke;
 end;
 end;
 
 
+{ TPDFRectangle }
+
 procedure TPDFRectangle.Write(const AStream: TStream);
 procedure TPDFRectangle.Write(const AStream: TStream);
 begin
 begin
   if FStroke then
   if FStroke then
@@ -2855,6 +3072,67 @@ begin
   FStroke := AStroke;
   FStroke := AStroke;
 end;
 end;
 
 
+{ TPDFRoundedRectangle }
+
+procedure TPDFRoundedRectangle.Write(const AStream: TStream);
+var
+  c: TPDFFloat;
+  x1, y1, x2, y2: TPDFFloat;
+begin
+  if FStroke then
+    SetWidth(FWidth, AStream);
+
+  // bottom left
+  x1 := FBottomLeft.X;
+  y1 := FBottomLeft.Y;
+
+  // top right
+  x2 := FBottomLeft.X + FDimensions.X;
+  y2 := FBottomLeft.Y + FDimensions.Y;
+
+  // radius
+  c := FRadius;
+
+  // Starting point is bottom left, then drawing anti-clockwise
+  WriteString(TPDFMoveTo.Command(x1+c, y1), AStream);
+  WriteString(TPDFLineSegment.Command(x2-c, y1), AStream);
+
+  WriteString(TPDFCurveC.Command(x2-c+BEZIER*c, y1,   x2, y1+c-BEZIER*c,   x2, y1+c), AStream);
+  WriteString(TPDFLineSegment.Command(x2, y2-c), AStream);
+
+  WriteString(TPDFCurveC.Command(x2, y2-c+BEZIER*c, x2-c+BEZIER*c, y2, x2-c, y2), AStream);
+  WriteString(TPDFLineSegment.Command(x1+c, y2), AStream);
+
+  WriteString(TPDFCurveC.Command(x1+c-BEZIER*c, y2, x1, y2-c+BEZIER*c, x1, y2-c), AStream);
+  WriteString(TPDFLineSegment.Command(x1, y1+c), AStream);
+
+  WriteString(TPDFCurveC.Command(x1, y1+c-BEZIER*c, x1+c-BEZIER*c, y1, x1+c, y1), AStream);
+  WriteString('h'+CRLF, AStream);
+
+  if FStroke and FFill then
+    WriteString('b'+CRLF, AStream)
+  else if FFill then
+    WriteString('f'+CRLF, AStream)
+  else if FStroke then
+    WriteString('S'+CRLF, AStream);
+end;
+
+constructor TPDFRoundedRectangle.Create(const ADocument: TPDFDocument; const APosX, APosY, AWidth, AHeight, ARadius,
+  ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);
+begin
+  inherited Create(ADocument);
+  FBottomLeft.X := APosX;
+  FBottomLeft.Y := APosY;
+  FDimensions.X := AWidth;
+  FDimensions.Y := AHeight;
+  FWidth := ALineWidth;
+  FFill := AFill;
+  FStroke := AStroke;
+  FRadius := ARadius;
+end;
+
+{ TPDFSurface }
+
 procedure TPDFSurface.Write(const AStream: TStream);
 procedure TPDFSurface.Write(const AStream: TStream);
 var
 var
   i: integer;
   i: integer;
@@ -3339,31 +3617,48 @@ end;
 procedure TPDFDocument.WriteObject(const AObject: integer; const AStream: TStream);
 procedure TPDFDocument.WriteObject(const AObject: integer; const AStream: TStream);
 var
 var
   M : TMemoryStream;
   M : TMemoryStream;
+  MCompressed: TMemoryStream;
   X : TPDFXRef;
   X : TPDFXRef;
+  PS: UInt64;
 begin
 begin
   TPDFObject.WriteString(IntToStr(AObject)+' 0 obj'+CRLF, AStream);
   TPDFObject.WriteString(IntToStr(AObject)+' 0 obj'+CRLF, AStream);
   X:=GlobalXRefs[AObject];
   X:=GlobalXRefs[AObject];
   if X.FStream = nil then
   if X.FStream = nil then
     X.Dict.WriteDictionary(AObject, AStream)
     X.Dict.WriteDictionary(AObject, AStream)
   else
   else
+  begin
+    CurrentColor := '';
+    CurrentWidth := '';
+
+    M := TMemoryStream.Create;
+    X.FStream.Write(M);
+    X.Dict.AddInteger('Length', M.Size);
+
+    if poCompressText in Options then
     begin
     begin
-    M:=TMemoryStream.Create;
-    try
-      CurrentColor:='';
-      CurrentWidth:='';
-      X.FStream.Write(M);
-      X.Dict.AddInteger('Length',M.Size);
-    finally
-      M.Free;
+      MCompressed := TMemoryStream.Create;
+      CompressStream(M, MCompressed);
+      MCompressed.Position := 0;
+      X.Dict.AddName('Filter', 'FlateDecode');
+      X.Dict.AddInteger('Length1', MCompressed.Size);
     end;
     end;
+
     X.Dict.Write(AStream);
     X.Dict.Write(AStream);
+    M.Free;
+
     // write stream in contents dictionary
     // write stream in contents dictionary
     CurrentColor:='';
     CurrentColor:='';
     CurrentWidth:='';
     CurrentWidth:='';
     TPDFObject.WriteString(CRLF+'stream'+CRLF, AStream);
     TPDFObject.WriteString(CRLF+'stream'+CRLF, AStream);
-    X.FStream.Write(AStream);
+    if poCompressText in Options then
+    begin
+      MCompressed.SaveToStream(AStream);
+      MCompressed.Free;
+    end
+    else
+      X.FStream.Write(AStream);
     TPDFObject.WriteString('endstream', AStream);
     TPDFObject.WriteString('endstream', AStream);
-    end;
+  end;
   TPDFObject.WriteString(CRLF+'endobj'+CRLF+CRLF, AStream);
   TPDFObject.WriteString(CRLF+'endobj'+CRLF+CRLF, AStream);
 end;
 end;
 
 
@@ -4147,6 +4442,12 @@ begin
   Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
   Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
 end;
 end;
 
 
+function TPDFDocument.CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat;
+    const AFill, AStroke: Boolean): TPDFRoundedRectangle;
+begin
+  Result := TPDFRoundedRectangle.Create(Self, X, Y, W, H, ARadius, ALineWidth, AFill, AStroke);
+end;
+
 function TPDFDocument.CreateColor(AColor: TARGBColor; AStroke: Boolean): TPDFColor;
 function TPDFDocument.CreateColor(AColor: TARGBColor; AStroke: Boolean): TPDFColor;
 begin
 begin
   Result:=TPDFColor.Create(Self,AStroke,AColor);
   Result:=TPDFColor.Create(Self,AStroke,AColor);
@@ -4276,5 +4577,6 @@ begin
 end;
 end;
 
 
 
 
+
 end.
 end.
 
 

+ 19 - 19
packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -478,22 +478,17 @@ var
 begin
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
 
 
-  //dt := IncSecond(dt, FI.Head.Created);
-
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
   dt := MacToDateTime(FI.Head.Created);
 
 
-  // We don't use this AssertEquals() because it shows a huge Double data-type
-  // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 11, 2, 31, 0), dt);
 
 
   // Instead we use this - which shows human readable dates.
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 end;
 
 
 procedure TTestLiberationFont.TestHead_Modified;
 procedure TTestLiberationFont.TestHead_Modified;
@@ -501,9 +496,13 @@ var
   dt: TDateTime;
   dt: TDateTime;
   s: string;
   s: string;
 begin
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+
   dt := MacToDateTime(FI.Head.Modified);
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 end;
 
 
 procedure TTestLiberationFont.TestHead_BBox_xMin;
 procedure TTestLiberationFont.TestHead_BBox_xMin;
@@ -1259,22 +1258,20 @@ var
 begin
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
 
 
-  //dt := IncSecond(dt, FI.Head.Created);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
 
 
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
   dt := MacToDateTime(FI.Head.Created);
 
 
   // We don't use this AssertEquals() because it shows a huge Double data-type
   // We don't use this AssertEquals() because it shows a huge Double data-type
   // value as the result.
   // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 5, 3, 13, 34, 25, 0), dt);
 
 
   // Instead we use this - which shows human readable dates.
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 end;
 
 
 procedure TTestFreeSansFont.TestHead_Modified;
 procedure TTestFreeSansFont.TestHead_Modified;
@@ -1282,9 +1279,12 @@ var
   dt: TDateTime;
   dt: TDateTime;
   s: string;
   s: string;
 begin
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
   dt := MacToDateTime(FI.Head.Modified);
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 end;
 
 
 procedure TTestFreeSansFont.TestHead_BBox_xMin;
 procedure TTestFreeSansFont.TestHead_BBox_xMin;