* Fix font encoding and unicode issues, rework tests to work with val()

git-svn-id: trunk@33401 -

packages/fcl-pdf/examples/testfppdf.lpr

@@ -1,40 +1,87 @@
-{ This program generatesa multi-page PDF document and tests various
-  functionality on each of the 5 pages. }
-{$mode objfpc}
-{$H+}
+{ This program generates a multi-page PDF document and tests various
+  functionality on each of the 5 pages.
+
+  You can also specify to generate single pages by using the -p <n>
+  command line parameter.
+     eg:   testfppdf -p 1
+           testfppdf -p 2
+
+  Use -h to see more command line parameter options.
+}
 program testfppdf;
 
+{$mode objfpc}{$H+}
+{$codepage utf8}
+
 uses
-  classes, sysutils, fpimage, fpreadjpeg, freetype, fppdf;
+  {$ifdef unix}cwstring,{$endif}
+  classes, sysutils, custapp, fpimage, fpreadjpeg, fppdf, fpparsettf;
+
+type
+
+  TPDFTestApp = class(TCustomApplication)
+  private
+    Fpg: integer;
+    FFontCompression: 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);
+  protected
+    procedure   DoRun; override;
+  public
+    procedure   WriteHelp;
+  end;
 
-Function SetUpDocument : TPDFDocument;
-Var
-  P : TPDFPage;
-  S : TPDFSection;
+
+var
+  Application: TPDFTestApp;
+
+
+function TPDFTestApp.SetUpDocument: TPDFDocument;
+var
+  P: TPDFPage;
+  S: TPDFSection;
   i: integer;
+  lPageCount: integer;
+  lOpts: TPDFOptions;
 begin
-  Result:=TPDFDocument.Create(Nil);
-  Result.Infos.Title := 'Test Document';
-  Result.Infos.Author := ApplicationName;
-  Result.Infos.Producer:='fpGUI Toolkit 0.8';
-  Result.Infos.ApplicationName:='pdf_demo';
-  Result.Infos.CreationDate:=Now;
+  Result := TPDFDocument.Create(Nil);
+  Result.Infos.Title := Application.Title;
+  Result.Infos.Author := 'Graeme Geldenhuys';
+  Result.Infos.Producer := 'fpGUI Toolkit 0.8';
+  Result.Infos.ApplicationName := ApplicationName;
+  Result.Infos.CreationDate := Now;
+
+  lOpts := [];
+  if FFontCompression then
+    Include(lOpts, poCompressFonts);
+  Result.Options := lOpts;
+
   Result.StartDocument;
-  S:=Result.Sections.AddSection; // we always need at least one section
-  for i := 1 to 5 do
+  S := Result.Sections.AddSection; // we always need at least one section
+  lPageCount := 5;
+  if Fpg <> -1 then
+    lPageCount := 1;
+  for i := 1 to lPageCount do
   begin
-    P:=Result.Pages.AddPage;
+    P := Result.Pages.AddPage;
     P.PaperType := ptA4;
     P.UnitOfMeasure := uomMillimeters;
     S.AddPage(P);
   end;
 end;
 
-Procedure SaveDocument(D : TPDFDocument);
-Var
-  F : TFileStream;
+procedure TPDFTestApp.SaveDocument(D : TPDFDocument);
+var
+  F: TFileStream;
 begin
-  F:=TFileStream.Create('test.pdf',fmCreate);
+  F := TFileStream.Create('test.pdf',fmCreate);
   try
     D.SaveToStream(F);
     Writeln('Document used ',D.ObjectCount,' PDF objects/commands');
@@ -43,48 +90,95 @@ begin
   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 SimpleText(D: TPDFDocument; APage: integer);
-Var
+procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
+var
   P : TPDFPage;
-  FtTitle, FtText1, FtText2: integer;
+  FtTitle, FtText1, FtText2, FtText3: integer;
   lPt1: TPDFCoord;
 begin
-  P:=D.Pages[APage];
+  P := D.Pages[APage];
+
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clRed);
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans-12', clGreen); // TODO: this color value means nothing - not used at all
-  FtText2 := D.AddFont('times-8', clGreen);
+  FtTitle := D.AddFont('Helvetica', clRed);
+  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
+  FtText2 := D.AddFont('Times-BoldItalic', clBlack);
+  // FtText3 := D.AddFont('arial.ttf', 'Arial', clBlack);
+  FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
 
   { Page title }
-  P.SetFont(FtTitle,23);
+  P.SetFont(FtTitle, 23);
   P.SetColor(clBlack, false);
   lPt1 := P.Matrix.Transform(25, 20);
   P.WriteText(lPt1.X, lPt1.Y, 'Sample Text');
 
-  // Write text using FreeSans font
-  P.SetFont(ftText1,12);
-  P.SetColor(clBlack, false);
-  P.WriteText(25, P.GetPaperHeight-70, '(25mm,70mm) FreeSans: 0oO 1lL - wêreld çèûÎÐð£¢ß');
-  lPt1 := P.Matrix.Transform(25, 76);
-  P.WriteText(lPt1.X, lPt1.Y, '(25mm,76mm) - FreeSans font');
-
-  P.WriteUTF8Text(25, P.GetPaperHeight-200, 'Hello Graeme *'#$E2#$95#$AC'*'#$C3#$A4); // 0xE2 0x95 0xAC is UTF-8 for ╬   and   0xC3 0xA4 is UTF-8 for ä
-  lPt1 := P.Matrix.Transform(25, 210);
-  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'В субботу двадцать третьего мая приезжает твоя любимая теща.');
+  // Write text using PDF standard fonts
 
-  // Write text using Helvetica font
-  P.SetFont(ftText2,12);
+  P.SetFont(FtTitle, 12);
   P.SetColor(clBlue, false);
   lPt1 := P.Matrix.Transform(25, 50);
-  P.WriteText(lPt1.X, lPt1.Y, '(25mm,50mm) - Times: 0oO 1lL - wêreld çèûÎÐð£¢ß');
+  P.WriteText(lPt1.X, lPt1.Y, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
+
   P.SetFont(ftText2,16);
   P.SetColor($c00000, false);
-  lPt1 := P.Matrix.Transform(75, 100);
-  P.WriteText(lPt1.X, lPt1.Y, '(75mm,100mm) - Big text at absolute position');
+  lPt1 := P.Matrix.Transform(60, 100);
+  P.WriteText(lPt1.X, lPt1.Y, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
+
+  // TrueType testing purposes
+
+  P.SetFont(ftText3, 13);
+  P.SetColor(clBlack, false);
+
+  lPt1 := P.Matrix.Transform(15, 120);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Languages: English: Hello, World!');
+
+  lPt1 := P.Matrix.Transform(40, 130);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Greek: Γειά σου κόσμος');
+
+  lPt1 := P.Matrix.Transform(40, 140);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Polish: Witaj świecie');
+
+  lPt1 := P.Matrix.Transform(40, 150);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Portuguese: Olá mundo');
+
+  lPt1 := P.Matrix.Transform(40, 160);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Russian: Здравствулте мир');
+
+  lPt1 := P.Matrix.Transform(40, 170);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Vietnamese: Xin chào thế giới');
+
+
+  P.SetFont(ftText1, 13);
+  lPt1 := P.Matrix.Transform(15, 185);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
+
+  lPt1 := P.Matrix.Transform(15, 200);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'Typography: “What’s wrong?”');
+  lPt1 := P.Matrix.Transform(40, 210);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, '£17.99 vs £17·99');
+  lPt1 := P.Matrix.Transform(40, 220);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, '€17.99 vs €17·99');
+  lPt1 := P.Matrix.Transform(40, 230);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'OK then…    êçèûÎÐð£¢ß');
+
+  lPt1 := P.Matrix.Transform(25, 280);
+  P.WriteUTF8Text(lPt1.X, lPt1.Y, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
+
 end;
 
-Procedure SimpleLinesRaw(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
 var
   P: TPDFPage;
   FtTitle: integer;
@@ -92,42 +186,46 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
-  P.SetColor(clBlack, false);
+  P.SetColor(clBlack, False);
   lPt1 := P.Matrix.Transform(25, 20);
   P.WriteText(lPt1.X, lPt1.Y, 'Sample Line Drawing (DrawLine)');
 
-  P.SetColor(clBlack,False); // clblue
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsSolid);
   lPt1 := P.Matrix.Transform(30, 100);
   lPt2 := P.Matrix.Transform(150, 150);
   P.DrawLine(lPt1, lPt2, 0.2);
-  P.SetColor($0000FF,False); // clblue
+
+  P.SetColor(clBlue, True);
   P.SetPenStyle(ppsDash);
   lPt1 := P.Matrix.Transform(50, 70);
   lPt2 := P.Matrix.Transform(180, 100);
   P.DrawLine(lPt1, lPt2, 0.1);
-  P.SetColor($FF0000,False); // clRed
+
+  P.SetColor(clRed, True);
   P.SetPenStyle(ppsDashDot);
   lPt1 := P.Matrix.Transform(40, 140);
   lPt2 := P.Matrix.Transform(160, 80);
   P.DrawLine(lPt1, lPt2, 1);
-  P.SetColor(clBlack,False); // clBlack
+
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsDashDotDot);
   lPt1 := P.Matrix.Transform(60, 50);
   lPt2 := P.Matrix.Transform(60, 120);
   P.DrawLine(lPt1, lPt2, 1.5);
-  P.SetColor(clBlack,False); // clBlack
+
+  P.SetColor(clBlack, True);
   P.SetPenStyle(ppsDot);
   lPt1 := P.Matrix.Transform(10, 80);
   lPt2 := P.Matrix.Transform(130, 130);
   P.DrawLine(lPt1, lPt2, 0.5);
 end;
 
-Procedure SimpleLines(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
 var
   P: TPDFPage;
   FtTitle: integer;
@@ -136,7 +234,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clRed);
+  FtTitle := D.AddFont('Helvetica', clRed);
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -172,7 +270,7 @@ begin
   P.DrawLineStyle(lPt1.X, lPt1.Y, lPt2.X, lPt2.Y, tsThinBlackDot);  { just to test the other overloaded version too. }
 end;
 
-Procedure SimpleImage(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleImage(D: TPDFDocument; APage: integer);
 Var
   P: TPDFPage;
   FtTitle: integer;
@@ -182,7 +280,7 @@ Var
 begin
   P := D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -210,7 +308,7 @@ begin
   P.WriteText(lPt1.X, lPt1.Y, '[Default size]');
 end;
 
-Procedure SimpleShapes(D: TPDFDocument; APage: integer);
+procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
 Var
   P : TPDFPage;
   FtTitle: integer;
@@ -219,7 +317,7 @@ Var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('helvetica-12', clBlack);
+  FtTitle := D.AddFont('Helvetica', clBlack);
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -421,22 +519,110 @@ begin
   P.DrawLine(lPt2.X, lPt2.Y, lPt3.X, lPt3.Y, 5);
 end;
 
-Var
-  D: TPDFDocument;
+
+{ TPDFTestApp }
+
+procedure TPDFTestApp.DoRun;
+var
+  ErrorMsg: String;
+  v: integer;
 begin
-  D := SetupDocument;
-  try
-    D.FontDirectory := ExtractFIlePath(Paramstr(0))+'fonts'+PathDelim;
+  inherited DoRun;
+  // quick check parameters
+  ErrorMsg := CheckOptions('hp:f:', '');
+  if ErrorMsg <> '' then
+  begin
+    WriteLn('ERROR:  ' + ErrorMsg);
+    Writeln('');
+    Terminate;
+    Exit;
+  end;
 
-    SimpleText(D, 0);
-    SimpleShapes(D, 1);
-    SimpleLines(D, 2);
-    SimpleLinesRaw(D, 3);
-    SimpleImage(D, 4);
+  // parse parameters
+  if HasOption('h', '') then
+  begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
 
-    SaveDocument(D);
+  Fpg := -1;
+  if HasOption('p', '') then
+  begin
+    Fpg := StrToInt(GetOptionValue('p', ''));
+    if (Fpg < 1) or (Fpg > 5) then
+    begin
+      Writeln('Error in -p parameter. Valid range is 1-5.');
+      Writeln('');
+      Terminate;
+      Exit;
+    end;
+  end;
+
+  FFontCompression := True;
+  if HasOption('f', '') then
+  begin
+    v := StrToInt(GetOptionValue('f', ''));
+    if (v <> 0) and (v <> 1) then
+    begin
+      Writeln('Error in -f parameter. Valid range is 0-1.');
+      Writeln('');
+      Terminate;
+      Exit;
+    end;
+    FFontCompression := (v = 1);
+  end;
+
+  FDoc := SetupDocument;
+  try
+    FDoc.FontDirectory := 'fonts';
+
+    if Fpg = -1 then
+    begin
+      SimpleText(FDoc, 0);
+      SimpleShapes(FDoc, 1);
+      SimpleLines(FDoc, 2);
+      SimpleLinesRaw(FDoc, 3);
+      SimpleImage(FDoc, 4);
+    end
+    else
+    begin
+      case Fpg of
+        1:  SimpleText(FDoc, 0);
+        2:  SimpleShapes(FDoc, 0);
+        3:  SimpleLines(FDoc, 0);
+        4:  SimpleLinesRaw(FDoc, 0);
+        5:  SimpleImage(FDoc, 0);
+      end;
+    end;
+
+    SaveDocument(FDoc);
   finally
-    D.Free;
+    FDoc.Free;
   end;
+
+  // stop program loop
+  Terminate;
+end;
+
+procedure TPDFTestApp.WriteHelp;
+begin
+  writeln('Usage:');
+  writeln('    -h          Show this help.');
+  writeln('    -p <n>      Generate only one page. Valid range is 1-5.' + LineEnding +
+          '                If this option is not specified, then all 5 pages are' + LineEnding +
+          '                generated.');
+  writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
+          '                disables compression. A value of 1 enables compression.');
+  writeln('');
+end;
+
+
+
+begin
+  Application := TPDFTestApp.Create(nil);
+  Application.Title := 'fpPDF Test Application';
+  Application.Run;
+  Application.Free;
 end.
 

packages/fcl-pdf/src/fpparsettf.pp

@@ -51,8 +51,8 @@ type
     OriginalSize : integer;
   end;
 
-  TSmallintArray = Packed Array of Smallint;
-  TWordArray = Packed Array of Smallint;
+  TSmallintArray = Packed Array of Int16;
+  TWordArray = Packed Array of UInt16;
 
   TFixedVersionRec = packed record
     case Integer of
@@ -288,8 +288,6 @@ Type
     { Also know as the linegap. "Leading" is the gap between two lines. }
     Function Leading: SmallInt;
     Function CapHeight: SmallInt;
-    { Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. }
-    function GetGlyphIndex(AValue: word): word;
     { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. }
     function GetAdvanceWidth(AIndex: word): word;
   public
@@ -301,6 +299,8 @@ Type
     PostScriptName: string;
     FamilyName: string;
     destructor Destroy; override;
+    { Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. }
+    function  GetGlyphIndex(AValue: word): word;
     // Load a TTF file from file or stream.
     Procedure LoadFromFile(const AFileName : String);
     Procedure LoadFromStream(AStream: TStream); virtual;
@@ -653,16 +653,16 @@ begin
   FHead.Created := BEtoN(FHead.Created);
   FHead.Modified := BEtoN(FHead.Modified);
   For i:=0 to 3 do
-    FHead.BBox[i]:=betOn(FHead.BBox[i]);
-  FHead.CheckSumAdjustment:=beton(FHead.CheckSumAdjustment);
-  FHead.MagicNumber:=beton(FHead.MagicNumber);
-  FHead.Flags:=Beton(FHead.Flags);
-  FHead.UnitsPerEm:=beton(FHead.UnitsPerEm);
-  FHead.MacStyle:=Beton(FHead.MacStyle);
-  FHead.LowestRecPPEM:=Beton(FHead.LowestRecPPEM);
-  FHead.FontDirectionHint:=Beton(FHead.FontDirectionHint);
-  FHead.IndexToLocFormat:=Beton(FHead.IndexToLocFormat);
-  FHead.glyphDataFormat:=Beton(FHead.glyphDataFormat);
+    FHead.BBox[i]:=BEtoN(FHead.BBox[i]);
+  FHead.CheckSumAdjustment:=BEtoN(FHead.CheckSumAdjustment);
+  FHead.MagicNumber:=BEtoN(FHead.MagicNumber);
+  FHead.Flags:=BEtoN(FHead.Flags);
+  FHead.UnitsPerEm:=BEtoN(FHead.UnitsPerEm);
+  FHead.MacStyle:=BEtoN(FHead.MacStyle);
+  FHead.LowestRecPPEM:=BEtoN(FHead.LowestRecPPEM);
+  FHead.FontDirectionHint:=BEtoN(FHead.FontDirectionHint);
+  FHead.IndexToLocFormat:=BEtoN(FHead.IndexToLocFormat);
+  FHead.glyphDataFormat:=BEtoN(FHead.glyphDataFormat);
 end;
 
 procedure TTFFileInfo.ParseHhea(AStream : TStream);
@@ -671,19 +671,19 @@ begin
   AStream.ReadBuffer(FHHEad,SizeOf(FHHEad));
   if IsNativeData then
     exit;
-  FHHEad.TableVersion.Version := BeToN(FHHEad.TableVersion.Version);
+  FHHEad.TableVersion.Version := BEToN(FHHEad.TableVersion.Version);
   FHHEad.TableVersion.Minor := FixMinorVersion(FHHEad.TableVersion.Minor);
-  FHHEad.Ascender:=BeToN(FHHEad.Ascender);
-  FHHEad.Descender:=BeToN(FHHEad.Descender);
-  FHHEad.LineGap:=BeToN(FHHEad.LineGap);
-  FHHEad.MinLeftSideBearing:=BeToN(FHHEad.MinLeftSideBearing);
-  FHHEad.MinRightSideBearing:=BeToN(FHHEad.MinRightSideBearing);
-  FHHEad.XMaxExtent:=BeToN(FHHEad.XMaxExtent);
-  FHHEad.CaretSlopeRise:=BeToN(FHHEad.CaretSlopeRise);
-  FHHEad.CaretSlopeRun:=BeToN(FHHEad.CaretSlopeRun);
-  FHHEad.metricDataFormat:=BeToN(FHHEad.metricDataFormat);
-  FHHEad.numberOfHMetrics:=BeToN(FHHEad.numberOfHMetrics);
-  FHHead.AdvanceWidthMax := BeToN(FHHead.AdvanceWidthMax);
+  FHHEad.Ascender:=BEToN(FHHEad.Ascender);
+  FHHEad.Descender:=BEToN(FHHEad.Descender);
+  FHHEad.LineGap:=BEToN(FHHEad.LineGap);
+  FHHEad.MinLeftSideBearing:=BEToN(FHHEad.MinLeftSideBearing);
+  FHHEad.MinRightSideBearing:=BEToN(FHHEad.MinRightSideBearing);
+  FHHEad.XMaxExtent:=BEToN(FHHEad.XMaxExtent);
+  FHHEad.CaretSlopeRise:=BEToN(FHHEad.CaretSlopeRise);
+  FHHEad.CaretSlopeRun:=BEToN(FHHEad.CaretSlopeRun);
+  FHHEad.metricDataFormat:=BEToN(FHHEad.metricDataFormat);
+  FHHEad.numberOfHMetrics:=BEToN(FHHEad.numberOfHMetrics);
+  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
 end;
 
 procedure TTFFileInfo.ParseMaxp(AStream : TStream);
@@ -696,20 +696,20 @@ begin
     begin
     VersionNumber.Version := BEtoN(VersionNumber.Version);
     VersionNumber.Minor := FixMinorVersion(VersionNumber.Minor);
-    numGlyphs:=Beton(numGlyphs);
-    maxPoints:=Beton(maxPoints);
-    maxContours:=Beton(maxContours);
-    maxCompositePoints :=BeToN(maxCompositePoints);
-    maxCompositeContours :=BeToN(maxCompositeContours);
-    maxZones :=BeToN(maxZones);
-    maxTwilightPoints :=BeToN(maxTwilightPoints);
-    maxStorage :=BeToN(maxStorage);
-    maxFunctionDefs :=BeToN(maxFunctionDefs);
-    maxInstructionDefs :=BeToN(maxInstructionDefs);
-    maxStackElements :=BeToN(maxStackElements);
-    maxSizeOfInstructions :=BeToN(maxSizeOfInstructions);
-    maxComponentElements :=BeToN(maxComponentElements);
-    maxComponentDepth :=BeToN(maxComponentDepth);
+    numGlyphs:=BEtoN(numGlyphs);
+    maxPoints:=BEtoN(maxPoints);
+    maxContours:=BEtoN(maxContours);
+    maxCompositePoints :=BEtoN(maxCompositePoints);
+    maxCompositeContours :=BEtoN(maxCompositeContours);
+    maxZones :=BEtoN(maxZones);
+    maxTwilightPoints :=BEtoN(maxTwilightPoints);
+    maxStorage :=BEtoN(maxStorage);
+    maxFunctionDefs :=BEtoN(maxFunctionDefs);
+    maxInstructionDefs :=BEtoN(maxInstructionDefs);
+    maxStackElements :=BEtoN(maxStackElements);
+    maxSizeOfInstructions :=BEtoN(maxSizeOfInstructions);
+    maxComponentElements :=BEtoN(maxComponentElements);
+    maxComponentDepth :=BEtoN(maxComponentDepth);
     end;
 end;
 
@@ -725,8 +725,8 @@ begin
     exit;
   for I:=0 to FHHead.NumberOfHMetrics-1 do
     begin
-    FWidths[I].AdvanceWidth:=beton(FWidths[I].AdvanceWidth);
-    FWidths[I].LSB:=beton(FWidths[I].LSB);
+    FWidths[I].AdvanceWidth:=BEtoN(FWidths[I].AdvanceWidth);
+    FWidths[I].LSB:=BEtoN(FWidths[I].LSB);
     end;
 end;
 
@@ -1094,7 +1094,7 @@ begin
   TE:=GetEncoding(AEncoding);
   if (TE<>teUnknown) then
     GetEncodingTables(Te,CharNames,CharCodes);
-  // Needed to mak difference
+  // Needed to make difference
   GetEncodingTables(Te,CharBase,V);
 end;
 
@@ -1243,11 +1243,11 @@ end;
 
 function TTFFileInfo.Flags: Integer;
 begin
-  Result:=32;
+  Result := 32;
   if FPostScript.IsFixedPitch<>0 then
-    Result:=Result+1;
+    Result := Result+1;
   if FPostScript.ItalicAngle<>0 then
-    Flags:= Flags+64;
+    Result := Result+64;
 end;
 
 procedure TTFFileInfo.MakePDFFontDef(const FontFile: string; const Encoding:string; Embed: Boolean);

packages/fcl-pdf/src/fppdf.pp

@@ -3,9 +3,9 @@
     Copyright (c) 2014 by Michael Van Canneyt
 
     This unit generates PDF files, without dependencies on GUI libraries.
-    (Based on original ideas from the fpGUI pdf generator by Jean-Marc Levecque 
+    (Based on original ideas from the fpGUI pdf generator by Jean-Marc Levecque
      <[email protected]>)
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -26,7 +26,8 @@ uses
   StrUtils,
   contnrs,
   fpImage,
-  zstream;
+  zstream,
+  fpparsettf;
 
 Const
   clBlack = $000000;
@@ -165,7 +166,14 @@ type
   end;
 
 
-  TPDFString = class(TPDFDocumentObject)
+  TPDFAbstractString = class(TPDFDocumentObject)
+  protected
+    // These symbols must be preceded by a backslash:  "(", ")", "\"
+    function InsertEscape(const AValue: string): string;
+  end;
+
+
+  TPDFString = class(TPDFAbstractString)
   private
     FValue: string;
   protected
@@ -175,12 +183,12 @@ type
   end;
 
 
-  TPDFUTF8String = class(TPDFDocumentObject)
+  TPDFUTF8String = class(TPDFAbstractString)
   private
     FValue: UTF8String;
     FFontIndex: integer;
     { Remap each character to the equivalant dictionary character code }
-    function RemapedText: String;
+    function RemapedText: AnsiString;
   protected
     procedure Write(const AStream: TStream); override;
   public
@@ -558,6 +566,37 @@ type
   end;
 
 
+  // forward declarations
+  TTextMapping = class;
+
+
+  TTextMappingList = class(TObject)
+  private
+    FList: TFPObjectList;
+    function    GetCount: Integer;
+  protected
+    function    GetItem(AIndex: Integer): TTextMapping; reintroduce;
+    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); reintroduce;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function    Add(AObject: TTextMapping): Integer; overload;
+    function    Add(const ACharID, AGlyphID: uint16): Integer; overload;
+    property    Count: Integer read GetCount;
+    property    Items[Index: Integer]: TTextMapping read GetItem write SetItem; default;
+  end;
+
+
+  TTextMapping = class(TObject)
+  private
+    FCharID: uint16;
+    FGlyphID: uint16;
+  public
+    class function NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
+    property    CharID: uint16 read FCharID write FCharID;
+    property    GlyphID: uint16 read FGlyphID write FGlyphID;
+  end;
+
   TTextDictionary = class(TObject)
   private
     FChar: UnicodeChar;
@@ -571,17 +610,34 @@ type
   private
     FColor: TARGBColor;
     FName: String;
-    FFontFile: string;
-    { stores lookup code for each letter of text used and associated 2-byte Unicode code point }
-    FDictionary: TObjectList;
+    FFontFilename: String;
+    FTrueTypeFile: TTFFileInfo;
+    { stores mapping of Char IDs to font Glyph IDs }
+    FTextMappingList: TTextMappingList;
+    procedure   PrepareTextMapping;
+    procedure   SetFontFilename(AValue: string);
   public
-    constructor Create(ACollection: TCollection); override;
     destructor  Destroy; override;
-    function FindIndexOf(const AValue: UnicodeChar): integer;
-    Property FontFile: string read FFontFile write FFontFile;
-    Property Name : String Read FName Write FName;
-    Property Color : TARGBColor Read FColor Write FColor;
-    property Dictionary: TObjectList read FDictionary;
+    { Returns a string where each character is replaced with a glyph index value instead. }
+    function    GetGlyphIndices(const AText: UnicodeString): AnsiString;
+    procedure   AddTextToMappingList(const AText: UnicodeString);
+    Property    FontFile: string read FFontFilename write SetFontFilename;
+    Property    Name: String Read FName Write FName;
+    Property    Color: TARGBColor Read FColor Write FColor;
+    property    TextMapping: TTextMappingList read FTextMappingList;
+  end;
+
+
+  TPDFTrueTypeCharWidths = class(TPDFDocumentObject)
+  private
+    FEmbeddedFontNum: integer;
+    FFontIndex: integer;
+  protected
+    procedure Write(const AStream: TStream);override;
+  public
+    constructor Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer); overload;
+    property EmbeddedFontNum: integer read FEmbeddedFontNum;
+    property FontIndex: integer read FFontIndex write FFontIndex;
   end;
 
 
@@ -671,7 +727,6 @@ type
   end;
 
 
-
   TPDFLineStyleDef = Class(TCollectionItem)
   private
     FColor: TARGBColor;
@@ -744,11 +799,13 @@ type
     function LoadFont(AFont: TPDFFont; Out FontDef : TFontDef): string;
     procedure CreateStdFont(EmbeddedFontName: string; EmbeddedFontNum: integer);virtual;
     procedure CreateTTFFont(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual;
+    procedure CreateTTFDescendantFont(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual;
+    procedure CreateTTFCIDSystemInfo(const EmbeddedFontNum: integer; FontDef: TFontDef);virtual;
     procedure CreateTp1Font(const EmbeddedFontNum: integer);virtual;
     procedure CreateFontDescriptor(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual;
     procedure CreateToUnicode(const EmbeddedFontNum: integer; FontDef : TFontDef);virtual;
     procedure CreateFontWidth(FontDef : TFontDef);virtual;
-    procedure CreateFontFileEntry(const EmbeddedFontNum: integer;FontDef : TFontDef);virtual;
+    procedure CreateFontFileEntry(const EmbeddedFontNum: integer; FontDef: TFontDef);virtual;
     procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
     procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
     Function CreateGlobalXRef: TPDFXRef;
@@ -805,8 +862,9 @@ type
 
 
 const
-  CRLF        =#13#10;
-  PDF_VERSION ='%PDF-1.3';
+  CRLF = #13#10;
+  PDF_VERSION = '%PDF-1.3';
+  PDF_BINARY_BLOB = '%'#$C3#$A4#$C3#$BC#$C3#$B6#$C3#$9F;
   PDF_FILE_END = '%%EOF';
   PDF_MAX_GEN_NUM = 65535;
   PDF_UNICODE_HEADER = 'FEFF001B%s001B';
@@ -858,8 +916,6 @@ function InchesToPDF(Inches: single): TPDFFloat;
 
 implementation
 
-uses
-  fpparsettf;
 
 Resourcestring
   rsErrReportFontFileMissing = 'Font File "%s" does not exist.';
@@ -867,6 +923,12 @@ Resourcestring
   SerrInvalidSectionPage = 'Error: Invalid section page index.';
   SErrNoGlobalDict = 'Error: no global XRef named "%s".';
   SErrInvalidPageIndex = 'Invalid page index: %d';
+  SErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
+
+type
+  // to get access to protected methods
+  TTTFFriendClass = class(TTFFileInfo)
+  end;
 
 Const
   // TODO: we should improve this to take into account the line width
@@ -888,22 +950,6 @@ const
   // cm = ((pixels * 25.4) / dpi) / 10
 
 
-// These symbols must be preceded by a slash:  %, (, ), <, >, [, ], {, }, / and #
-function InsertEscape(const AValue: string): string;
-var
-  S: string;
-begin
-  Result:='';
-  S:=AValue;
-  if Pos('\', S) > 0 then
-    S:=AnsiReplaceStr(S, '\', '\\');
-  if Pos('(', S) > 0 then
-    S:=AnsiReplaceStr(S, '(', '\(');
-  if Pos(')', S) > 0 then
-    S:=AnsiReplaceStr(S, ')', '\)');
-  Result:=S;
-end;
-
 function DateToPdfDate(const ADate: TDateTime): string;
 begin
   Result:=FormatDateTime('"D:"yyyymmddhhnnss', ADate);
@@ -917,11 +963,6 @@ begin
     Result:=StringOfChar('0',Padlen)+Result;
 end;
 
-function IntToStrZeros(const AValue, ADigits: integer): string;
-begin
-   result := SysUtils.Format('%.*d', [ADigits, AValue]) ;
-end;
-
 procedure CompressStream(AFrom: TStream; ATo: TStream; ACompressLevel: TCompressionLevel = clDefault; ASkipHeader: boolean = False);
 var
   c: TCompressionStream;
@@ -1066,35 +1107,146 @@ begin
   Result.y := (APoint.y - _21) / _11;
 end;
 
+{ TTextMappingList }
+
+function TTextMappingList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
+begin
+  Result := TTextMapping(FList.Items[AIndex]);
+end;
+
+procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
+begin
+  FList.Items[AIndex] := AValue;
+end;
+
+constructor TTextMappingList.Create;
+begin
+  FList := TFPObjectList.Create;
+end;
+
+destructor TTextMappingList.Destroy;
+begin
+  FList.Free;
+  inherited Destroy;
+end;
+
+function TTextMappingList.Add(AObject: TTextMapping): Integer;
+var
+  i: integer;
+begin
+  Result := -1;
+  for i := 0 to FList.Count-1 do
+  begin
+    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
+      Exit; // mapping already exists
+  end;
+  Result := FList.Add(AObject);
+end;
+
+function TTextMappingList.Add(const ACharID, AGlyphID: uint16): Integer;
+var
+  o: TTextMapping;
+begin
+  o := TTextMapping.Create;
+  o.CharID := ACharID;
+  o.GlyphID := AGlyphID;
+  Result := Add(o);
+  if Result = -1 then
+    o.Free;
+end;
+
+{ TTextMapping }
+
+class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
+begin
+  Result := TTextMapping.Create;
+  Result.CharID := ACharID;
+  Result.GlyphID := AGlyphID;
+end;
+
 { TPDFFont }
 
-constructor TPDFFont.Create(ACollection: TCollection);
+procedure TPDFFont.PrepareTextMapping;
 begin
-  inherited Create(ACollection);
-  FDictionary := TObjectList.create;
+  if FFontFilename <> '' then
+  begin
+    // only create objects when needed
+    FTextMappingList := TTextMappingList.Create;
+    FTrueTypeFile := TTFFileInfo.Create;
+    FTrueTypeFile.LoadFromFile(FFontFilename);
+  end;
+end;
+
+procedure TPDFFont.SetFontFilename(AValue: string);
+begin
+  if FFontFilename = AValue then
+    Exit;
+  FFontFilename := AValue;
+  PrepareTextMapping;
 end;
 
 destructor TPDFFont.Destroy;
 begin
-  FDictionary.Free;
+  FTextMappingList.Free;
+  FTrueTypeFile.Free;
   inherited Destroy;
 end;
 
-function TPDFFont.FindIndexOf(const AValue: UnicodeChar): integer;
+function TPDFFont.GetGlyphIndices(const AText: UnicodeString): AnsiString;
 var
   i: integer;
+  c: word;
 begin
-  result := -1; // default to not found
-  for i := 0 to FDictionary.Count-1 do
+  Result := '';
+  for i := 1 to Length(AText) do
   begin
-    if TTextDictionary(FDictionary[i]).Char = AValue then
-    begin
-      result := i;
-      exit;
-    end;
+    c := Word(AText[i]);
+    Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4);
+  end;
+end;
+
+procedure TPDFFont.AddTextToMappingList(const AText: UnicodeString);
+var
+  i: integer;
+  c: uint16; // Unicode codepoint
+begin
+  if AText = '' then
+    Exit;
+  for i := 1 to Length(AText) do
+  begin
+    c := uint16(AText[i]);
+    FTextMappingList.Add(c, FTrueTypeFile.GetGlyphIndex(c));
   end;
 end;
 
+{ TPDFTrueTypeCharWidths }
+
+procedure TPDFTrueTypeCharWidths.Write(const AStream: TStream);
+var
+  i: integer;
+  s: string;
+  lst: TTextMappingList;
+  lFont: TTFFileInfo;
+begin
+  s := '';
+  lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+  lFont := Document.Fonts[EmbeddedFontNum].FTrueTypeFile;
+  for i := 0 to lst.Count-1 do
+    s :=  s + Format(' %d [%d]', [ lst[i].GlyphID, TTTFFriendClass(lFont).ToNatural(lFont.Widths[lst[i].GlyphID].AdvanceWidth)]);
+  WriteString(s, AStream);
+end;
+
+constructor TPDFTrueTypeCharWidths.Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer);
+begin
+  inherited Create(ADocument);
+  FEmbeddedFontNum := AEmbeddedFontNum;
+end;
+
 { TPDFMoveTo }
 
 class function TPDFMoveTo.Command(APos: TPDFCoord): String;
@@ -1384,27 +1536,12 @@ end;
 
 procedure TPDFPage.AddTextToLookupLists(AText: UTF8String);
 var
-  i: integer;
-  c: UnicodeChar;
   str: UnicodeString;
-  idx: integer;
-  dict: TTextDictionary;
 begin
   if AText = '' then
     Exit;
   str := UTF8ToUTF16(AText);
-  for i := 1 to Length(str) do
-  begin
-    c := str[i];
-    idx := Document.Fonts[FFontIndex].FindIndexOf(c);
-    if idx = -1 then
-    begin
-      dict := TTextDictionary.Create;
-      dict.Char := c;
-      dict.CodePoint := AnsiString(IntToHex(Word(c), 4));;
-      Document.Fonts[FFontIndex].Dictionary.Add(dict);
-    end;
-  end;
+  Document.Fonts[FFontIndex].AddTextToMappingList(str);
 end;
 
 procedure TPDFPage.DoUnitConversion(var APoint: TPDFCoord);
@@ -1456,8 +1593,8 @@ begin
 
   FMatrix._00 := 1;
   FMatrix._20 := 0;
-  FMatrix._11 := -1; // flip coordinates
-  FMatrix._21 := GetPaperHeight;
+  FMatrix._11 := -1;  // flip coordinates
+  AdjustMatrix;       // sets FMatrix._21 value
 end;
 
 destructor TPDFPage.Destroy;
@@ -1522,14 +1659,18 @@ begin
 end;
 
 procedure TPDFPage.WriteUTF8Text(X, Y: TPDFFloat; AText: UTF8String);
-Var
-  T : TPDFUTF8Text;
+var
+  T: TPDFUTF8Text;
+  p: TPDFCoord;
 begin
   if FFontIndex = -1 then
-    raise EPDF.Create('No FontIndex was set - please use SetFont() first.');
-  T := Document.CreateUTF8Text(X,Y,AText,FFontIndex);
-  AddObject(T);
+    raise EPDF.Create(SErrNoFontIndex);
+  p.X := X;
+  p.Y := Y;
+  DoUnitConversion(p);
   AddTextToLookupLists(AText);
+  T := Document.CreateUTF8Text(p.X, p.Y, AText, FFontIndex);
+  AddObject(T);
 end;
 
 procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat);
@@ -1557,7 +1698,7 @@ var
   S: TPDFLineStyleDef;
 begin
   S := Document.LineStyles[AStyle];
-  SetColor(S.Color, False);
+  SetColor(S.Color, True);
   SetPenStyle(S.PenStyle);
   DrawLine(X1, Y1, X2, Y2, S.LineWidth);
 end;
@@ -1754,7 +1895,7 @@ var
   P : Integer;
 
 begin
-  P:=Pos('-', AValue);
+  P:=RPos('-', AValue);
   if (P>0) then
     FontName:=Copy(AValue,1,P-1)
   else
@@ -1917,9 +2058,15 @@ begin
     Inc(ADocument.FObjectCount);
 end;
 
+{ We opted to use the Str() function instead of FormatFloat(), because it is
+  considerably faster. This also works around the problem of locale specific
+  DecimalSeparator causing float formatting problems in the generated PDF. }
 class function TPDFObject.FloatStr(F: TPDFFloat): String;
 begin
-  Str(F:5:2,Result);
+  if ((Round(F*100) mod 100)=0) then
+    Str(F:4:0,Result)
+  else
+    Str(F:4:2,Result);
 end;
 
 procedure TPDFObject.Write(const AStream: TStream);
@@ -2002,10 +2149,29 @@ begin
   Result := s;
 end;
 
+{ TPDFAbstractString }
+
+function TPDFAbstractString.InsertEscape(const AValue: string): string;
+var
+  S: string;
+begin
+  Result:='';
+  S:=AValue;
+  if Pos('\', S) > 0 then
+    S:=AnsiReplaceStr(S, '\', '\\');
+  if Pos('(', S) > 0 then
+    S:=AnsiReplaceStr(S, '(', '\(');
+  if Pos(')', S) > 0 then
+    S:=AnsiReplaceStr(S, ')', '\)');
+  Result:=S;
+end;
+
+{ TPDFString }
+
 procedure TPDFString.Write(const AStream: TStream);
 var
   s: AnsiString;
-  cs: AnsiString;
+//  cs: AnsiString;
 begin
   s := Utf8ToAnsi(FValue);
   if poCompressText in Document.Options then
@@ -2021,29 +2187,19 @@ end;
 constructor TPDFString.Create(Const ADocument : TPDFDocument; const AValue: string);
 begin
   inherited Create(ADocument);
-  FValue:=AValue;
+  FValue := AValue;
   if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then
-    FValue:=InsertEscape(FValue);
+    FValue := InsertEscape(FValue);
 end;
 
 { TPDFUTF8String }
 
-function TPDFUTF8String.RemapedText: String;
+function TPDFUTF8String.RemapedText: AnsiString;
 var
   s: UnicodeString;
-  i: integer;
-  idx: integer;  // character code
-  c: UnicodeChar;
 begin
-  Result := '';
   s := UTF8ToUTF16(FValue);
-  // lookup the alphabet code for each character
-  for i := 1 to Length(s) do
-  begin
-    c := s[i];
-    idx := Document.Fonts[FontIndex].FindIndexOf(c);
-    Result := Result + IntToStrZeros(idx+1,2);   // PDF expects 1-based numbering
-  end;
+  Result := Document.Fonts[FontIndex].GetGlyphIndices(s);
 end;
 
 procedure TPDFUTF8String.Write(const AStream: TStream);
@@ -2051,7 +2207,7 @@ begin
   if poCompressText in Document.Options then
   begin
     // do nothing yet
-    WriteString('('+UTF8ToUTF16(FValue)+')', AStream);
+    WriteString('<'+RemapedText+'>', AStream)
   end
   else
     WriteString('<'+RemapedText+'>', AStream);
@@ -2063,7 +2219,7 @@ begin
   FValue := AValue;
   FFontIndex := AFontIndex;
   if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then
-    FValue:=InsertEscape(FValue);
+    FValue := InsertEscape(FValue);
 end;
 
 { TPDFArray }
@@ -2482,9 +2638,9 @@ end;
 
 procedure TPDFDictionary.WriteDictionary(const AObject: integer; const AStream: TStream);
 var
-  ISize,i, NumImg, NumFnt: integer;
+  ISize,i, NumImg, NumFnt, BufSize: integer;
   Value: string;
-  M : TMemoryStream;
+  M, Buf : TMemoryStream;
   E : TPDFDictionaryItem;
   D : TPDFDictionary;
 begin
@@ -2524,13 +2680,21 @@ begin
               Value:=E.FKey.Name;
               NumFnt:=StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
               m.LoadFromFile(Document.FontFiles[NumFnt]);
-              // write fontfile stream length in xobject dictionary
-              D:=Document.GlobalXRefs[AObject].Dict;
-              D.AddInteger('Length',M.Size);
-              LastElement.Write(AStream);
-              WriteString('>>', AStream);
-              // write fontfile stream in xobject dictionary
-              TPDFEmbeddedFont.WriteEmbeddedFont(Document, M, AStream);
+              Buf := TMemoryStream.Create;
+              try
+                // write fontfile stream (could be compressed or not) to a temporary buffer so we can get the size
+                BufSize := TPDFEmbeddedFont.WriteEmbeddedFont(Document, M, Buf);
+                Buf.Position := 0;
+                // write fontfile stream length in xobject dictionary
+                D := Document.GlobalXRefs[AObject].Dict;
+                D.AddInteger('Length', BufSize);
+                LastElement.Write(AStream);
+                WriteString('>>', AStream);
+                // write fontfile buffer stream in xobject dictionary
+                Buf.SaveToStream(AStream);
+              finally
+                Buf.Free;
+              end;
             finally
               M.Free;
             end;
@@ -2637,31 +2801,28 @@ end;
 
 procedure TPDFToUnicode.Write(const AStream: TStream);
 var
+  lst: TTextMappingList;
   i: integer;
-  lFontIndex: integer;
-  lFont: TPDFFont;
 begin
-  WriteString('/CIDInit/ProcSet findresource begin'+CRLF, AStream);
+  lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+
+  WriteString('/CIDInit /ProcSet findresource begin'+CRLF, AStream);
   WriteString('12 dict begin'+CRLF, AStream);
   WriteString('begincmap'+CRLF, AStream);
-  WriteString('/CIDSystemInfo <<'+CRLF, AStream);
-  WriteString('/Registry (Adobe)'+CRLF, AStream);
-  WriteString('/Ordering (UCS)'+CRLF, AStream);
+  WriteString('/CIDSystemInfo'+CRLF, AStream);
+  WriteString('<</Registry (Adobe)'+CRLF, AStream);
+  WriteString('/Ordering (Identity)'+CRLF, AStream);
   WriteString('/Supplement 0'+CRLF, AStream);
   WriteString('>> def'+CRLF, AStream);
-  WriteString('/CMapName/Adobe-Identity-UCS def'+CRLF, AStream);
+  WriteString(Format('/CMapName /%s def', [Document.Fonts[EmbeddedFontNum].FTrueTypeFile.PostScriptName])+CRLF, AStream);
   WriteString('/CMapType 2 def'+CRLF, AStream);
   WriteString('1 begincodespacerange'+CRLF, AStream);
-  WriteString('<00> <FF>'+CRLF, AStream);
+  WriteString('<0000> <FFFF>'+CRLF, AStream);
   WriteString('endcodespacerange'+CRLF, AStream);
-
-  lFont := Document.Fonts[EmbeddedFontNum];
-  WriteString(Format('%d beginbfchar'+CRLF, [lFont.Dictionary.Count]), AStream);
-  // write mapping for each character in dictionary
-  for i := 0 to lFont.Dictionary.Count-1 do
-    WriteString(Format('<%s> <%s>'+CRLF, [IntToStrZeros(i+1, 2), TTextDictionary(lFont.Dictionary[i]).CodePoint]), AStream);  // PDF expects 1-based numbering
+  WriteString(Format('%d beginbfchar', [lst.Count])+CRLF, AStream);
+  for i := 0 to lst.Count-1 do
+    WriteString(Format('<%s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
   WriteString('endbfchar'+CRLF, AStream);
-
   WriteString('endcmap'+CRLF, AStream);
   WriteString('CMapName currentdict /CMap defineresource pop'+CRLF, AStream);
   WriteString('end'+CRLF, AStream);
@@ -2675,6 +2836,7 @@ begin
   FFontDef := AFontDef;
 end;
 
+{ TPDFDocument }
 
 procedure TPDFDocument.SetInfos(AValue: TPDFInfos);
 begin
@@ -2722,7 +2884,7 @@ begin
     p:=GetX(i).Dict.Elements[0].Value;
     if (p is TPDFName) and (TPDFName(p).Name=AValue) then
       Result:=i;
-    Inc(I);    
+    Inc(I);
     end;
 end;
 
@@ -2944,24 +3106,19 @@ begin
 end;
 
 procedure TPDFDocument.CreateStdFont(EmbeddedFontName: string; EmbeddedFontNum: integer);
-
 var
   FDict: TPDFDictionary;
   N: TPDFName;
-
 begin
-  if Pos('Italic', EmbeddedFontName) > 0 then
-    EmbeddedFontName:=Copy(EmbeddedFontName, 1, Pred(Pos('Italic', EmbeddedFontName)))+'Oblique';
-  //  AnsiReplaceText(EmbeddedFontName,'Italic','Oblique');
   // add xref entry
-  FDict:=CreateGlobalXRef.Dict;
+  FDict := CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'Font');
   FDict.AddName('Subtype', 'Type1');
   FDict.AddName('Encoding', 'WinAnsiEncoding');
   FDict.AddInteger('FirstChar', 32);
   FDict.AddInteger('LastChar', 255);
   FDict.AddName('BaseFont', EmbeddedFontName);
-  N:=CreateName('F'+IntToStr(EmbeddedFontNum));
+  N := CreateName('F'+IntToStr(EmbeddedFontNum));
   FDict.AddElement('Name',N);
   AddFontNameToPages(N.Name,GLobalXRefCount-1);
   // add font reference to all page dictionary
@@ -3005,8 +3162,10 @@ begin
     FontDef.FFontBBox := s;
     FontDef.FItalicAngle := IntToStr(lFontDef.ItalicAngle);
     FontDef.FStemV := IntToStr(lFontDef.StemV);
-   {$NOTE The 1000 value is a work-around until I can figure out the character spacing problem. }
-    FontDef.FMissingWidth := '1000'; //IntToStr(lFontDef.MissingWidth);
+
+    {$NOTE The 700 value is a work-around until I can figure out the character spacing problem. }
+    FontDef.FMissingWidth := '700'; //IntToStr(lFontDef.MissingWidth);
+
     FontDef.FEncoding := lFontDef.Encoding;
     FontDef.FFile := lFName;
     FontDef.FOriginalSize := IntToStr(lFontDef.OriginalSize);
@@ -3023,50 +3182,79 @@ procedure TPDFDocument.CreateTTFFont(const EmbeddedFontNum: integer; FontDef : T
 var
   FDict: TPDFDictionary;
   N: TPDFName;
-
+  Arr: TPDFArray;
 begin
   // add xref entry
-  FDict:=CreateGlobalXRef.Dict;
+  FDict := CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'Font');
-  FDict.AddName('Subtype', FontDef.FType);
-  FDict.AddName('Encoding', 'WinAnsiEncoding');
-  FDict.AddInteger('FirstChar', 32);
-  FDict.AddInteger('LastChar', 255);
+  FDict.AddName('Subtype', 'Type0');
   FDict.AddName('BaseFont', FontDef.FName);
+  FDict.AddName('Encoding', 'Identity-H');
   // add name element to font dictionary
   N:=CreateName('F'+IntToStr(EmbeddedFontNum));
   FDict.AddElement('Name',N);
   Self.AddFontNameToPages(N.Name,GlobalXRefCount-1);
-  CreateFontDescriptor(EmbeddedFontNum,FontDef);
-  // add fontdescriptor reference to font dictionary
-  FDict.AddReference('FontDescriptor',GlobalXRefCount-2);
-  CreateFontWidth(FontDef);
-  // add fontwidth reference to font dictionary
-  FDict.AddReference('Widths',GlobalXRefCount-1);
+  CreateTTFDescendantFont(EmbeddedFontNum, FontDef);
+  Arr := CreateArray;
+  FDict.AddElement('DescendantFonts', Arr);
+  Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount-4));
   CreateToUnicode(EmbeddedFontNum, FontDef);
   FDict.AddReference('ToUnicode', GlobalXRefCount-1);
   FontFiles.Add(FontDef.FFile);
 end;
 
+procedure TPDFDocument.CreateTTFDescendantFont(const EmbeddedFontNum: integer; FontDef: TFontDef);
+var
+  FDict: TPDFDictionary;
+  N: TPDFName;
+  Arr: TPDFArray;
+begin
+  // add xref entry
+  FDict := CreateGlobalXRef.Dict;
+  FDict.AddName('Type', 'Font');
+  FDict.AddName('Subtype', 'CIDFontType2');
+  FDict.AddName('BaseFont', FontDef.FName);
+
+  CreateTTFCIDSystemInfo(EmbeddedFontNum, FontDef);
+  FDict.AddReference('CIDSystemInfo', GlobalXRefCount-1);
+
+  // add fontdescriptor reference to font dictionary
+  CreateFontDescriptor(EmbeddedFontNum,FontDef);
+  FDict.AddReference('FontDescriptor',GlobalXRefCount-2);
+
+  Arr := CreateArray;
+  FDict.AddElement('W',Arr);
+  Arr.AddItem(TPDFTrueTypeCharWidths.Create(self, EmbeddedFontNum));
+end;
+
+procedure TPDFDocument.CreateTTFCIDSystemInfo(const EmbeddedFontNum: integer; FontDef: TFontDef);
+var
+  FDict: TPDFDictionary;
+begin
+  FDict := CreateGlobalXRef.Dict;
+  FDict.AddString('Registry', 'Adobe');
+  FDict.AddString('Ordering', 'Identity');
+  FDict.AddInteger('Supplement', 0);
+end;
+
 procedure TPDFDocument.CreateTp1Font(const EmbeddedFontNum: integer);
 begin
   Assert(EmbeddedFontNum<>-1);
 end;
 
 procedure TPDFDocument.CreateFontDescriptor(const EmbeddedFontNum: integer; FontDef : TFontDef);
-
 var
   Arr: TPDFArray;
   FDict: TPDFDictionary;
-
 begin
   FDict:=CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'FontDescriptor');
   FDict.AddName('FontName', FontDef.FName);
+  FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName);
   FDict.AddInteger('Ascent', StrToInt(FontDef.FAscent));
   FDict.AddInteger('Descent', StrToInt(FontDef.FDescent));
   FDict.AddInteger('CapHeight', StrToInt(FontDef.FCapHeight));
-  FDict.AddInteger('Flags', StrToInt(FontDef.FFlags));
+  FDict.AddInteger('Flags', 32);
   Arr:=CreateArray;
   FDict.AddElement('FontBBox',Arr);
   Arr.AddIntArray(FontDef.FFontBBox);
@@ -3099,14 +3287,13 @@ begin
   Arr.AddIntArray(FontDef.FCharWidth);
 end;
 
-procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer;FontDef : TFontDef);
-
+procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer; FontDef: TFontDef);
 var
   FDict: TPDFDictionary;
-
 begin
   FDict:=CreateGlobalXRef.Dict;
-  FDict.AddName('Filter','FlateDecode');
+  if poCompressFonts in Options then
+    FDict.AddName('Filter','FlateDecode');
   FDict.AddInteger('Length1 '+IntToStr(EmbeddedFontNum),StrToInt(FontDef.FOriginalSize));
 end;
 
@@ -3152,8 +3339,8 @@ var
 begin
   Contents:=CreateGlobalXRef;
   Contents.FStream:=CreateStream(False);
-  Result:=GLobalXRefCount-1;
-  GLobalXrefs[GLobalXRefCount-2].Dict.AddReference('Contents',Result);
+  Result:=GlobalXRefCount-1;
+  GlobalXrefs[GlobalXRefCount-2].Dict.AddReference('Contents',Result);
 end;
 
 procedure TPDFDocument.CreatePageStream(APage : TPDFPage; PageNum: integer);
@@ -3387,17 +3574,16 @@ begin
   NumFont:=0;
   for i:=0 to Fonts.Count-1 do
     begin
-    FontName:=ExtractBaseFontName(Fonts[i].Name);
-    P:=Pos('-', FontName);
-    if P>0 then
-      FtName:=LowerCase(Copy(FontName,1,P-1))
-    else
-      FtName:=LowerCase(FontName);
-    if (FtName='courier') or (FtName='helvetica') or (FtName='times') then
-      begin
-      FontName[1]:=UpCase(FontName[1]);
-      CreateStdFont(FontName,NumFont);
-      end
+    FontName := Fonts[i].Name;
+    { Acrobat Reader expects us to be case sensitive. Other PDF viewers are case-insensitive. }
+    if (FontName='Courier') or (FontName='Courier-Bold') or (FontName='Courier-Oblique') or (FontName='Courier-BoldOblique')
+        or (FontName='Helvetica') or (FontName='Helvetica-Bold') or (FontName='Helvetica-Oblique') or (FontName='Helvetica-BoldOblique')
+        or (FontName='Times-Roman') or (FontName='Times-Bold') or (FontName='Times-Italic') or (FontName='Times-BoldItalic')
+        or (FontName='Symbol')
+        or (FontName='Zapf Dingbats') then
+    begin
+      CreateStdFont(FontName, NumFont);
+    end
     else if (LoadFont(Fonts[i], FontDef)='TrueType') then
       CreateTtfFont(NumFont,FontDef)
     else
@@ -3428,6 +3614,7 @@ begin
   (Trailer.ValueByName('Size') as TPDFInteger).Value:=GlobalXRefCount;
   AStream.Position:=0;
   TPDFObject.WriteString(PDF_VERSION+CRLF, AStream);
+  TPDFObject.WriteString(PDF_BINARY_BLOB+CRLF, AStream); // write some binary data as recommended in PDF Spec section 3.4.1 (File Header)
   // write numbered indirect objects
   for i:=1 to GlobalXRefCount-1 do
     begin
@@ -3537,22 +3724,48 @@ begin
 end;
 
 function TPDFDocument.AddFont(AName: String; AColor : TARGBColor = clBlack): Integer;
-Var
-  F : TPDFFont;
-
+var
+  F: TPDFFont;
+  i: integer;
 begin
-  F:=Fonts.AddFontDef;
-  F.Name:=AName;
-  F.Color:=AColor;
-  Result:=Fonts.Count-1;
+  { reuse existing font definition if it exists }
+  for i := 0 to Fonts.Count-1 do
+  begin
+    if Fonts[i].Name = AName then
+    begin
+      Result := i;
+      Exit;
+    end;
+  end;
+  F := Fonts.AddFontDef;
+  F.Name := AName;
+  F.Color := AColor;
+  Result := Fonts.Count-1;
 end;
 
 function TPDFDocument.AddFont(AFontFile: String; AName: String; AColor: TARGBColor): Integer;
-Var
-  F : TPDFFont;
+var
+  F: TPDFFont;
+  i: integer;
+  lFName: string;
 begin
-  F:=Fonts.AddFontDef;
-  F.FontFile := AFontFile;
+  { reuse existing font definition if it exists }
+  for i := 0 to Fonts.Count-1 do
+  begin
+    if Fonts[i].Name = AName then
+    begin
+      Result := i;
+      Exit;
+    end;
+  end;
+  F := Fonts.AddFontDef;
+  if ExtractFilePath(AFontFile) <> '' then
+    // assume AFontFile is the full path to the TTF file
+    lFName := AFontFile
+  else
+    // assume it's just the TTF filename
+    lFName := IncludeTrailingPathDelimiter(FontDirectory)+AFontFile;
+  F.FontFile := lFName;
   F.Name := AName;
   F.Color := AColor;
   Result := Fonts.Count-1;
@@ -3572,5 +3785,6 @@ begin
   Result:=FLineStyleDefs.Count-1;
 end;
 
+
 end.
 

packages/fcl-pdf/tests/fpparsettf_test.pas

@@ -2052,9 +2052,9 @@ end;
 
 
 initialization
-  RegisterTest(TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestLiberationFont{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestFreeSansFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestFreeSansFont{$ifdef fptest}.Suite{$endif});
 
 end.
 

packages/fcl-pdf/tests/fppdf_test.pas

@@ -76,6 +76,11 @@ type
   end;
 
 
+  TTestPDFAbstractString = class(TBasePDFTest)
+  published
+    procedure   TestInsertEscape;
+  end;
+
   TTestPDFString = class(TBasePDFTest)
   published
     procedure   TestWrite;
@@ -284,11 +289,35 @@ end;
 { TTestPDFObject }
 
 procedure TTestPDFObject.TestFloatStr;
+
+Var
+  C : Char;
+  
 begin
   AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12)));
-  AssertEquals('Failed on 2', '12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
-  AssertEquals('Failed on 3', '12.3', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
+  AssertEquals('Failed on 2', '  12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
+  AssertEquals('Failed on 3', '12.30', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
   AssertEquals('Failed on 4', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
+  AssertEquals('Failed on 5', '123.45', TMockPDFObject.FloatStr(TPDFFLoat(123.45)));
+  AssertEquals('Failed on 6', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.455)));
+  AssertEquals('Failed on 7', '123.46', TMockPDFObject.FloatStr(TPDFFLoat(123.456)));
+  AssertEquals('Failed on 8', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
+  // Set DecimalSeparator
+  C:=FormatSettings.DecimalSeparator;
+  FormatSettings.DecimalSeparator:=',';
+  try
+    AssertEquals('Failed on 9', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
+  finally
+    FormatSettings.DecimalSeparator:=C;
+  end;  
+  // Set ThousandSeparator
+  C:=FormatSettings.ThousandSeparator;
+  FormatSettings.ThousandSeparator:=' ';
+  try
+    AssertEquals('Failed on 10', '1234567.00', TMockPDFObject.FloatStr(TPDFFLoat(1234567)));
+  finally
+    FormatSettings.ThousandSeparator:=C;
+  end;
 end;
 
 procedure TTestPDFObject.TestWriteString;
@@ -315,23 +344,23 @@ begin
     o.SetWidth(TPDFFloat(300.5), S);
     AssertEquals('Failed on 1',
       '1 J'+CRLF+
-      '300.5 w'+CRLF,             // line width
+      '300.50 w'+CRLF,             // line width
       s.DataString);
 
     // this shouldn't cause any change
     o.SetWidth(TPDFFloat(300.5), S);
-    AssertEquals('Failed on 1',
+    AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '300.5 w'+CRLF,             // line width
+      '300.50 w'+CRLF,             // line width
       s.DataString);
 
     // but this will
     o.SetWidth(TPDFFloat(123), S);
-    AssertEquals('Failed on 1',
+    AssertEquals('Failed on 3',
       '1 J'+CRLF+
-      '300.5 w'+CRLF+           // line width 300.5
+      '300.50 w'+CRLF+           // line width 300.5
       '1 J'+CRLF+
-      '123 w'+CRLF,             // line width 123
+      ' 123 w'+CRLF,             // line width 123
       s.DataString);
   finally
     o.Free;
@@ -378,7 +407,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -395,7 +424,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -490,6 +519,23 @@ begin
 end;
 
 
+{ TTestPDFAbstractString }
+
+procedure TTestPDFAbstractString.TestInsertEscape;
+var
+  o: TPDFAbstractString;
+begin
+  o := TPDFAbstractString.Create(PDF);
+  try
+    AssertEquals('Failed on 1', 'abcdefg', TMockPDFString(o).InsertEscape('abcdefg'));
+    AssertEquals('Failed on 2', 'a\\b/cdefg', TMockPDFString(o).InsertEscape('a\b/cdefg'));
+    AssertEquals('Failed on 3', 'a\(b\)cdefg', TMockPDFString(o).InsertEscape('a(b)cdefg'));
+    AssertEquals('Failed on 4', 'a\(b\)c\\def/g', TMockPDFString(o).InsertEscape('a(b)c\def/g'));
+  finally
+    o.Free;
+  end;
+end;
+
 { TTestPDFString }
 
 procedure TTestPDFString.TestWrite;
@@ -639,7 +685,7 @@ begin
     TMockPDFText(o).Write(S);
     AssertEquals('Failed on 2',
       'BT'+CRLF+
-      '10.5 20 TD'+CRLF+
+      '10.50   20 TD'+CRLF+
       '(Hello World!) Tj'+CRLF+
       'ET'+CRLF,
       S.DataString);
@@ -656,7 +702,7 @@ var
 begin
   pos.X := 10.0;
   pos.Y := 55.5;
-  AssertEquals('Failed on 1', '10 55.5 l'+CRLF, TPDFLineSegment.Command(pos));
+  AssertEquals('Failed on 1', '  10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
 end;
 
 procedure TTestPDFLineSegment.TestWrite;
@@ -675,9 +721,9 @@ begin
     TMockPDFLineSegment(o).Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+             // line width
-      '10 15.5 m'+CRLF+       // moveto command
-      '50 55.5 l'+CRLF+       // line segment
+      '   2 w'+CRLF+             // line width
+      '  10 15.50 m'+CRLF+       // moveto command
+      '  50 55.50 l'+CRLF+       // line segment
       'S'+CRLF,               // end line segment
       S.DataString);
   finally
@@ -702,7 +748,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '10 11 100 200 re'+CRLF,
+      '  10   11  100  200 re'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -725,8 +771,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
-      '10 11 100 200 re'+CRLF+
+      '   2 w'+CRLF+
+      '  10   11  100  200 re'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -750,8 +796,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
-      '10 11 100 200 re'+CRLF+
+      '   2 w'+CRLF+
+      '  10   11  100  200 re'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -774,7 +820,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '10 11 100 200 re'+CRLF+
+      '  10   11  100  200 re'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -798,7 +844,7 @@ begin
   X3 := 200;
   Y3 := 250;
   s1 := TMockPDFCurveC.Command(x1, y1, x2, y2, x3, y3);
-  AssertEquals('Failed on 1', '10 11 100 9 200 250 c'+CRLF, s1);
+  AssertEquals('Failed on 1', '  10   11  100    9  200  250 c'+CRLF, s1);
 end;
 
 procedure TTestPDFCurveC.TestWrite_Stroke;
@@ -822,8 +868,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
-      '10 11 100 9 200 250 c'+CRLF+
+      '   2 w'+CRLF+
+      '  10   11  100    9  200  250 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -851,7 +897,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '10 11 100 9 200 250 c'+CRLF,
+      '  10   11  100    9  200  250 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -878,8 +924,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
-      '100 9 200 250 v'+CRLF+
+      '   2 w'+CRLF+
+      ' 100    9  200  250 v'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -904,7 +950,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '100 9 200 250 v'+CRLF,
+      ' 100    9  200  250 v'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -931,8 +977,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
-      '100 9 200 250 y'+CRLF+
+      '   2 w'+CRLF+
+      ' 100    9  200  250 y'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -957,7 +1003,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '100 9 200 250 y'+CRLF,
+      ' 100    9  200  250 y'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -982,15 +1028,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '10 145 m'+CRLF+
+      '  10  145 m'+CRLF+
       // curveC 1
-      '10 76.25 55 20 110 20 c'+CRLF+
+      '  10 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF,
+      '  55  270   10 213.75   10  145 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1013,15 +1059,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '10 145 m'+CRLF+
+      '  10  145 m'+CRLF+
       // curveC 1
-      '10 76.25 55 20 110 20 c'+CRLF+
+      '  10 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -1045,17 +1091,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
+      '   2 w'+CRLF+
       // move to
-      '10 145 m'+CRLF+
+      '  10  145 m'+CRLF+
       // curveC 1
-      '10 76.25 55 20 110 20 c'+CRLF+
+      '  10 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1079,17 +1125,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '2 w'+CRLF+
+      '   2 w'+CRLF+
       // move to
-      '10 145 m'+CRLF+
+      '  10  145 m'+CRLF+
       // curveC 1
-      '10 76.25 55 20 110 20 c'+CRLF+
+      '  10 76.25   55   20  110   20 c'+CRLF+
       // curveC 2
-      '165 20 210 76.25 210 145 c'+CRLF+
+      ' 165   20  210 76.25  210  145 c'+CRLF+
       // curveC 3
-      '210 213.75 165 270 110 270 c'+CRLF+
+      ' 210 213.75  165  270  110  270 c'+CRLF+
       // curveC 4
-      '55 270 10 213.75 10 145 c'+CRLF+
+      '  55  270   10 213.75   10  145 c'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -1118,11 +1164,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '10 20 m'+CRLF+
+      '  10   20 m'+CRLF+
       // line segment - p1
-      '30 40 l'+CRLF+
+      '  30   40 l'+CRLF+
       // line segment - p2
-      '50 60 l'+CRLF+
+      '  50   60 l'+CRLF+
       'h'+CRLF+   // close
       'f'+CRLF,   // fill
       S.DataString);
@@ -1151,11 +1197,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '10 20 m'+CRLF+
+      '  10   20 m'+CRLF+
       // line segment - p1
-      '30 40 l'+CRLF+
+      '  30   40 l'+CRLF+
       // line segment - p2
-      '50 60 l'+CRLF+
+      '  50   60 l'+CRLF+
       'h'+CRLF,   // close
       S.DataString);
   finally
@@ -1183,11 +1229,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '10 20 m'+CRLF+
+      '  10   20 m'+CRLF+
       // line segment - p1
-      '30 40 l'+CRLF+
+      '  30   40 l'+CRLF+
       // line segment - p2
-      '50 60 l'+CRLF+
+      '  50   60 l'+CRLF+
       'f'+CRLF,   // fill
       S.DataString);
   finally
@@ -1213,7 +1259,7 @@ begin
     AssertEquals('Failed on 2',
       // save graphics state
       'q'+CRLF+
-      '150 0 0 75 100 200 cm'+CRLF+
+      '150 0 0 75  100  200 cm'+CRLF+
       '/I1 Do'+CRLF+
       // restore graphics state
       'Q'+CRLF,
@@ -1317,7 +1363,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '0.66 0.73 0.8 RG'+CRLF,
+      '0.66 0.73 0.80 RG'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1333,7 +1379,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '0.66 0.73 0.8 rg'+CRLF,
+      '0.66 0.73 0.80 rg'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1622,34 +1668,35 @@ end;
 
 
 initialization
-  RegisterTest(TTestPDFObject{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFInteger{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFReference{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFName{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFString{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFArray{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFStream{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFText{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFSurface{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFImage{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFColor{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFXRef{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestPDFPage{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFObject{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFDocumentObject{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFBoolean{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFMoveTo{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFInteger{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFReference{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFName{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFAbstractString{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFString{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFArray{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFStream{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEmbeddedFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFText{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineSegment{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFRectangle{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveC{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveV{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFCurveY{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFEllipse{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFSurface{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFImage{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFLineStyle{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFColor{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionaryItem{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFDictionary{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFXRef{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestPDFPage{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestCompressionDecompression{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpPDF',{$endif}TTestTPDFImageItem{$ifdef fptest}.Suite{$endif});
 
 end.
 

packages/fcl-pdf/tests/fpttf_test.pas

@@ -301,8 +301,8 @@ end;
 
 
 initialization
-  RegisterTest(TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
-  RegisterTest(TFPFontCacheListTest{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheListTest{$ifdef fptest}.Suite{$endif});
 
 end.