diff --git a/.gitattributes b/.gitattributes
index ddae172ffe..7f0b6285fa 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -2595,6 +2595,7 @@ packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
packages/fcl-pdf/fpmake.pp svneol=native#text/plain
packages/fcl-pdf/readme.txt svneol=native#text/plain
+packages/fcl-pdf/src/fontmetrics_stdpdf.inc svneol=native#text/plain
packages/fcl-pdf/src/fpparsettf.pp svneol=native#text/plain
packages/fcl-pdf/src/fppdf.pp svneol=native#text/plain
packages/fcl-pdf/src/fpttf.pp svneol=native#text/plain
diff --git a/packages/fcl-pdf/examples/testfppdf.lpr b/packages/fcl-pdf/examples/testfppdf.lpr
index aad211d54b..b3da161e00 100644
--- a/packages/fcl-pdf/examples/testfppdf.lpr
+++ b/packages/fcl-pdf/examples/testfppdf.lpr
@@ -35,6 +35,7 @@ type
FTextCompression,
FFontCompression: boolean;
FNoFontEmbedding: boolean;
+ FSubsetFontEmbedding: boolean;
FDoc: TPDFDocument;
function SetUpDocument: TPDFDocument;
procedure SaveDocument(D: TPDFDocument);
@@ -77,8 +78,13 @@ begin
Result.Infos.CreationDate := Now;
lOpts := [poPageOriginAtTop];
+ if FSubsetFontEmbedding then
+ Include(lOpts, poSubsetFont);
if FNoFontEmbedding then
+ begin
Include(lOpts, poNoEmbeddedFonts);
+ Exclude(lOpts, poSubsetFont);
+ end;
if FFontCompression then
Include(lOpts, poCompressFonts);
if FTextCompression then
@@ -132,7 +138,8 @@ end;
procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
var
P : TPDFPage;
- FtTitle, FtText1, FtText2, FtText3: integer;
+ FtTitle, FtText1, FtText2: integer;
+ FtWaterMark: integer;
begin
P := D.Pages[APage];
@@ -140,14 +147,16 @@ begin
FtTitle := D.AddFont('Helvetica');
FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
FtText2 := D.AddFont('Times-BoldItalic');
- // FtText3 := D.AddFont('arial.ttf', 'Arial');
- FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
+ FtWaterMark := D.AddFont('Helvetica-Bold');
{ Page title }
P.SetFont(FtTitle, 23);
P.SetColor(clBlack, false);
P.WriteText(25, 20, 'Sample Text');
+ P.SetFont(FtWaterMark, 120);
+ P.SetColor(clWaterMark, false);
+ P.WriteText(55, 190, 'Sample', 45);
// -----------------------------------
// Write text using PDF standard fonts
@@ -158,6 +167,12 @@ begin
P.WriteText(25, 57, 'Click the URL: http://www.freepascal.org');
P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
+ // strike-through text
+ P.WriteText(25, 64, 'Strike-Through text', 0, false, true);
+
+ // strike-through text
+ P.WriteText(65, 64, 'Underlined text', 0, true);
+
// rotated text
P.SetColor(clBlue, false);
P.WriteText(25, 100, 'Rotated text at 30 degrees', 30);
@@ -169,17 +184,16 @@ begin
// -----------------------------------
// TrueType testing purposes
- P.SetFont(ftText3, 13);
+ P.SetFont(FtText1, 13);
P.SetColor(clBlack, false);
P.WriteText(15, 120, 'Languages: English: Hello, World!');
- P.WriteText(40, 130, 'Greek: Γειά σου κόσμος');
+ P.WriteText(40, 130, 'Greek: Γεια σου κόσμος');
P.WriteText(40, 140, 'Polish: Witaj świecie');
P.WriteText(40, 150, 'Portuguese: Olá mundo');
P.WriteText(40, 160, 'Russian: Здравствуйте мир');
P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
- P.SetFont(ftText1, 13);
P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
P.WriteText(15, 200, 'Typography: “What’s wrong?”');
@@ -213,30 +227,30 @@ begin
P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
P.SetColor(clBlack, True);
- P.SetPenStyle(ppsSolid);
+ P.SetPenStyle(ppsSolid, 1);
lPt1.X := 30; lPt1.Y := 100;
lPt2.X := 150; lPt2.Y := 150;
- P.DrawLine(lPt1, lPt2, 0.2);
+ P.DrawLine(lPt1, lPt2, 1);
P.SetColor(clBlue, True);
- P.SetPenStyle(ppsDash);
+ P.SetPenStyle(ppsDash, 1);
lPt1.X := 50; lPt1.Y := 70;
lPt2.X := 180; lPt2.Y := 100;
- P.DrawLine(lPt1, lPt2, 0.1);
+ P.DrawLine(lPt1, lPt2, 1);
{ we can also use coordinates directly, without TPDFCoord variables }
P.SetColor(clRed, True);
- P.SetPenStyle(ppsDashDot);
+ P.SetPenStyle(ppsDashDot, 1);
P.DrawLine(40, 140, 160, 80, 1);
P.SetColor(clBlack, True);
- P.SetPenStyle(ppsDashDotDot);
- P.DrawLine(60, 50, 60, 120, 1.5);
+ P.SetPenStyle(ppsDashDotDot, 1);
+ P.DrawLine(60, 50, 60, 120, 1);
P.SetColor(clBlack, True);
- P.SetPenStyle(ppsDot);
- P.DrawLine(10, 80, 130, 130, 0.5);
+ P.SetPenStyle(ppsDot, 1);
+ P.DrawLine(10, 80, 130, 130, 1);
end;
procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
@@ -256,11 +270,11 @@ begin
P.WriteText(25, 20, 'Sample Line Drawing (DrawLineStyle)');
// write the text at position 100 mm from left and 120 mm from top
- TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
- TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
+ TsThinBlack := D.AddLineStyleDef(1, clBlack, ppsSolid);
+ TsThinBlue := D.AddLineStyleDef(1, clBlue, ppsDash);
TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
- TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
- TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
+ TsThick := D.AddLineStyleDef(1, clBlack, ppsDashDotDot);
+ TsThinBlackDot := D.AddLineStyleDef(1, clBlack, ppsDot);
lPt1.X := 30; lPt1.Y := 100;
lPt2.X := 150; lPt2.Y := 150;
@@ -697,6 +711,7 @@ var
lFontIdx: integer;
lFC: TFPFontCacheItem;
lHeight: single;
+ lDescenderHeight: single;
lTextHeightInMM: single;
lWidth: single;
lTextWidthInMM: single;
@@ -719,21 +734,15 @@ begin
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;
+ lHeight := lFC.TextHeight(AText, APointSize, lDescenderHeight);
+ { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
+ lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
+ lDescenderHeightInMM := (lDescenderHeight * 25.4) / gTTFontCache.DPI;
lWidth := lFC.TextWidth(AText, APointSize);
- { convert the Font Units to Millimeters }
+ { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
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. }
@@ -766,7 +775,7 @@ begin
StopOnException:=True;
inherited DoRun;
// quick check parameters
- ErrorMsg := CheckOptions('hp:f:t:i:j:n', '');
+ ErrorMsg := CheckOptions('hp:f:t:i:j:ns', '');
if ErrorMsg <> '' then
begin
WriteLn('ERROR: ' + ErrorMsg);
@@ -797,6 +806,7 @@ begin
end;
FNoFontEmbedding := HasOption('n', '');
+ FSubsetFontEmbedding := HasOption('s', '');
FFontCompression := BoolFlag('f',true);
FTextCompression := BoolFlag('t',False);
FImageCompression := BoolFlag('i',False);
@@ -852,6 +862,7 @@ begin
' If this option is not specified, then all %0:d pages are' + LineEnding +
' generated.', [cPageCount]));
writeln(' -n If specified, no fonts will be embedded.');
+ writeln(' -s If specified, subset TTF font embedding will occur.');
writeln(' -f <0|1> Toggle embedded font compression. A value of 0' + LineEnding +
' disables compression. A value of 1 enables compression.' + LineEnding +
' If -n is specified, this option is ignored.');
diff --git a/packages/fcl-pdf/fpmake.pp b/packages/fcl-pdf/fpmake.pp
index b8582b34f1..bb9c5af715 100644
--- a/packages/fcl-pdf/fpmake.pp
+++ b/packages/fcl-pdf/fpmake.pp
@@ -28,6 +28,7 @@ begin
P.Dependencies.Add('rtl-objpas');
P.Dependencies.Add('fcl-base');
P.Dependencies.Add('fcl-image');
+ P.Dependencies.Add('fcl-xml');
P.Dependencies.Add('paszlib');
P.Version:='3.1.1';
T:=P.Targets.AddUnit('src/fpttfencodings.pp');
diff --git a/packages/fcl-pdf/src/fontmetrics_stdpdf.inc b/packages/fcl-pdf/src/fontmetrics_stdpdf.inc
new file mode 100644
index 0000000000..03739a99f7
--- /dev/null
+++ b/packages/fcl-pdf/src/fontmetrics_stdpdf.inc
@@ -0,0 +1,222 @@
+const
+
+ // helvetica (used metric equivalent Liberation Sans as substitute)
+ FONT_HELVETICA_ARIAL: array[0..255] of integer = (
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+ 1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+ 1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+ 1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+ 1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+ 569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+ 532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,682,
+ 682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,1366,
+ 1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+ 1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,1139,
+ 1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,1139,
+ 1139,1139,1024,1139,1024 );
+ FONT_HELVETICA_ARIAL_CAPHEIGHT = 1409;
+ FONT_HELVETICA_ARIAL_DESCENDER = 431;
+
+ // helveticaB (used metric equivalent Liberation Sans Bold as substitute)
+ FONT_HELVETICA_ARIAL_BOLD: array[0..255] of integer = (
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+ 1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+ 1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+ 1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+ 1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+ 682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+ 573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,682,
+ 682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+ 1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+ 1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,1139,
+ 1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,1251,
+ 1251,1251,1139,1251,1139 );
+ FONT_HELVETICA_ARIAL_BOLD_CAPHEIGHT = 688;
+ FONT_HELVETICA_ARIAL_BOLD_DESCENDER = 210;
+
+ // helveticaI (used metric equivalent Liberation Sans Italic as substitute)
+ FONT_HELVETICA_ARIAL_ITALIC: array[0..255] of Integer = (
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+ 1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+ 1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+ 1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+ 1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+ 569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+ 1139,532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,
+ 682,682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,
+ 1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+ 1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,
+ 1139,1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,
+ 1139,1139,1139,1024,1139,1024 );
+ FONT_HELVETICA_ARIAL_ITALIC_CAPHEIGHT = 688;
+ FONT_HELVETICA_ARIAL_ITALIC_DESCENDER = 208;
+
+ // helveticaBI (used metric equivalent Liberation Sans Bold Italic as substitute)
+ FONT_HELVETICA_ARIAL_BOLD_ITALIC: array[0..255] of Integer = (
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+ 1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+ 1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+ 1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+ 1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+ 682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+ 1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+ 1139,573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,
+ 682,682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,
+ 1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+ 1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,
+ 1139,1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,
+ 1251,1251,1251,1139,1251,1139 );
+ FONT_HELVETICA_ARIAL_BOLD_ITALIC_CAPHEIGHT = 688;
+ FONT_HELVETICA_ARIAL_BOLD_ITALIC_DESCENDER = 210;
+
+ // times (used metric equivalent Liberation Serif as substitute)
+ FONT_TIMES: array[0..255] of Integer = (
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 512,682,836,1024,1024,1706,1593,369,682,682,1024,1155,512,682,512,569,1024,1024,
+ 1024,1024,1024,1024,1024,1024,1024,1024,569,569,1155,1155,1155,909,1886,1479,1366,
+ 1366,1479,1251,1139,1479,1479,682,797,1479,1251,1821,1479,1479,1139,1479,1366,
+ 1139,1251,1479,1479,1933,1479,1479,1251,682,569,682,961,1024,682,909,1024,909,
+ 1024,909,682,1024,1024,569,569,1024,569,1593,1024,1024,1024,1024,682,797,569,
+ 1024,1024,1479,1024,1024,909,983,410,983,1108,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,
+ 410,1024,682,1556,565,1024,1155,682,1556,1024,819,1124,614,614,682,1180,928,682,
+ 682,614,635,1024,1536,1536,1536,909,1479,1479,1479,1479,1479,1479,1821,1366,1251,
+ 1251,1251,1251,682,682,682,682,1479,1479,1479,1479,1479,1479,1479,1155,1479,1479,
+ 1479,1479,1479,1479,1139,1024,909,909,909,909,909,909,1366,909,909,909,909,909,
+ 569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,1024,
+ 1024,1024,1024 );
+ FONT_TIMES_CAPHEIGHT = 1341;
+ FONT_TIMES_DESCENDER = 442;
+
+ // timesI (used metric equivalent Liberation Serif Italic as substitute)
+ FONT_TIMES_ITALIC: array[0..255] of Integer = (
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 512,682,860,1024,1024,1706,1593,438,682,682,1024,1382,512,682,512,569,1024,1024,
+ 1024,1024,1024,1024,1024,1024,1024,1024,682,682,1382,1382,1382,1024,1884,1251,
+ 1251,1366,1479,1251,1251,1479,1479,682,909,1366,1139,1706,1366,1479,1251,1479,
+ 1251,1024,1139,1479,1251,1706,1251,1139,1139,797,569,797,864,1024,682,1024,1024,
+ 909,1024,909,569,1024,1024,569,569,909,569,1479,1024,1024,1024,1024,797,797,569,
+ 1024,909,1366,909,909,797,819,563,819,1108,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,
+ 563,1024,682,1556,565,1024,1382,682,1556,1024,819,1124,614,614,682,1180,1071,512,
+ 682,614,635,1024,1536,1536,1536,1024,1251,1251,1251,1251,1251,1251,1821,1366,1251,
+ 1251,1251,1251,682,682,682,682,1479,1366,1479,1479,1479,1479,1479,1382,1479,1479,
+ 1479,1479,1479,1139,1251,1024,1024,1024,1024,1024,1024,1024,1366,909,909,909,909,
+ 909,569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,
+ 1024,909,1024,909 );
+ FONT_TIMES_ITALIC_CAPHEIGHT = 655;
+ FONT_TIMES_ITALIC_DESCENDER = 216;
+
+ //timesB (used metric equivalent Liberation Serif Bold as substitute)
+ FONT_TIMES_BOLD: array[0..255] of Integer = (
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 512,682,1137,1024,1024,2048,1706,569,682,682,1024,1167,512,682,512,569,1024,1024,
+ 1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1905,1479,
+ 1366,1479,1479,1366,1251,1593,1593,797,1024,1593,1366,1933,1479,1593,1251,1593,
+ 1479,1139,1366,1479,1479,2048,1479,1479,1366,682,569,682,1190,1024,682,1024,1139,
+ 909,1139,909,682,1024,1139,569,682,1139,569,1706,1139,1024,1139,1139,909,797,682,
+ 1139,1024,1479,1024,1024,909,807,451,807,1065,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,451,
+ 1024,682,1530,614,1024,1167,682,1530,1024,819,1124,614,614,682,1180,1106,683,682,
+ 614,676,1024,1536,1536,1536,1024,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+ 1366,1366,1366,797,797,797,797,1479,1479,1593,1593,1593,1593,1593,1167,1593,1479,
+ 1479,1479,1479,1479,1251,1139,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+ 909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+ 1139,1024,1139,1024 );
+ FONT_TIMES_BOLD_CAPHEIGHT = 655;
+ FONT_TIMES_BOLD_DESCENDER = 216;
+
+ // timesBI (used metric equivalent Liberation Serif Bold Italic as substitute)
+ FONT_TIMES_BOLD_ITALIC: array[0..255] of Integer = (
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 512,797,1137,1024,1024,1706,1593,569,682,682,1024,1167,512,682,512,569,1024,1024,
+ 1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1704,1366,
+ 1366,1366,1479,1366,1366,1479,1593,797,1024,1366,1251,1821,1479,1479,1251,1479,
+ 1366,1139,1251,1479,1366,1821,1366,1251,1251,682,569,682,1167,1024,682,1024,1024,
+ 909,1024,909,682,1024,1139,569,569,1024,569,1593,1139,1024,1024,1024,797,797,569,
+ 1139,909,1366,1024,909,797,713,451,713,1167,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+ 1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,451,
+ 1024,682,1530,545,1024,1241,682,1530,1024,819,1124,614,614,682,1180,1024,512,682,
+ 614,614,1024,1536,1536,1536,1024,1366,1366,1366,1366,1366,1366,1933,1366,1366,
+ 1366,1366,1366,797,797,797,797,1479,1479,1479,1479,1479,1479,1479,1167,1479,1479,
+ 1479,1479,1479,1251,1251,1024,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+ 909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+ 1139,909,1024,909 );
+ FONT_TIMES_BOLD_ITALIC_CAPHEIGHT = 655;
+ FONT_TIMES_BOLD_ITALIC_DESCENDER = 216;
+
+ // courier courierB courierI courierBI
+ FONT_COURIER_FULL: array[0..255] of Integer = (
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+ 1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229 );
+ FONT_TIMES_COURIER_CAPHEIGHT = 613;
+ FONT_TIMES_COURIER_DESCENDER = 386;
+
+ // symbol
+ FONT_SYMBOL: array[0..255] of Integer = (
+ 250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,
+ 250,250,250,250,250,250,250,250,250,250,250,333,713,500,549,833,778,439,333,333,500,549,
+ 250,549,250,278,500,500,500,500,500,500,500,500,500,500,278,278,549,549,549,444,549,722,
+ 667,722,612,611,763,603,722,333,631,722,686,889,722,722,768,741,556,592,611,690,439,768,
+ 645,795,611,333,863,333,658,500,500,631,549,549,494,439,521,411,603,329,603,549,549,576,
+ 521,549,549,521,549,603,439,576,713,686,493,686,494,480,200,480,549,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,750,620,247,549,167,713,500,753,753,753,753,1042,987,603,987,603,
+ 400,549,411,549,549,713,494,460,549,549,549,549,1000,603,1000,658,823,686,795,987,768,768,
+ 823,768,768,713,713,713,713,713,713,713,768,713,790,790,890,823,549,250,713,603,603,1042,
+ 987,603,987,603,494,329,790,790,786,713,384,384,384,384,384,384,494,494,494,494,0,329,
+ 274,686,686,686,384,384,384,384,384,384,494,494,494,0);
+
+ // zapfdingbats
+ FONT_ZAPFDINGBATS: array[0..255] of Integer = (
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,278,974,961,974,980,719,789,790,791,690,960,939,
+ 549,855,911,933,911,945,974,755,846,762,761,571,677,763,760,759,754,494,552,537,577,692,
+ 786,788,788,790,793,794,816,823,789,841,823,833,816,831,923,744,723,749,790,792,695,776,
+ 768,792,759,707,708,682,701,826,815,789,789,707,687,696,689,786,787,713,791,785,791,873,
+ 761,762,762,759,759,892,892,788,784,438,138,277,415,392,392,668,668,0,390,390,317,317,
+ 276,276,509,509,410,410,234,234,334,334,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,732,544,544,910,667,760,760,776,595,694,626,788,788,788,788,
+ 788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,
+ 788,788,788,788,788,788,788,788,788,788,788,788,788,788,894,838,1016,458,748,924,748,918,
+ 927,928,928,834,873,828,924,924,917,930,931,463,883,836,836,867,867,696,696,874,0,874,
+ 760,946,771,865,771,888,967,888,831,873,927,970,918,0);
+
+
diff --git a/packages/fcl-pdf/src/fpparsettf.pp b/packages/fcl-pdf/src/fpparsettf.pp
index bcd507dd59..9680a6337a 100644
--- a/packages/fcl-pdf/src/fpparsettf.pp
+++ b/packages/fcl-pdf/src/fpparsettf.pp
@@ -23,16 +23,22 @@ unit fpparsettf;
interface
uses
- Classes, SysUtils, fpttfencodings;
+ Classes,
+ SysUtils,
+ fpttfencodings;
type
ETTF = Class(Exception);
// Tables recognized in this unit.
- TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost {,ttglyph});
+ TTTFTableType = (
+ // these are for general font information
+ ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost,
+ // these are used for font subsetting
+ ttglyf,ttloca,ttcvt,ttprep,ttfpgm);
TSmallintArray = Packed Array of Int16;
- TWordArray = Packed Array of UInt16;
+ TWordArray = Packed Array of UInt16; // redefined because the one in SysUtils is not a packed array
{ Signed Fixed 16.16 Float }
TF16Dot16 = type Int32;
@@ -43,6 +49,7 @@ type
1: (Version: UInt32);
end;
+ { The file header record that starts at byte 0 of a TTF file }
TTableDirectory = Packed Record
FontVersion : TFixedVersionRec; { UInt32}
Numtables : UInt16;
@@ -63,7 +70,7 @@ type
AdvanceWidth : UInt16;
LSB: Int16; { leftSideBearing }
end;
- TLongHorMetrics = Packed Array of TLongHorMetric;
+ TLongHorMetricArray = Packed Array of TLongHorMetric;
Type
TPostScript = Packed Record
@@ -166,7 +173,8 @@ Type
XMaxExtent : Int16;
CaretSlopeRise : Int16;
CaretSlopeRun : Int16;
- Reserved : Array[0..4] of Int16;
+ caretOffset: Int16; // reserved field
+ Reserved : Array[0..3] of Int16;
metricDataFormat : Int16;
numberOfHMetrics : UInt16;
end;
@@ -219,6 +227,19 @@ Type
TNameEntries = Array of TNameEntry;
+ TGlyphHeader = packed record
+ numberOfContours: int16;
+ xMin: uint16;
+ yMin: uint16;
+ xMax: uint16;
+ yMax: uint16;
+ end;
+
+
+ { As per the TTF specification document...
+ https://www.microsoft.com/typography/tt/ttf_spec/ttch02.doc
+ ...all TTF files are always stored in Big-Endian byte ordering (pg.31 Data Types).
+ }
TTFFileInfo = class(TObject)
private
FFilename: string;
@@ -233,7 +254,7 @@ Type
FHHEad : THHead;
FOS2Data : TOS2Data;
FPostScript : TPostScript;
- FWidths: TLongHorMetrics; // hmtx data
+ FWidths: TLongHorMetricArray; // hmtx data
// Needed to create PDF font def.
FOriginalSize : Cardinal;
FMissingWidth: Integer;
@@ -242,7 +263,6 @@ Type
function FixMinorVersion(const AMinor: word): word;
function GetMissingWidth: integer;
Protected
- Function IsNativeData : Boolean; virtual;
// Stream reading functions.
function ReadInt16(AStream: TStream): Int16; inline;
function ReadUInt32(AStream: TStream): UInt32; inline;
@@ -272,6 +292,7 @@ Type
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;
+ function GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
// Load a TTF file from file or stream.
Procedure LoadFromFile(const AFileName : String);
Procedure LoadFromStream(AStream: TStream); virtual;
@@ -307,7 +328,7 @@ Type
property CmapSubtables : TCmapSubTables Read FSubtables;
property CmapUnicodeMap : TCmapFmt4 Read FUnicodeMap;
property CmapUnicodeMapSegments : TUnicodeMapSegmentArray Read FUnicodeMapSegments;
- Property Widths : TLongHorMetrics Read FWidths;
+ Property Widths : TLongHorMetricArray Read FWidths;
Property MaxP : TMaxP Read FMaxP;
Property OS2Data : TOS2Data Read FOS2Data;
Property PostScript : TPostScript Read FPostScript;
@@ -331,7 +352,8 @@ procedure FillMem(Dest: pointer; Size: longint; Data: Byte );
Const
TTFTableNames : Array[TTTFTableType] of String
- = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post');
+ = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post',
+ 'glyf', 'loca', 'cvt ', 'prep', 'fpgm');
Const
@@ -393,16 +415,14 @@ function TTFFileInfo.ReadUInt32(AStream: TStream): UInt32;
begin
Result:=0;
AStream.ReadBuffer(Result,SizeOf(Result));
- if Not IsNativeData then
- Result:=BEtoN(Result);
+ Result:=BEtoN(Result);
end;
function TTFFileInfo.ReadUInt16(AStream: TStream): UInt16;
begin
Result:=0;
AStream.ReadBuffer(Result,SizeOf(Result));
- if Not IsNativeData then
- Result:=BEtoN(Result);
+ Result:=BEtoN(Result);
end;
function TTFFileInfo.ReadInt16(AStream: TStream): Int16;
@@ -415,8 +435,6 @@ var
i : Integer;
begin
AStream.ReadBuffer(FHead,SizeOf(FHead));
- if IsNativeData then
- exit;
FHead.FileVersion.Version := BEtoN(FHead.FileVersion.Version);
FHead.FileVersion.Minor := FixMinorVersion(FHead.FileVersion.Minor);
FHead.FontRevision.Version := BEtoN(FHead.FontRevision.Version);
@@ -437,34 +455,29 @@ begin
end;
procedure TTFFileInfo.ParseHhea(AStream : TStream);
-
begin
AStream.ReadBuffer(FHHEad,SizeOf(FHHEad));
- if IsNativeData then
- exit;
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.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
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.caretOffset := BEToN(FHHEad.caretOffset);
FHHEad.metricDataFormat:=BEToN(FHHEad.metricDataFormat);
FHHEad.numberOfHMetrics:=BEToN(FHHEad.numberOfHMetrics);
- FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
end;
procedure TTFFileInfo.ParseMaxp(AStream : TStream);
-
begin
AStream.ReadBuffer(FMaxP,SizeOf(TMaxP));
- if IsNativeData then
- exit;
With FMaxP do
- begin
+ begin
VersionNumber.Version := BEtoN(VersionNumber.Version);
VersionNumber.Minor := FixMinorVersion(VersionNumber.Minor);
numGlyphs:=BEtoN(numGlyphs);
@@ -481,24 +494,20 @@ begin
maxSizeOfInstructions :=BEtoN(maxSizeOfInstructions);
maxComponentElements :=BEtoN(maxComponentElements);
maxComponentDepth :=BEtoN(maxComponentDepth);
- end;
+ end;
end;
procedure TTFFileInfo.ParseHmtx(AStream : TStream);
-
var
i : Integer;
-
begin
SetLength(FWidths,FHHead.numberOfHMetrics);
AStream.ReadBuffer(FWidths[0],SizeOf(TLongHorMetric)*Length(FWidths));
- if IsNativeData then
- exit;
for I:=0 to FHHead.NumberOfHMetrics-1 do
- begin
+ begin
FWidths[I].AdvanceWidth:=BEtoN(FWidths[I].AdvanceWidth);
FWidths[I].LSB:=BEtoN(FWidths[I].LSB);
- end;
+ end;
end;
@@ -510,7 +519,6 @@ var
Segm : TUnicodeMapSegment;
GlyphIDArray : Array of word;
S : TStream;
-
begin
TableStartPos:=AStream.Position;
FCMapH.Version:=ReadUInt16(AStream);
@@ -670,80 +678,76 @@ begin
FillWord(FOS2Data,SizeOf(TOS2Data) div 2,0);
// -18, so version 1 will not overflow
AStream.ReadBuffer(FOS2Data,SizeOf(TOS2Data)-18);
- if Not isNativeData then
- With FOS2Data do
- begin
- version:=BeToN(version);
- xAvgCharWidth:=BeToN(xAvgCharWidth);
- usWeightClass:=BeToN(usWeightClass);
- usWidthClass:=BeToN(usWidthClass);
- fsType:=BeToN(fsType);
- ySubscriptXSize:=BeToN(ySubscriptXSize);
- ySubscriptYSize:=BeToN(ySubscriptYSize);
- ySubscriptXOffset:=BeToN(ySubscriptXOffset);
- ySubscriptYOffset:=BeToN(ySubscriptYOffset);
- ySuperscriptXSize:=BeToN(ySuperscriptXSize);
- ySuperscriptYSize:=BeToN(ySuperscriptYSize);
- ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
- ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
- yStrikeoutSize:=BeToN(yStrikeoutSize);
- yStrikeoutPosition:=BeToN(yStrikeoutPosition);
- sFamilyClass:=BeToN(sFamilyClass);
- ulUnicodeRange1:=BeToN(ulUnicodeRange1);
- ulUnicodeRange2:=BeToN(ulUnicodeRange2);
- ulUnicodeRange3:=BeToN(ulUnicodeRange3);
- ulUnicodeRange4:=BeToN(ulUnicodeRange4);
- fsSelection:=BeToN(fsSelection);
- usFirstCharIndex:=BeToN(usFirstCharIndex);
- usLastCharIndex:=BeToN(usLastCharIndex);
- sTypoAscender:=BeToN(sTypoAscender);
- sTypoDescender:=BeToN(sTypoDescender);
- sTypoLineGap:=BeToN(sTypoLineGap);
- usWinAscent:=BeToN(usWinAscent);
- usWinDescent:=BeToN(usWinDescent);
- // We miss 7 fields
- end;
With FOS2Data do
- begin
+ begin
+ version:=BeToN(version);
+ xAvgCharWidth:=BeToN(xAvgCharWidth);
+ usWeightClass:=BeToN(usWeightClass);
+ usWidthClass:=BeToN(usWidthClass);
+ fsType:=BeToN(fsType);
+ ySubscriptXSize:=BeToN(ySubscriptXSize);
+ ySubscriptYSize:=BeToN(ySubscriptYSize);
+ ySubscriptXOffset:=BeToN(ySubscriptXOffset);
+ ySubscriptYOffset:=BeToN(ySubscriptYOffset);
+ ySuperscriptXSize:=BeToN(ySuperscriptXSize);
+ ySuperscriptYSize:=BeToN(ySuperscriptYSize);
+ ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
+ ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
+ yStrikeoutSize:=BeToN(yStrikeoutSize);
+ yStrikeoutPosition:=BeToN(yStrikeoutPosition);
+ sFamilyClass:=BeToN(sFamilyClass);
+ ulUnicodeRange1:=BeToN(ulUnicodeRange1);
+ ulUnicodeRange2:=BeToN(ulUnicodeRange2);
+ ulUnicodeRange3:=BeToN(ulUnicodeRange3);
+ ulUnicodeRange4:=BeToN(ulUnicodeRange4);
+ fsSelection:=BeToN(fsSelection);
+ usFirstCharIndex:=BeToN(usFirstCharIndex);
+ usLastCharIndex:=BeToN(usLastCharIndex);
+ sTypoAscender:=BeToN(sTypoAscender);
+ sTypoDescender:=BeToN(sTypoDescender);
+ sTypoLineGap:=BeToN(sTypoLineGap);
+ usWinAscent:=BeToN(usWinAscent);
+ usWinDescent:=BeToN(usWinDescent);
+ // We miss 7 fields
+ end;
+ With FOS2Data do
+ begin
// Read remaining 7 fields' data depending on version
if Version>=1 then
- begin
+ begin
ulCodePageRange1:=ReadUInt32(AStream);
ulCodePageRange2:=ReadUInt32(AStream);
- end;
+ end;
if Version>=2 then
- begin
+ begin
sxHeight:=ReadInt16(AStream);
sCapHeight:=ReadInt16(AStream);
usDefaultChar:=ReadUInt16(AStream);
usBreakChar:=ReadUInt16(AStream);
usMaxContext:=ReadUInt16(AStream);
- end;
end;
+ end;
end;
procedure TTFFileInfo.ParsePost(AStream : TStream);
-
begin
AStream.ReadBuffer(FPostScript,SizeOf(TPostScript));
- if not IsNativeData then
- With FPostScript do
- begin
- Format.Version := BEtoN(Format.Version);
- Format.Minor := FixMinorVersion(Format.Minor);
- ItalicAngle:=BeToN(ItalicAngle);
- UnderlinePosition:=BeToN(UnderlinePosition);
- underlineThickness:=BeToN(underlineThickness);
- isFixedPitch:=BeToN(isFixedPitch);
- minMemType42:=BeToN(minMemType42);
- maxMemType42:=BeToN(maxMemType42);
- minMemType1:=BeToN(minMemType1);
- maxMemType1:=BeToN(maxMemType1);
- end;
+ With FPostScript do
+ begin
+ Format.Version := BEtoN(Format.Version);
+ Format.Minor := FixMinorVersion(Format.Minor);
+ ItalicAngle:=BeToN(ItalicAngle);
+ UnderlinePosition:=BeToN(UnderlinePosition);
+ underlineThickness:=BeToN(underlineThickness);
+ isFixedPitch:=BeToN(isFixedPitch);
+ minMemType42:=BeToN(minMemType42);
+ maxMemType42:=BeToN(maxMemType42);
+ minMemType1:=BeToN(minMemType1);
+ maxMemType1:=BeToN(maxMemType1);
+ end;
end;
procedure TTFFileInfo.LoadFromFile(const AFileName: String);
-
Var
AStream: TFileStream;
begin
@@ -763,31 +767,30 @@ var
begin
FOriginalSize:= AStream.Size;
AStream.ReadBuffer(FTableDir,Sizeof(TTableDirectory));
- if not isNativeData then
- With FTableDir do
- begin
- FontVersion.Version := BEtoN(FontVersion.Version);
- FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
- Numtables:=BeToN(Numtables);
- SearchRange:=BeToN(SearchRange);
- EntrySelector:=BeToN(EntrySelector);
- RangeShift:=BeToN(RangeShift);
- end;
+ With FTableDir do
+ begin
+ FontVersion.Version := BEtoN(FontVersion.Version);
+ FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
+ Numtables:=BeToN(Numtables);
+ SearchRange:=BeToN(SearchRange);
+ EntrySelector:=BeToN(EntrySelector);
+ RangeShift:=BeToN(RangeShift);
+ end;
SetLength(FTables,FTableDir.Numtables);
AStream.ReadBuffer(FTables[0],FTableDir.NumTables*Sizeof(TTableDirectoryEntry));
- if Not IsNativeData then
- For I:=0 to Length(FTables)-1 do
- With FTables[I] do
- begin
- checkSum:=BeToN(checkSum);
- offset:=BeToN(offset);
- Length:=BeToN(Length);
- end;
- for I:=0 to FTableDir.NumTables-1 do
+ For I:=0 to Length(FTables)-1 do
+ With FTables[I] do
begin
+ // note: Tag field doesn't require BEtoN processing.
+ checkSum:=BeToN(checkSum);
+ offset:=BeToN(offset);
+ Length:=BeToN(Length);
+ end;
+ for I:=0 to FTableDir.NumTables-1 do
+ begin
TT:=GetTableType(FTables[I].Tag);
if (TT<>ttUnknown) then
- begin
+ begin
AStream.Position:=FTables[i].Offset;
Case TT of
tthead: ParseHead(AStream);
@@ -799,8 +802,8 @@ begin
ttos2 : ParseOS2(AStream);
ttPost: ParsePost(AStream);
end;
- end;
end;
+ end;
end;
procedure TTFFileInfo.PrepareFontDefinition(const Encoding: string; Embed: Boolean);
@@ -813,13 +816,13 @@ begin
// MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth); // Char(32) - Space character
FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth; // Char(32) - Space character
for I:=0 to 255 do
- begin
+ begin
if (CharCodes^[i]>=0) and (CharCodes^[i]<=High(Chars))
and (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth)
else
CharWidth[I]:= FMissingWidth;
- end;
+ end;
end;
procedure TTFFileInfo.PrepareEncoding(const AEncoding: String);
@@ -842,12 +845,12 @@ begin
L:= 0;
for i:=32 to 255 do
if CharNames^[i]<>CharBase^[i] then
- begin
+ begin
if (i<>l+1) then
Result:= Result+IntToStr(i)+' ';
l:=i;
Result:= Result+'/'+CharNames^[i]+' ';
- end;
+ end;
end;
function TTFFileInfo.Bold: Boolean;
@@ -900,6 +903,23 @@ begin
result := Chars[AValue];
end;
+function TTFFileInfo.GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
+var
+ i: integer;
+begin
+ FillMem(@AEntry, SizeOf(TTableDirectoryEntry), 0);
+ Result := False;
+ for i := Low(Tables) to High(Tables) do
+ begin
+ if CompareStr(Tables[i].Tag, ATableName) = 0 then
+ begin
+ Result := True;
+ AEntry := Tables[i];
+ Exit;
+ end;
+ end;
+end;
+
function TTFFileInfo.GetAdvanceWidth(AIndex: word): word;
begin
Result := Widths[AIndex].AdvanceWidth;
@@ -948,11 +968,6 @@ begin
Result := FMissingWidth;
end;
-function TTFFileInfo.IsNativeData: Boolean;
-begin
- Result:=False;
-end;
-
function TTFFileInfo.ToNatural(AUnit: Smallint): Smallint;
begin
if FHead.UnitsPerEm=0 then
diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp
index 4826a2f02a..f30187c9f6 100644
--- a/packages/fcl-pdf/src/fppdf.pp
+++ b/packages/fcl-pdf/src/fppdf.pp
@@ -37,7 +37,9 @@ uses
fpImage,
FPReadJPEG, FPReadPNG, FPReadBMP, // these are required for auto image-handler functionality
zstream,
- fpparsettf;
+ fpparsettf,
+ fpTTFSubsetter,
+ FPFontTextMapping;
Const
{ Some popular predefined colors. Channel format is: RRGGBB }
@@ -57,6 +59,7 @@ Const
clNavy = $000080;
clPurple = $800080;
clLime = $00FF00;
+ clWaterMark = $F0F0F0;
type
TPDFPaperType = (ptCustom, ptA4, ptA5, ptLetter, ptLegal, ptExecutive, ptComm10, ptMonarch, ptDL, ptC5, ptB5);
@@ -65,7 +68,7 @@ type
TPDFPageLayout = (lSingle, lTwo, lContinuous);
TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
- TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts, poPageOriginAtTop);
+ TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts, poPageOriginAtTop, poSubsetFont);
TPDFOptions = set of TPDFOption;
EPDF = Class(Exception);
@@ -74,6 +77,7 @@ type
TPDFDocument = class;
TPDFAnnotList = class;
TPDFLineStyleDef = class;
+ TPDFPage = class;
TARGBColor = Cardinal;
TPDFFloat = Single;
@@ -122,6 +126,9 @@ type
procedure SetYTranslation(const AValue: TPDFFloat);
end;
+ // CharWidth array of standard PDF fonts
+ TPDFFontWidthArray = array[0..255] of integer;
+
TPDFObject = class(TObject)
Protected
@@ -255,11 +262,12 @@ type
TPDFString = class(TPDFAbstractString)
private
- FValue: string;
+ FValue: AnsiString;
protected
procedure Write(const AStream: TStream); override;
public
- constructor Create(Const ADocument : TPDFDocument; const AValue: string); overload;
+ constructor Create(Const ADocument : TPDFDocument; const AValue: AnsiString); overload;
+ property Value: AnsiString read FValue;
end;
@@ -272,6 +280,7 @@ type
procedure Write(const AStream: TStream); override;
public
constructor Create(Const ADocument : TPDFDocument; const AValue: UTF8String; const AFontIndex: integer); overload;
+ property Value: UTF8String read FValue;
end;
{ Is useful to populate an array with free-form space separated values. This
@@ -284,6 +293,7 @@ type
procedure Write(const AStream: TStream); override;
public
constructor Create(Const ADocument: TPDFDocument; const AValue: string); overload;
+ property Value: string read FValue;
end;
@@ -318,51 +328,64 @@ type
private
FTxtFont: integer;
FTxtSize: string;
+ FPage: TPDFPage;
+ function GetPointSize: integer;
protected
procedure Write(const AStream: TStream); override;
- Class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
+ class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
+ class function WriteEmbeddedSubsetFont(const ADocument: TPDFDocument; const AFontNum: integer; const AOutStream: TStream): int64;
public
- constructor Create(Const ADocument : TPDFDocument;const AFont: integer; const ASize: string); overload;
+ constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: string); overload;
+ property FontIndex: integer read FTxtFont;
+ property PointSize: integer read GetPointSize;
+ property Page: TPDFPage read FPage;
end;
- TPDFText = class(TPDFDocumentObject)
+ TPDFBaseText = class(TPDFDocumentObject)
private
FX: TPDFFloat;
FY: TPDFFloat;
+ FFont: TPDFEmbeddedFont;
+ FDegrees: single;
+ FUnderline: boolean;
+ FColor: TARGBColor;
+ FStrikeThrough: boolean;
+ public
+ constructor Create(const ADocument: TPDFDocument); override;
+ property X: TPDFFloat read FX write FX;
+ property Y: TPDFFloat read FY write FY;
+ property Font: TPDFEmbeddedFont read FFont write FFont;
+ property Degrees: single read FDegrees write FDegrees;
+ property Underline: boolean read FUnderline write FUnderline;
+ property Color: TARGBColor read FColor write FColor;
+ property StrikeThrough: boolean read FStrikeThrough write FStrikeThrough;
+ end;
+
+
+ TPDFText = class(TPDFBaseText)
+ private
FString: TPDFString;
- FFontIndex: integer;
- FDegrees: single;
+ function GetTextWidth: single;
+ function GetTextHeight: single;
protected
- procedure Write(const AStream: TStream); override;
+ procedure Write(const AStream: TStream); override;
public
- constructor Create(Const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString; const AFontIndex: integer; const ADegrees: single); overload;
- destructor Destroy; override;
- Property X : TPDFFloat Read FX Write FX;
- Property Y : TPDFFloat Read FY Write FY;
- Property Text : TPDFString Read FString;
- property FontIndex: integer read FFontIndex;
- property Degrees: single read FDegrees;
+ constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
+ destructor Destroy; override;
+ property Text: TPDFString read FString;
end;
- TPDFUTF8Text = class(TPDFDocumentObject)
+ TPDFUTF8Text = class(TPDFBaseText)
private
- FX: TPDFFloat;
- FY: TPDFFloat;
FString: TPDFUTF8String;
- FFontIndex: integer;
- FDegrees: single;
protected
- procedure Write(const AStream: TStream); override;
+ procedure Write(const AStream: TStream); override;
public
- constructor Create(Const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String; const AFontIndex: integer; const ADegrees: single); overload;
- destructor Destroy; override;
- Property X : TPDFFloat Read FX Write FX;
- Property Y : TPDFFloat Read FY Write FY;
- Property Text : TPDFUTF8String Read FString;
- property FontIndex: integer read FFontIndex;
- property Degrees: single read FDegrees;
+ constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
+ destructor Destroy; override;
+ property Text: TPDFUTF8String read FString;
end;
@@ -416,10 +439,10 @@ type
FWidth: TPDFFloat;
FStroke: Boolean;
protected
- 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;
public
+ Class Function Command(Const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo: TPDFFloat): String; overload;
+ Class Function Command(Const ACtrl1, ACtrl2, ATo3: TPDFCoord): String; 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;
@@ -507,10 +530,13 @@ type
FGreen: string;
FBlue: string;
FStroke: Boolean;
+ FColor: TARGBColor;
protected
procedure Write(const AStream: TStream);override;
public
+ class function Command(const AStroke: boolean; const AColor: TARGBColor): string;
constructor Create(Const ADocument : TPDFDocument; const AStroke: Boolean; AColor: TARGBColor); overload;
+ property Color: TARGBColor read FColor;
end;
@@ -591,19 +617,17 @@ type
{ When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
per the PDF specification, from the bottom-left. }
-
- { TPDFPage }
-
TPDFPage = Class(TPDFDocumentObject)
private
FObjects : TObjectList;
FOrientation: TPDFPaperOrientation;
FPaper: TPDFPaper;
FPaperType: TPDFPaperType;
- FFontIndex: integer;
FUnitOfMeasure: TPDFUnitOfMeasure;
FMatrix: TPDFMatrix;
FAnnots: TPDFAnnotList;
+ FLastFont: TPDFEmbeddedFont;
+ FLastFontColor: TARGBColor;
procedure CalcPaperSize;
function GetO(AIndex : Integer): TPDFObject;
function GetObjectCount: Integer;
@@ -615,8 +639,8 @@ type
protected
procedure AdjustMatrix; virtual;
procedure DoUnitConversion(var APoint: TPDFCoord); virtual;
- procedure CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; AFontIndex: integer; const ADegrees: single); virtual;
- procedure CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; AFontIndex: integer; const ADegrees: single); virtual;
+ procedure CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); virtual;
+ procedure CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); virtual;
Public
Constructor Create(Const ADocument : TPDFDocument); override;
Destructor Destroy; override;
@@ -630,8 +654,8 @@ type
Procedure SetLineStyle(AIndex : Integer; AStroke : Boolean = True); overload;
Procedure SetLineStyle(S : TPDFLineStyleDef; AStroke : Boolean = True); overload;
{ output coordinate is the font baseline. }
- Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String; const ADegrees: single = 0.0); overload;
- Procedure WriteText(APos: TPDFCoord; AText : UTF8String; const ADegrees: single = 0.0); overload;
+ Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String; const ADegrees: single = 0.0; const AUnderline: boolean = false; const AStrikethrough: boolean = false); overload;
+ Procedure WriteText(APos: TPDFCoord; AText : UTF8String; const ADegrees: single = 0.0; const AUnderline: boolean = false; const AStrikethrough: boolean = false); overload;
procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat; const AStroke: Boolean = True); overload;
procedure DrawLine(APos1, APos2: TPDFCoord; ALineWidth: TPDFFloat; const AStroke: Boolean = True); overload;
Procedure DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer); overload;
@@ -700,8 +724,8 @@ type
property UnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write SetUnitOfMeasure default uomMillimeters;
Property ObjectCount: Integer Read GetObjectCount;
Property Objects[AIndex : Integer] : TPDFObject Read GetO; default;
- // returns the last used FontIndex used in SetFont()
- property FontIndex: integer read FFontIndex;
+ // returns the last font object created by SetFont()
+ property LastFont: TPDFEmbeddedFont read FLastFont;
{ A 3x3 matrix used to translate the PDF Cartesian coordinate system to an Image coordinate system. }
property Matrix: TPDFMatrix read FMatrix write FMatrix;
property Annots: TPDFAnnotList read FAnnots;
@@ -735,39 +759,7 @@ 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;
-
-
- TPDFFont = CLass(TCollectionItem)
+ TPDFFont = class(TCollectionItem)
private
FIsStdFont: boolean;
FName: String;
@@ -775,9 +767,12 @@ type
FTrueTypeFile: TTFFileInfo;
{ stores mapping of Char IDs to font Glyph IDs }
FTextMappingList: TTextMappingList;
+ FSubsetFont: TStream;
procedure PrepareTextMapping;
procedure SetFontFilename(AValue: string);
+ procedure GenerateSubsetFont;
public
+ constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
{ Returns a string where each character is replaced with a glyph index value instead. }
function GetGlyphIndices(const AText: UnicodeString): AnsiString;
@@ -786,6 +781,7 @@ type
Property Name: String Read FName Write FName;
property TextMapping: TTextMappingList read FTextMappingList;
property IsStdFont: boolean read FIsStdFont write FIsStdFont;
+ property SubsetFont: TStream read FSubsetFont;
end;
@@ -884,8 +880,6 @@ type
end;
- { TPDFImages }
-
TPDFImages = Class(TCollection)
Private
FOwner: TPDFDocument;
@@ -904,14 +898,30 @@ type
end;
- TPDFToUnicode = class(TPDFDocumentObject)
- private
- FEmbeddedFontNum: integer;
+ TPDFFontNumBaseObject = class(TPDFDocumentObject)
protected
- procedure Write(const AStream: TStream);override;
+ FFontNum: integer;
public
- constructor Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer); overload;
- property EmbeddedFontNum: integer read FEmbeddedFontNum;
+ constructor Create(const ADocument: TPDFDocument; const AFontNum: integer); overload;
+ property FontNum: integer read FFontNum;
+ end;
+
+
+ TPDFToUnicode = class(TPDFFontNumBaseObject)
+ protected
+ procedure Write(const AStream: TStream); override;
+ end;
+
+
+ TCIDToGIDMap = class(TPDFFontNumBaseObject)
+ protected
+ procedure Write(const AStream: TStream); override;
+ end;
+
+
+ TPDFCIDSet = class(TPDFFontNumBaseObject)
+ protected
+ procedure Write(const AStream: TStream); override;
end;
@@ -921,7 +931,7 @@ type
FLineWidth: TPDFFloat;
FPenStyle: TPDFPenStyle;
Public
- Procedure Assign(Source : TPersistent); override;
+ Procedure Assign(Source : TPersistent); override;
Published
Property LineWidth : TPDFFloat Read FLineWidth Write FLineWidth;
Property Color : TARGBColor Read FColor Write FColor Default clBlack;
@@ -938,8 +948,6 @@ type
end;
- { TPDFDocument }
-
TPDFDocument = class(TComponent)
private
FCatalogue: integer;
@@ -963,9 +971,11 @@ type
FZoomValue: string;
FGlobalXRefs: TFPObjectList; // list of TPDFXRef
FUnitOfMeasure: TPDFUnitOfMeasure;
+ function GetStdFontCharWidthsArray(const AFontName: string): TPDFFontWidthArray;
function GetX(AIndex : Integer): TPDFXRef;
function GetXC: Integer;
function GetTotalAnnotsCount: integer;
+ function GetFontNamePrefix(const AFontNum: Integer): string;
procedure SetFontFiles(AValue: TStrings);
procedure SetFonts(AValue: TPDFFontDefs);
procedure SetInfos(AValue: TPDFInfos);
@@ -1005,10 +1015,12 @@ type
procedure CreateTTFCIDSystemInfo;virtual;
procedure CreateTp1Font(const EmbeddedFontNum: integer);virtual;
procedure CreateFontDescriptor(const EmbeddedFontNum: integer);virtual;
- procedure CreateToUnicode(const EmbeddedFontNum: integer);virtual;
- procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual;
+ procedure CreateToUnicode(const AFontNum: integer);virtual;
+ procedure CreateFontFileEntry(const AFontNum: integer);virtual;
+ procedure CreateCIDSet(const AFontNum: integer); virtual;
procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
function CreateAnnotEntry(const APageNum, AnnotNum: integer): integer; virtual;
+ function CreateCIDToGIDMap(const AFontNum: integer): integer; virtual;
procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
Function CreateString(Const AValue : String) : TPDFString;
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
@@ -1027,11 +1039,12 @@ type
procedure StartDocument;
procedure Reset;
procedure SaveToStream(const AStream: TStream); virtual;
- Procedure SaveToFile(Const AFileName : String);
+ Procedure SaveToFile(Const AFileName : String);
+ function IsStandardPDFFont(AFontName: string): boolean;
// Create objects, owned by this document.
- Function CreateEmbeddedFont(AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
- Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFontIndex: integer; const ADegrees: single) : TPDFText; overload;
- Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer; const ADegrees: single) : TPDFUTF8Text; overload;
+ Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
+ Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFText; overload;
+ Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF8Text; overload;
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;
@@ -1057,7 +1070,7 @@ type
Property FontDirectory: string Read FFontDirectory Write FFontDirectory;
Property Sections : TPDFSectionList Read FSections;
Property ObjectCount : Integer Read FObjectCount;
- Published
+ Published
Property Options : TPDFOptions Read FOptions Write FOPtions;
Property LineStyles : TPDFLineStyleDefs Read FLineStyleDefs Write SetLineStyles;
property PageLayout: TPDFPageLayout read FPageLayout write FPageLayout default lSingle;
@@ -1065,7 +1078,7 @@ type
Property DefaultPaperType : TPDFPaperTYpe Read FDefaultPaperType Write FDefaultPaperType;
Property DefaultOrientation : TPDFPaperOrientation Read FDefaultOrientation Write FDefaultOrientation;
property DefaultUnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write FUnitOfMeasure default uomMillimeters;
-
+
end;
@@ -1130,7 +1143,8 @@ function PDFCoord(x, y: TPDFFloat): TPDFCoord;
implementation
uses
- math;
+ math,
+ fpttf;
resourcestring
@@ -1140,34 +1154,29 @@ resourcestring
rsErrNoGlobalDict = 'Error: no global XRef named "%s".';
rsErrInvalidPageIndex = 'Invalid page index: %d';
rsErrInvalidAnnotIndex = 'Invalid annot index: %d';
- rsErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
+ rsErrNoFontDefined = 'No Font was set - please use SetFont() first.';
rsErrNoImageReader = 'Unsupported image format - no image reader available.';
+ rsErrUnknownStdFont = 'Unknown standard PDF font name <%s>.';
+
+{ Includes font metrics constant arrays for the standard PDF fonts. They are
+ not used at the moment, but in future we might want to do something with
+ them. }
+{$I fontmetrics_stdpdf.inc }
type
// to get access to protected methods
TTTFFriendClass = class(TTFFileInfo)
end;
-const
- // Dot = linewidth; Dash = (5 x linewidth); Gap = (3 x linewidth);
- cPenStyleBitmasks: array[TPDFPenStyle] of string = (
- '', // ppsSolid
- '%0.2f %0.2f', // ppsDash (dash space ...)
- '%0.2f %0.2f', // ppsDot (dot space ...)
- '%0.2f %0.2f %0.2f %0.2f', // ppsDashDot (dash space dot space ...)
- '%0.2f %0.2f %0.2f %0.2f %0.2f %0.2f' // ppsDashDotDot (dash space dot space dot space ...)
- );
const
cInchToMM = 25.4;
cInchToCM = 2.54;
cDefaultDPI = 72;
-
// mm = (pixels * 25.4) / dpi
// pixels = (mm * dpi) / 25.4
// cm = ((pixels * 25.4) / dpi) / 10
-const
// see http://paste.lisp.org/display/1105
BEZIER: single = 0.5522847498; // = 4/3 * (sqrt(2) - 1);
@@ -1354,68 +1363,6 @@ begin
_21 := AValue;
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 }
procedure TPDFFont.PrepareTextMapping;
@@ -1438,10 +1385,41 @@ begin
PrepareTextMapping;
end;
+procedure TPDFFont.GenerateSubsetFont;
+var
+ f: TFontSubsetter;
+ {$ifdef gdebug}
+ fs: TFileStream;
+ {$endif}
+begin
+ if Assigned(FSubsetFont) then
+ FreeAndNil(FSubSetFont);
+ f := TFontSubsetter.Create(FTrueTypeFile, FTextMappingList);
+ try
+ FSubSetFont := TMemoryStream.Create;
+ f.SaveToStream(FSubsetFont);
+ {$ifdef gdebug}
+ fs := TFileStream.Create(FTrueTypeFile.PostScriptName + '-subset.ttf', fmCreate);
+ FSubSetFont.Position := 0;
+ TMemoryStream(FSubsetFont).SaveToStream(fs);
+ fs.Free;
+ {$endif}
+ finally
+ f.Free;
+ end;
+end;
+
+constructor TPDFFont.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FSubsetFont := nil;
+end;
+
destructor TPDFFont.Destroy;
begin
FTextMappingList.Free;
FTrueTypeFile.Free;
+ FSubSetFont.Free;
inherited Destroy;
end;
@@ -1449,6 +1427,7 @@ function TPDFFont.GetGlyphIndices(const AText: UnicodeString): AnsiString;
var
i: integer;
c: word;
+ n: integer;
begin
Result := '';
if Length(AText) = 0 then
@@ -1456,7 +1435,18 @@ begin
for i := 1 to Length(AText) do
begin
c := Word(AText[i]);
- Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4);
+ //Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4);
+ for n := 0 to FTextMappingList.Count-1 do
+ begin
+ if FTextMappingList[n].CharID = c then
+ begin
+ //if poSubsetFont in Document.Options then
+ // result := Result + IntToHex(FTextMappingList[n].NewGlyphID, 4);
+ //else
+ result := Result + IntToHex(FTextMappingList[n].GlyphID, 4);
+ break;
+ end;
+ end;
end;
end;
@@ -1464,18 +1454,22 @@ procedure TPDFFont.AddTextToMappingList(const AText: UnicodeString);
var
i: integer;
c: uint16; // Unicode codepoint
+ gid: uint16;
begin
if AText = '' then
Exit;
for i := 1 to Length(AText) do
begin
c := uint16(AText[i]);
- FTextMappingList.Add(c, FTrueTypeFile.GetGlyphIndex(c));
+ gid := FTrueTypeFile.GetGlyphIndex(c);
+ FTextMappingList.Add(c, gid);
end;
end;
{ TPDFTrueTypeCharWidths }
+// TODO: (optional improvement) CID -> Unicode mappings, use ranges to generate a smaller CMap
+// See pdfbox's writeTo() method in ToUnicodeWriter.java
procedure TPDFTrueTypeCharWidths.Write(const AStream: TStream);
var
i: integer;
@@ -1485,7 +1479,9 @@ var
begin
s := '';
lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+ lst.Sort;
lFont := Document.Fonts[EmbeddedFontNum].FTrueTypeFile;
+ // use decimal values for the output
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);
@@ -1773,7 +1769,7 @@ begin
PenStyle:=L.PenStyle;
end
else
- Inherited;
+ Inherited;
end;
@@ -1960,7 +1956,7 @@ begin
if AText = '' then
Exit;
str := UTF8Decode(AText);
- Document.Fonts[FFontIndex].AddTextToMappingList(str);
+ Document.Fonts[FLastFont.FontIndex].AddTextToMappingList(str);
end;
procedure TPDFPage.DoUnitConversion(var APoint: TPDFCoord);
@@ -1984,20 +1980,22 @@ begin
end;
end;
-procedure TPDFPage.CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; AFontIndex: integer; const ADegrees: single);
+procedure TPDFPage.CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
+ const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
var
T: TPDFText;
begin
- T := Document.CreateText(X, Y, AText, AFontIndex, ADegrees);
+ T := Document.CreateText(X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
AddObject(T);
end;
-procedure TPDFPage.CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; AFontIndex: integer; const ADegrees: single);
+procedure TPDFPage.CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont;
+ const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
var
T: TPDFUTF8Text;
begin
AddTextToLookupLists(AText);
- T := Document.CreateText(X, Y, AText, FFontIndex, ADegrees);
+ T := Document.CreateText(X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
AddObject(T);
end;
@@ -2026,7 +2024,8 @@ end;
constructor TPDFPage.Create(const ADocument: TPDFDocument);
begin
inherited Create(ADocument);
- FFontIndex := -1;
+ FLastFont := nil;
+ FLastFontColor := clBlack;
FPaperType := ptA4;
FUnitOfMeasure := uomMillimeters;
CalcPaperSize;
@@ -2059,40 +2058,35 @@ begin
end;
procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: Integer);
-
Var
F : TPDFEmbeddedFont;
-
begin
- F:=Document.CreateEmbeddedFont(AFontIndex,AFontSize);
+ F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize);
AddObject(F);
- FFontIndex := AFontIndex;
+ FLastFont := F;
end;
procedure TPDFPage.SetColor(AColor: TARGBColor; AStroke : Boolean = True);
-
Var
C : TPDFColor;
-
begin
C:=Document.CreateColor(AColor,AStroke);
+ if not AStroke then
+ FLastFontColor := AColor;
AddObject(C);
end;
procedure TPDFPage.SetPenStyle(AStyle: TPDFPenStyle; const ALineWidth: TPDFFloat);
-
Var
L : TPDFLineStyle;
-
begin
L:=Document.CreateLineStyle(AStyle, ALineWidth);
AddObject(L);
end;
procedure TPDFPage.SetLineStyle(AIndex: Integer; AStroke : Boolean = True);
-
begin
- SetLineStyle(Document.LineStyles[Aindex]);
+ SetLineStyle(Document.LineStyles[Aindex],AStroke);
end;
procedure TPDFPage.SetLineStyle(S: TPDFLineStyleDef; AStroke: Boolean = True);
@@ -2101,23 +2095,25 @@ begin
SetPenStyle(S.PenStyle,S.LineWidth);
end;
-procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String; const ADegrees: single);
+procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String; const ADegrees: single;
+ const AUnderline: boolean; const AStrikethrough: boolean);
var
p: TPDFCoord;
begin
- if FFontIndex = -1 then
- raise EPDF.Create(rsErrNoFontIndex);
+ if not Assigned(FLastFont) then
+ raise EPDF.Create(rsErrNoFontDefined);
p := Matrix.Transform(X, Y);
DoUnitConversion(p);
- if Document.Fonts[FFontIndex].IsStdFont then
- CreateStdFontText(p.X, p.Y, AText, FFontIndex, ADegrees)
+ if Document.Fonts[FLastFont.FontIndex].IsStdFont then
+ CreateStdFontText(p.X, p.Y, AText, FLastFont, ADegrees, AUnderline, AStrikeThrough)
else
- CreateTTFFontText(p.X, p.Y, AText, FFontIndex, ADegrees);
+ CreateTTFFontText(p.X, p.Y, AText, FLastFont, ADegrees, AUnderline, AStrikeThrough);
end;
-procedure TPDFPage.WriteText(APos: TPDFCoord; AText: UTF8String; const ADegrees: single);
+procedure TPDFPage.WriteText(APos: TPDFCoord; AText: UTF8String; const ADegrees: single;
+ const AUnderline: boolean; const AStrikethrough: boolean);
begin
- WriteText(APos.X, APos.Y, AText, ADegrees);
+ WriteText(APos.X, APos.Y, AText, ADegrees, AUnderline, AStrikeThrough);
end;
procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat; const AStroke: Boolean = True);
@@ -2921,6 +2917,7 @@ begin
Str(F:4:0,Result)
else
Str(F:4:2,Result);
+ result := trim(Result);
end;
procedure TPDFObject.Write(const AStream: TStream);
@@ -3165,6 +3162,11 @@ begin
inherited;
end;
+function TPDFEmbeddedFont.GetPointSize: integer;
+begin
+ Result := StrToInt(FTxtSize);
+end;
+
procedure TPDFEmbeddedFont.Write(const AStream: TStream);
begin
WriteString('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF, AStream);
@@ -3195,46 +3197,177 @@ begin
WriteString('endstream', AStream);
end;
-constructor TPDFEmbeddedFont.Create(Const ADocument : TPDFDocument;const AFont: integer; const ASize: string);
+class function TPDFEmbeddedFont.WriteEmbeddedSubsetFont(const ADocument: TPDFDocument;
+ const AFontNum: integer; const AOutStream: TStream): int64;
+var
+ PS: int64;
+ CompressedStream: TMemoryStream;
begin
- inherited Create(ADocument);
- FTxtFont:=AFont;
- FTxtSize:=ASize;
+ if ADocument.Fonts[AFontNum].SubsetFont = nil then
+ raise Exception.Create('WriteEmbeddedSubsetFont: SubsetFont stream was not initialised.');
+ WriteString(CRLF+'stream'+CRLF, AOutStream);
+ PS := AOutStream.Position;
+ if poCompressFonts in ADocument.Options then
+ begin
+ CompressedStream := TMemoryStream.Create;
+ CompressStream(ADocument.Fonts[AFontNum].SubsetFont, CompressedStream);
+ CompressedStream.Position := 0;
+ CompressedStream.SaveToStream(AOutStream);
+ CompressedStream.Free;
+ end
+ else
+ begin
+ ADocument.Fonts[AFontNum].SubsetFont.Position := 0;
+ TMemoryStream(ADocument.Fonts[AFontNum].SubsetFont).SaveToStream(AOutStream);
+ end;
+ Result := AOutStream.Position-PS;
+
+ WriteString(CRLF, AOutStream);
+ WriteString('endstream', AOutStream);
end;
+constructor TPDFEmbeddedFont.Create(const ADocument: TPDFDocument; const APage: TPDFPage; const AFont: integer;
+ const ASize: string);
+begin
+ inherited Create(ADocument);
+ FTxtFont := AFont;
+ FTxtSize := ASize;
+ FPage := APage;
+end;
+
+{ TPDFBaseText }
+
+constructor TPDFBaseText.Create(const ADocument: TPDFDocument);
+begin
+ inherited Create(ADocument);
+ FX := 0.0;
+ FY := 0.0;
+ FFont := nil;
+ FDegrees := 0.0;
+ FUnderline := False;
+ FColor := clBlack;
+ FStrikeThrough := False;
+end;
+
+{ TPDFText }
+
+function TPDFText.GetTextWidth: single;
+var
+ i: integer;
+ lWidth: double;
+ lFontName: string;
+begin
+ lFontName := Document.Fonts[Font.FontIndex].Name;
+ if not Document.IsStandardPDFFont(lFontName) then
+ raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
+
+ lWidth := 0;
+ for i := 1 to Length(FString.Value) do
+ lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(FString.Value[i])];
+ Result := lWidth * Font.PointSize / 1540;
+end;
+
+function TPDFText.GetTextHeight: single;
+var
+ lFontName: string;
+begin
+ lFontName := Document.Fonts[Font.FontIndex].Name;
+ Result := 0;
+ case lFontName of
+ 'Courier': result := FONT_TIMES_COURIER_CAPHEIGHT;
+ 'Courier-Bold': result := FONT_TIMES_COURIER_CAPHEIGHT;
+ 'Courier-Oblique': result := FONT_TIMES_COURIER_CAPHEIGHT;
+ 'Courier-BoldOblique': result := FONT_TIMES_COURIER_CAPHEIGHT;
+ 'Helvetica': result := FONT_HELVETICA_ARIAL_CAPHEIGHT;
+ 'Helvetica-Bold': result := FONT_HELVETICA_ARIAL_BOLD_CAPHEIGHT;
+ 'Helvetica-Oblique': result := FONT_HELVETICA_ARIAL_ITALIC_CAPHEIGHT;
+ 'Helvetica-BoldOblique': result := FONT_HELVETICA_ARIAL_BOLD_ITALIC_CAPHEIGHT;
+ 'Times-Roman': result := FONT_TIMES_CAPHEIGHT;
+ 'Times-Bold': result := FONT_TIMES_BOLD_CAPHEIGHT;
+ 'Times-Italic': result := FONT_TIMES_ITALIC_CAPHEIGHT;
+ 'Times-BoldItalic': result := FONT_TIMES_BOLD_ITALIC_CAPHEIGHT;
+ 'Symbol': result := 300;
+ 'ZapfDingbats': result := 300;
+ else
+ raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
+ end;
+ Result := Result * Font.PointSize / 1540;
+end;
procedure TPDFText.Write(const AStream: TStream);
var
t1, t2, t3: string;
rad: single;
+ lWidth: single;
+ lTextWidthInMM: single;
+ lHeight: single;
+ lTextHeightInMM: single;
+ lColor: string;
+ lLineWidth: string;
begin
+ inherited Write(AStream);
WriteString('BT'+CRLF, AStream);
- if FDegrees <> 0.0 then
+ if Degrees <> 0.0 then
begin
- rad := DegToRad(-FDegrees);
- t1 := FormatFloat('0.###;;0', Cos(rad));
- t2 := FormatFloat('0.###;;0', -Sin(rad));
- t3 := FormatFloat('0.###;;0', Sin(rad));
- WriteString(Format('%s %s %s %s %.4f %.4f Tm', [t1, t2, t3, t1, FX, FY]) + CRLF, AStream);
+ rad := DegToRad(-Degrees);
+ t1 := FloatStr(Cos(rad));
+ t2 := FloatStr(-Sin(rad));
+ t3 := FloatStr(Sin(rad));
+ WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
end
else
begin
- WriteString(FloatStr(FX)+' '+FloatStr(FY)+' TD'+CRLF, AStream);
+ WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
end;
FString.Write(AStream);
WriteString(' Tj'+CRLF, AStream);
WriteString('ET'+CRLF, AStream);
+
+ if (not Underline) and (not StrikeThrough) then
+ Exit;
+
+ // result is in Font Units
+ lWidth := GetTextWidth;
+ lHeight := GetTextHeight;
+ { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+ lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+ lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+ if Degrees <> 0.0 then
+ // angled text
+ WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+ else
+ // horizontal text
+ WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+ { set up a pen width and stroke color }
+ lColor := TPDFColor.Command(True, Color);
+ lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
+ WriteString(lLineWidth + lColor + CRLF, AStream);
+
+ { line segment is relative to matrix translation coordinate, set above }
+ if Underline then
+ WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream)
+ else
+ WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+
+ { restore graphics state to before the translation matrix adjustment }
+ WriteString('Q' + CRLF, AStream);
end;
constructor TPDFText.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString;
- const AFontIndex: integer; const ADegrees: single);
+ const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
begin
inherited Create(ADocument);
- FX := AX;
- FY := AY;
- FFontIndex := AFontIndex;
+ X := AX;
+ Y := AY;
+ Font := AFont;
+ Degrees := ADegrees;
+ Underline := AUnderline;
+ StrikeThrough := AStrikeThrough;
+ if Assigned(AFont) and Assigned(AFont.Page) then
+ Color := AFont.Page.FLastFontColor;
FString := ADocument.CreateString(AText);
- FDegrees := ADegrees;
end;
destructor TPDFText.Destroy;
@@ -3249,34 +3382,84 @@ procedure TPDFUTF8Text.Write(const AStream: TStream);
var
t1, t2, t3: string;
rad: single;
+ lFC: TFPFontCacheItem;
+ lWidth: single;
+ lTextWidthInMM: single;
+ lHeight: single;
+ lTextHeightInMM: single;
+ lColor: string;
+ lLineWidth: string;
+ lDescender: single;
begin
+ inherited Write(AStream);
WriteString('BT'+CRLF, AStream);
- if FDegrees <> 0.0 then
+ if Degrees <> 0.0 then
begin
- rad := DegToRad(-FDegrees);
- t1 := FormatFloat('0.###;;0', Cos(rad));
- t2 := FormatFloat('0.###;;0', -Sin(rad));
- t3 := FormatFloat('0.###;;0', Sin(rad));
- WriteString(Format('%s %s %s %s %.4f %.4f Tm', [t1, t2, t3, t1, FX, FY]) + CRLF, AStream);
+ rad := DegToRad(-Degrees);
+ t1 := FloatStr(Cos(rad));
+ t2 := FloatStr(-Sin(rad));
+ t3 := FloatStr(Sin(rad));
+ WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
end
else
begin
- WriteString(FloatStr(FX)+' '+FloatStr(FY)+' TD'+CRLF, AStream);
+ WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
end;
FString.Write(AStream);
WriteString(' Tj'+CRLF, AStream);
WriteString('ET'+CRLF, AStream);
+
+ if (not Underline) and (not StrikeThrough) then
+ Exit;
+
+ // implement Underline and Strikethrough here
+ lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
+ if not Assigned(lFC) then
+ Exit; // we can't do anything further
+
+ // result is in Font Units
+ lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
+ lHeight := lFC.TextHeight(FString.Value, Font.PointSize, lDescender);
+ { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+ lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+ lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+ if Degrees <> 0.0 then
+ // angled text
+ WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+ else
+ // horizontal text
+ WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+ { set up a pen width and stroke color }
+ lColor := TPDFColor.Command(True, Color);
+ lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
+ WriteString(lLineWidth + lColor + CRLF, AStream);
+
+ { line segment is relative to matrix translation coordinate, set above }
+ if Underline then
+ WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream)
+ else
+ WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+
+ { restore graphics state to before the translation matrix adjustment }
+ WriteString('Q' + CRLF, AStream);
+
end;
constructor TPDFUTF8Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String;
- const AFontIndex: integer; const ADegrees: single);
+ const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
begin
inherited Create(ADocument);
- FX := AX;
- FY := AY;
- FFontIndex := AFontIndex;
- FString := ADocument.CreateUTF8String(AText, AFontIndex);
- FDegrees := ADegrees;
+ X := AX;
+ Y := AY;
+ Font := AFont;
+ Degrees := ADegrees;
+ Underline := AUnderline;
+ if Assigned(AFont) and Assigned(AFont.Page) then
+ Color := AFont.Page.FLastFontColor;
+ StrikeThrough := AStrikeThrough;
+ FString := ADocument.CreateUTF8String(AText, AFont.FontIndex);
end;
destructor TPDFUTF8Text.Destroy;
@@ -3458,6 +3641,7 @@ begin
FSize.Y:=AHeight;
end;
+// Dot = linewidth; Dash = (5 x linewidth); Gap = (3 x linewidth);
procedure TPDFLineStyle.Write(const AStream: TStream);
var
lMask: string;
@@ -3471,19 +3655,19 @@ begin
end;
ppsDash:
begin
- lMask := Format(cPenStyleBitmasks[FStyle], [(5*w), (5*w)]);
+ lMask := FloatStr(5*w) + ' ' + FloatStr(5*w);
end;
ppsDot:
begin
- lMask := Format(cPenStyleBitmasks[FStyle], [(0.8*w), (4*w)]);
+ lMask := FloatStr(0.8*w) + ' ' + FloatStr(4*w)
end;
ppsDashDot:
begin
- lMask := Format(cPenStyleBitmasks[FStyle], [(5*w), (3*w), (0.8*w), (3*w)]);
+ lMask := FloatStr(5*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w)
end;
ppsDashDotDot:
begin
- lMask := Format(cPenStyleBitmasks[FStyle], [(5*w), (3*w), (0.8*w), (3*w), (0.8*w), (3*w)]);
+ lMask := FloatStr(5*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w)
end;
end;
WriteString(Format('[%s] %d d'+CRLF,[lMask, FPhase]), AStream);
@@ -3498,23 +3682,6 @@ begin
FLineWidth := ALineWidth;
end;
-procedure TPDFColor.Write(const AStream: TStream);
-
-Var
- S : String;
-begin
- S:=FRed+' '+FGreen+' '+FBlue;
- if FStroke then
- S:=S+' RG'
- else
- S:=S+' rg';
- if (S<>Document.CurrentColor) then
- begin
- WriteString(S+CRLF, AStream);
- Document.CurrentColor:=S;
- end;
-end;
-
Function ARGBGetRed(AColor : TARGBColor) : Byte;
begin
@@ -3539,9 +3706,40 @@ begin
Result:=((AColor shr 24) and $FF)
end;
+procedure TPDFColor.Write(const AStream: TStream);
+var
+ S : String;
+begin
+ S:=FRed+' '+FGreen+' '+FBlue;
+ if FStroke then
+ S:=S+' RG'
+ else
+ S:=S+' rg';
+ if (S<>Document.CurrentColor) then
+ begin
+ WriteString(S+CRLF, AStream);
+ Document.CurrentColor:=S;
+ end;
+end;
+
+class function TPDFColor.Command(const AStroke: boolean; const AColor: TARGBColor): string;
+var
+ lR, lG, lB: string;
+begin
+ lR := FloatStr(ARGBGetRed(AColor)/256);
+ lG := FloatStr(ARGBGetGreen(AColor)/256);
+ lB := FloatStr(ARGBGetBlue(AColor)/256);
+ result := lR+' '+lG+' '+lB+' ';
+ if AStroke then
+ result := result + 'RG'
+ else
+ result := result + 'rg'
+end;
+
constructor TPDFColor.Create(Const ADocument : TPDFDocument; const AStroke: Boolean; AColor: TARGBColor);
begin
inherited Create(ADocument);
+ FColor := AColor;
FRed:=FloatStr( ARGBGetRed(AColor)/256);
FGreen:=FloatStr( ARGBGetGreen(AColor)/256);
FBlue:=FloatStr( ARGBGetBlue(AColor)/256);
@@ -3676,15 +3874,15 @@ begin
end;
if Pos('Length1', E.FKey.Name) > 0 then
begin
- M:=TMemoryStream.Create;
- try
- Value:=E.FKey.Name;
- NumFnt:=StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
- m.LoadFromFile(Document.FontFiles[NumFnt]);
- Buf := TMemoryStream.Create;
+ Value:=E.FKey.Name;
+ NumFnt:=StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
+ if poSubsetFont in Document.Options then
+ begin
+
+ 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);
+ BufSize := TPDFEmbeddedFont.WriteEmbeddedSubsetFont(Document, NumFnt, Buf);
Buf.Position := 0;
// write fontfile stream length in xobject dictionary
D := Document.GlobalXRefs[AObject].Dict;
@@ -3696,8 +3894,31 @@ begin
finally
Buf.Free;
end;
- finally
- M.Free;
+
+ end
+ else
+ begin
+ M:=TMemoryStream.Create;
+ try
+ m.LoadFromFile(Document.FontFiles[NumFnt]);
+ 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;
end;
end;
end;
@@ -3806,6 +4027,13 @@ begin
FProducer := 'fpGUI Toolkit 1.4';
end;
+{ TPDFFontNumBaseObject }
+
+constructor TPDFFontNumBaseObject.Create(const ADocument: TPDFDocument; const AFontNum: integer);
+begin
+ inherited Create(ADocument);
+ FFontNum := AFontNum;
+end;
{ TPDFToUnicode }
@@ -3814,35 +4042,137 @@ var
lst: TTextMappingList;
i: integer;
begin
- lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+ lst := Document.Fonts[FontNum].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 (Identity)'+CRLF, AStream);
+
+ if poSubsetFont in Document.Options then
+ WriteString('/Ordering (UCS)'+CRLF, AStream)
+ else
+ WriteString('/Ordering (Identity)'+CRLF, AStream);
+
WriteString('/Supplement 0'+CRLF, AStream);
WriteString('>> def'+CRLF, AStream);
- WriteString(Format('/CMapName /%s def', [Document.Fonts[EmbeddedFontNum].FTrueTypeFile.PostScriptName])+CRLF, AStream);
- WriteString('/CMapType 2 def'+CRLF, AStream);
+
+ if poSubsetFont in Document.Options then
+ WriteString('/CMapName /Adobe-Identity-UCS def'+CRLF, AStream)
+ else
+ WriteString(Format('/CMapName /%s def', [Document.Fonts[FontNum].FTrueTypeFile.PostScriptName])+CRLF, AStream);
+
+ WriteString('/CMapType 2 def'+CRLF, AStream); // 2 = ToUnicode
+
+ // ToUnicode always uses 16-bit CIDs
WriteString('1 begincodespacerange'+CRLF, AStream);
WriteString('<0000> <FFFF>'+CRLF, AStream);
WriteString('endcodespacerange'+CRLF, AStream);
- 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);
+
+ if poSubsetFont in Document.Options then
+ begin
+ // use hex values in the output
+
+ WriteString(Format('%d beginbfrange', [lst.Count-1])+CRLF, AStream);
+ for i := 1 to lst.Count-1 do
+ WriteString(Format('<%s> <%0:s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
+ WriteString('endbfrange'+CRLF, AStream);
+
+//WriteString('12 beginbfrange'+CRLF, AStream);
+//WriteString('<0003> <0004> <0020>'+CRLF, AStream);
+//WriteString('<0011> <0011> <002E>'+CRLF, AStream);
+//WriteString('<002A> <002B> <0047>'+CRLF, AStream);
+//WriteString('<0037> <0037> <0054>'+CRLF, AStream);
+//WriteString('<003A> <003A> <0057>'+CRLF, AStream);
+//WriteString('<0044> <0044> <0061>'+CRLF, AStream);
+//WriteString('<0047> <0048> <0064>'+CRLF, AStream);
+//WriteString('<004B> <004C> <0068>'+CRLF, AStream);
+//WriteString('<004F> <0052> <006C>'+CRLF, AStream);
+//WriteString('<0055> <0056> <0072>'+CRLF, AStream);
+//WriteString('<0058> <0058> <0075>'+CRLF, AStream);
+//WriteString('<005C> <005C> <0079>'+CRLF, AStream);
+//WriteString('endbfrange'+CRLF, AStream);
+
+//WriteString('1 beginbfrange'+CRLF, AStream);
+//WriteString('<0000> <FFFF> <0000>'+CRLF, AStream);
+//WriteString('endbfrange'+CRLF, AStream);
+
+ end
+ else
+ begin
+ 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);
+ end;
WriteString('endcmap'+CRLF, AStream);
WriteString('CMapName currentdict /CMap defineresource pop'+CRLF, AStream);
WriteString('end'+CRLF, AStream);
WriteString('end'+CRLF, AStream);
end;
-constructor TPDFToUnicode.Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer);
+
+{ TCIDToGIDMap }
+
+procedure TCIDToGIDMap.Write(const AStream: TStream);
+var
+ lst: TTextMappingList;
+ i: integer;
+ cid, gid: uint16;
+ ba: TBytes;
+ lMaxCharID: integer;
begin
- inherited Create(ADocument);
- FEmbeddedFontNum := AEmbeddedFontNum;
+ lst := Document.Fonts[FontNum].TextMapping;
+ lst.Sort;
+ lMaxCharID := lst.GetMaxCharID;
+ SetLength(ba, (lMaxCharID * 2)+1);
+ // initialize array to 0's
+ for i := 0 to Length(ba)-1 do
+ ba[i] := 0;
+ for i := 0 to lst.Count-1 do
+ begin
+ cid := lst[i].GlyphID;
+ gid := lst[i].NewGlyphID;
+
+ ba[2*cid] := Hi(gid); // Byte((gid shr 8) and $FF); //Hi(gid);
+ ba[(2*cid)+1] := Lo(gid); //Byte(gid and $FF); //Lo(gid);
+ end;
+
+ AStream.WriteBuffer(ba[0], Length(ba));
+ WriteString(CRLF, AStream);
+ SetLength(ba, 0);
+end;
+
+{ TPDFCIDSet }
+
+{ CIDSet uses the bits of each byte for optimised storage. }
+procedure TPDFCIDSet.Write(const AStream: TStream);
+var
+ lst: TTextMappingList;
+ i: integer;
+ cid, gid: uint16;
+ ba: TBytes;
+ mask: uint8;
+ lSize: integer;
+begin
+ lst := Document.Fonts[FontNum].TextMapping;
+ lst.Sort;
+ lSize := (lst.GetMaxCharID div 8) + 1;
+ SetLength(ba, lSize);
+ for i := 0 to lst.Count-1 do
+ begin
+ cid := lst[i].CharID;
+ mask := 1 shl (7 - (cid mod 8));
+ if cid = 0 then
+ gid := 0
+ else
+ gid := cid div 8;
+ ba[gid] := ba[gid] or mask;
+ end;
+ AStream.WriteBuffer(ba[0], Length(ba));
+ WriteString(CRLF, AStream);
+ SetLength(ba, 0);
end;
{ TPDFDocument }
@@ -3871,6 +4201,28 @@ begin
FFontFiles.Assign(AValue);
end;
+function TPDFDocument.GetStdFontCharWidthsArray(const AFontName: string): TPDFFontWidthArray;
+begin
+ case AFontName of
+ 'Courier': result := FONT_COURIER_FULL;
+ 'Courier-Bold': result := FONT_COURIER_FULL;
+ 'Courier-Oblique': result := FONT_COURIER_FULL;
+ 'Courier-BoldOblique': result := FONT_COURIER_FULL;
+ 'Helvetica': result := FONT_HELVETICA_ARIAL;
+ 'Helvetica-Bold': result := FONT_HELVETICA_ARIAL_BOLD;
+ 'Helvetica-Oblique': result := FONT_HELVETICA_ARIAL_ITALIC;
+ 'Helvetica-BoldOblique': result := FONT_HELVETICA_ARIAL_BOLD_ITALIC;
+ 'Times-Roman': result := FONT_TIMES;
+ 'Times-Bold': result := FONT_TIMES_BOLD;
+ 'Times-Italic': result := FONT_TIMES_ITALIC;
+ 'Times-BoldItalic': result := FONT_TIMES_BOLD_ITALIC;
+ 'Symbol': result := FONT_SYMBOL;
+ 'ZapfDingbats': result := FONT_ZAPFDINGBATS;
+ else
+ raise EPDF.CreateFmt(rsErrUnknownStdFont, [AFontName]);
+ end;
+end;
+
function TPDFDocument.GetX(AIndex : Integer): TPDFXRef;
begin
Result:=FGlobalXRefs[Aindex] as TPDFXRef;
@@ -3890,6 +4242,12 @@ begin
Result := Result + Pages[i].Annots.Count;
end;
+function TPDFDocument.GetFontNamePrefix(const AFontNum: Integer): string;
+begin
+ // TODO: it must be 6 uppercase characters - no numbers!
+ Result := 'GRAEA' + Char(65+AFontNum) + '+';
+end;
+
function TPDFDocument.IndexOfGlobalXRef(const AValue: string): integer;
var
i: integer;
@@ -3933,7 +4291,7 @@ var
M : TMemoryStream;
MCompressed: TMemoryStream;
X : TPDFXRef;
- PS: UInt64;
+ d: integer;
begin
TPDFObject.WriteString(IntToStr(AObject)+' 0 obj'+CRLF, AStream);
X:=GlobalXRefs[AObject];
@@ -3946,19 +4304,18 @@ begin
M := TMemoryStream.Create;
X.FStream.Write(M);
+ d := M.Size;
X.Dict.AddInteger('Length', M.Size);
if poCompressText in Options then
begin
MCompressed := TMemoryStream.Create;
CompressStream(M, MCompressed);
- MCompressed.Position := 0;
X.Dict.AddName('Filter', 'FlateDecode');
X.Dict.AddInteger('Length1', MCompressed.Size);
end;
X.Dict.Write(AStream);
- M.Free;
// write stream in contents dictionary
CurrentColor:='';
@@ -3966,11 +4323,18 @@ begin
TPDFObject.WriteString(CRLF+'stream'+CRLF, AStream);
if poCompressText in Options then
begin
+ MCompressed.Position := 0;
MCompressed.SaveToStream(AStream);
MCompressed.Free;
end
else
- X.FStream.Write(AStream);
+ begin
+ M.Position := 0;
+ m.SaveToStream(AStream);
+// X.FStream.Write(AStream);
+ end;
+
+ M.Free;
TPDFObject.WriteString('endstream', AStream);
end;
TPDFObject.WriteString(CRLF+'endobj'+CRLF+CRLF, AStream);
@@ -4145,7 +4509,9 @@ procedure TPDFDocument.CreateStdFont(EmbeddedFontName: string; EmbeddedFontNum:
var
FDict: TPDFDictionary;
N: TPDFName;
+ lFontXRef: integer;
begin
+ lFontXRef := GlobalXRefCount; // will be used a few lines down in AddFontNameToPages()
// add xref entry
FDict := CreateGlobalXRef.Dict;
FDict.AddName('Type', 'Font');
@@ -4156,8 +4522,9 @@ begin
FDict.AddName('BaseFont', EmbeddedFontName);
N := CreateName('F'+IntToStr(EmbeddedFontNum));
FDict.AddElement('Name',N);
- AddFontNameToPages(N.Name,GLobalXRefCount-1);
// add font reference to global page dictionary
+ AddFontNameToPages(N.Name, lFontXRef);
+
FontFiles.Add('');
end;
@@ -4188,29 +4555,36 @@ var
FDict: TPDFDictionary;
N: TPDFName;
Arr: TPDFArray;
+ lFontXRef: integer;
begin
+ lFontXRef := GlobalXRefCount; // will be used a few lines down in AddFontNameToPages()
+
// add xref entry
FDict := CreateGlobalXRef.Dict;
FDict.AddName('Type', 'Font');
FDict.AddName('Subtype', 'Type0');
- FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+
+ if poSubsetFont in Options then
+ FDict.AddName('BaseFont', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name)
+ else
+ FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+
FDict.AddName('Encoding', 'Identity-H');
+
// add name element to font dictionary
N:=CreateName('F'+IntToStr(EmbeddedFontNum));
FDict.AddElement('Name',N);
- AddFontNameToPages(N.Name,GlobalXRefCount-1);
- CreateTTFDescendantFont(EmbeddedFontNum);
+ AddFontNameToPages(N.Name, lFontXRef);
+
Arr := CreateArray;
+ Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount));
FDict.AddElement('DescendantFonts', Arr);
- if (poNoEmbeddedFonts in Options) then
+ CreateTTFDescendantFont(EmbeddedFontNum);
+
+ if not (poNoEmbeddedFonts in Options) then
begin
- Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount-3));
- end
- else
- begin
- Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount-4));
+ FDict.AddReference('ToUnicode', GlobalXRefCount);
CreateToUnicode(EmbeddedFontNum);
- FDict.AddReference('ToUnicode', GlobalXRefCount-1);
end;
FontFiles.Add(Fonts[EmbeddedFontNum].FTrueTypeFile.Filename);
end;
@@ -4224,21 +4598,31 @@ begin
FDict := CreateGlobalXRef.Dict;
FDict.AddName('Type', 'Font');
FDict.AddName('Subtype', 'CIDFontType2');
- FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+ if poSubsetFont in Options then
+ FDict.AddName('BaseFont', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name)
+ else
+ FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+ FDict.AddReference('CIDSystemInfo', GlobalXRefCount);
CreateTTFCIDSystemInfo;
- FDict.AddReference('CIDSystemInfo', GlobalXRefCount-1);
// add fontdescriptor reference to font dictionary
+ FDict.AddReference('FontDescriptor',GlobalXRefCount);
CreateFontDescriptor(EmbeddedFontNum);
- if (poNoEmbeddedFonts in Options) then
- FDict.AddReference('FontDescriptor',GlobalXRefCount-1)
- else
- FDict.AddReference('FontDescriptor',GlobalXRefCount-2);
Arr := CreateArray;
FDict.AddElement('W',Arr);
Arr.AddItem(TPDFTrueTypeCharWidths.Create(self, EmbeddedFontNum));
+
+ // TODO: Implement CIDToGIDMap here
+ { It's an array of 256*256*2, loop through the CID values (from <xxx> Tj) and if
+ CID matches the loop variable, then populate the 2-byte data, otherwise write
+ $0 to the two bytes. Then stream the array as a PDF Reference Object and
+ use compression (if defined in PDFDocument.Options. }
+ if (poSubsetFont in Options) then
+ begin
+ FDict.AddReference('CIDToGIDMap', CreateCIDToGIDMap(EmbeddedFontNum));
+ end;
end;
procedure TPDFDocument.CreateTTFCIDSystemInfo;
@@ -4263,46 +4647,68 @@ var
begin
FDict:=CreateGlobalXRef.Dict;
FDict.AddName('Type', 'FontDescriptor');
- FDict.AddName('FontName', Fonts[EmbeddedFontNum].Name);
- FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName);
+
+ if poSubsetFont in Options then
+ begin
+ FDict.AddName('FontName', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name);
+ FDict.AddInteger('Flags', 4);
+ end
+ else
+ begin
+ FDict.AddName('FontName', Fonts[EmbeddedFontNum].Name);
+ FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName);
+ FDict.AddInteger('Flags', 32);
+ end;
+
FDict.AddInteger('Ascent', Fonts[EmbeddedFontNum].FTrueTypeFile.Ascender);
FDict.AddInteger('Descent', Fonts[EmbeddedFontNum].FTrueTypeFile.Descender);
FDict.AddInteger('CapHeight', Fonts[EmbeddedFontNum].FTrueTypeFile.CapHeight);
- FDict.AddInteger('Flags', 32);
Arr:=CreateArray;
FDict.AddElement('FontBBox',Arr);
Arr.AddIntArray(Fonts[EmbeddedFontNum].FTrueTypeFile.BBox);
FDict.AddInteger('ItalicAngle', trunc(Fonts[EmbeddedFontNum].FTrueTypeFile.ItalicAngle));
FDict.AddInteger('StemV', Fonts[EmbeddedFontNum].FTrueTypeFile.StemV);
FDict.AddInteger('MissingWidth', Fonts[EmbeddedFontNum].FTrueTypeFile.MissingWidth);
- if (poNoEmbeddedFonts in Options) then
- begin
- // do nothing
- end
- else
+ if not (poNoEmbeddedFonts in Options) then
begin
+ FDict.AddReference('FontFile2', GlobalXRefCount);
CreateFontFileEntry(EmbeddedFontNum);
- FDict.AddReference('FontFile2',GlobalXRefCount-1);
+
+ if poSubsetFont in Options then
+ begin
+ // todo /CIDSet reference
+ FDict.AddReference('CIDSet', GlobalXRefCount);
+ CreateCIDSet(EmbeddedFontNum);
+ end;
end;
end;
-procedure TPDFDocument.CreateToUnicode(const EmbeddedFontNum: integer);
+procedure TPDFDocument.CreateToUnicode(const AFontNum: integer);
var
lXRef: TPDFXRef;
begin
lXRef := CreateGlobalXRef;
lXRef.FStream := CreateStream(True);
- lXRef.FStream.AddItem(TPDFToUnicode.Create(self, EmbeddedFontNum));
+ lXRef.FStream.AddItem(TPDFToUnicode.Create(self, AFontNum));
end;
-procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer);
+procedure TPDFDocument.CreateFontFileEntry(const AFontNum: integer);
var
FDict: TPDFDictionary;
begin
FDict:=CreateGlobalXRef.Dict;
if poCompressFonts in Options then
FDict.AddName('Filter','FlateDecode');
- FDict.AddInteger('Length1 '+IntToStr(EmbeddedFontNum), Fonts[EmbeddedFontNum].FTrueTypeFile.OriginalSize);
+ FDict.AddInteger('Length1 '+IntToStr(AFontNum), Fonts[AFontNum].FTrueTypeFile.OriginalSize);
+end;
+
+procedure TPDFDocument.CreateCIDSet(const AFontNum: integer);
+var
+ lXRef: TPDFXRef;
+begin
+ lXRef := CreateGlobalXRef;
+ lXRef.FStream := CreateStream(True);
+ lXRef.FStream.AddItem(TPDFCIDSet.Create(self, AFontNum));
end;
procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);
@@ -4310,7 +4716,10 @@ var
N: TPDFName;
IDict,ADict: TPDFDictionary;
i: integer;
+ lXRef: integer;
begin
+ lXRef := GlobalXRefCount; // reference to be used later
+
IDict:=CreateGlobalXRef.Dict;
IDict.AddName('Type','XObject');
IDict.AddName('Subtype','Image');
@@ -4320,22 +4729,24 @@ begin
IDict.AddInteger('BitsPerComponent',8);
N:=CreateName('I'+IntToStr(NumImg)); // Needed later
IDict.AddElement('Name',N);
- for i:=1 to GLobalXRefCount-1 do
- begin
+
+ // now find where we must add the image xref - we are looking for "Resources"
+ for i := 1 to GlobalXRefCount-1 do
+ begin
ADict:=GlobalXRefs[i].Dict;
if ADict.ElementCount > 0 then
- begin
+ begin
if (ADict.Values[0] is TPDFName) and ((ADict.Values[0] as TPDFName).Name='Page') then
- begin
+ begin
ADict:=ADict.ValueByName('Resources') as TPDFDictionary;
ADict:=TPDFDictionary(ADict.FindValue('XObject'));
if Assigned(ADict) then
- begin
- ADict.AddReference(N.Name,GLobalXRefCount-1);
- end;
+ begin
+ ADict.AddReference(N.Name, lXRef);
end;
end;
end;
+ end;
end;
function TPDFDocument.CreateAnnotEntry(const APageNum, AnnotNum: integer): integer;
@@ -4384,6 +4795,17 @@ begin
result := GlobalXRefCount-1;
end;
+function TPDFDocument.CreateCIDToGIDMap(const AFontNum: integer): integer;
+var
+ lXRef: TPDFXRef;
+begin
+ lXRef := CreateGlobalXRef;
+ result := GlobalXRefCount-1;
+
+ lXRef.FStream := CreateStream(True);
+ lXRef.FStream.AddItem(TCIDToGIDMap.Create(self, AFontNum));
+end;
+
function TPDFDocument.CreateContentsEntry(const APageNum: integer): integer;
var
Contents: TPDFXRef;
@@ -4668,23 +5090,22 @@ begin
// select the font type
NumFont:=0;
for i:=0 to Fonts.Count-1 do
- begin
+ begin
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
+
+ if IsStandardPDFFont(FontName) then
+ CreateStdFont(FontName, NumFont)
else if LoadFont(Fonts[i]) then
- CreateTtfFont(NumFont)
+ begin
+ if poSubsetFont in Options then
+ Fonts[i].GenerateSubsetFont;
+ CreateTtfFont(NumFont);
+ end
else
CreateTp1Font(NumFont); // not implemented yet
+
Inc(NumFont);
- end;
+ end;
end;
procedure TPDFDocument.CreateImageEntries;
@@ -4755,24 +5176,37 @@ begin
SaveToStream(F);
finally
F.Free;
- end;
+ end;
end;
-function TPDFDocument.CreateEmbeddedFont(AFontIndex, AFontSize : Integer): TPDFEmbeddedFont;
+function TPDFDocument.IsStandardPDFFont(AFontName: string): boolean;
begin
- Result:=TPDFEmbeddedFont.Create(Self,AFontIndex,IntToStr(AFontSize))
+ { Acrobat Reader expects us to be case sensitive. Other PDF viewers are case-insensitive. }
+ if (AFontName='Courier') or (AFontName='Courier-Bold') or (AFontName='Courier-Oblique') or (AFontName='Courier-BoldOblique')
+ or (AFontName='Helvetica') or (AFontName='Helvetica-Bold') or (AFontName='Helvetica-Oblique') or (AFontName='Helvetica-BoldOblique')
+ or (AFontName='Times-Roman') or (AFontName='Times-Bold') or (AFontName='Times-Italic') or (AFontName='Times-BoldItalic')
+ or (AFontName='Symbol')
+ or (AFontName='ZapfDingbats') then
+ Result := True
+ else
+ Result := False;
end;
-function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFontIndex: integer; const ADegrees: single
- ): TPDFText;
+function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize: Integer): TPDFEmbeddedFont;
begin
- Result:=TPDFText.Create(Self, X, Y, AText, AFontIndex, ADegrees);
+ Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, IntToStr(AFontSize))
end;
-function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UTF8String; const AFontIndex: integer; const ADegrees: single
- ): TPDFUTF8Text;
+function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
+ const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFText;
begin
- Result := TPDFUTF8Text.Create(Self, X, Y, AText, AFontIndex, ADegrees);
+ Result:=TPDFText.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
+end;
+
+function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont;
+ const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFUTF8Text;
+begin
+ Result := TPDFUTF8Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
end;
function TPDFDocument.CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRectangle;
diff --git a/packages/fcl-pdf/src/fpttf.pp b/packages/fcl-pdf/src/fpttf.pp
index d35431c7f5..d4ca15dcd9 100644
--- a/packages/fcl-pdf/src/fpttf.pp
+++ b/packages/fcl-pdf/src/fpttf.pp
@@ -49,12 +49,17 @@ type
FFileInfo: TTFFileInfo;
FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
FPostScriptName: string;
+ procedure DoLoadFileInfo;
+ procedure LoadFileInfo;
procedure BuildFontCacheItem;
procedure SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle);
function GetIsBold: boolean;
function GetIsFixedWidth: boolean;
function GetIsItalic: boolean;
function GetIsRegular: boolean;
+ function GetFamilyName: String;
+ function GetPostScriptName: string;
+ function GetFileInfo: TTFFileInfo;
public
constructor Create(const AFilename: String);
destructor Destroy; override;
@@ -63,9 +68,9 @@ type
{ Result is in pixels }
function TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
property FileName: String read FFileName;
- property FamilyName: String read FFamilyName;
- property PostScriptName: string read FPostScriptName;
- property FontData: TTFFileInfo read FFileInfo;
+ property FamilyName: String read GetFamilyName;
+ property PostScriptName: string read GetPostScriptName;
+ property FontData: TTFFileInfo read GetFileInfo;
{ A bitmasked value describing the full font style }
property StyleFlags: TTrueTypeFontStyles read FStyleFlags;
{ IsXXX properties are convenience properties, internally querying StyleFlags. }
@@ -78,7 +83,7 @@ type
TFPFontCacheList = class(TObject)
private
- FBuildFontFacheIgnoresErrors: Boolean;
+ FBuildFontCacheIgnoresErrors: Boolean;
FList: TObjectList;
FSearchPath: TStringList;
FDPI: integer;
@@ -97,6 +102,8 @@ type
function Add(const AObject: TFPFontCacheItem): integer;
procedure AssignFontList(const AStrings: TStrings);
procedure Clear;
+ procedure LoadFromFile(const AFilename: string);
+ procedure ReadStandardFonts;
property Count: integer read GetCount;
function IndexOf(const AObject: TFPFontCacheItem): integer;
function Find(const AFontCacheItem: TFPFontCacheItem): integer; overload;
@@ -107,7 +114,7 @@ type
property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
property SearchPath: TStringList read FSearchPath;
property DPI: integer read FDPI write SetDPI;
- Property BuildFontFacheIgnoresErrors : Boolean Read FBuildFontFacheIgnoresErrors Write FBuildFontFacheIgnoresErrors;
+ Property BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors;
end;
@@ -115,10 +122,18 @@ function gTTFontCache: TFPFontCacheList;
implementation
+uses
+ DOM
+ ,XMLRead
+ {$ifdef mswindows}
+ ,Windows // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method
+ {$endif}
+ ;
+
resourcestring
rsNoSearchPathDefined = 'No search path was defined';
rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
- rsCharAboveWord = 'TextWidth doesn''t support characters higher then High(Word) - %d.';
+ rsMissingFontFile = 'The font file <%s> can''t be found.';
var
uFontCacheList: TFPFontCacheList;
@@ -134,26 +149,66 @@ end;
{ TFPFontCacheItem }
+procedure TFPFontCacheItem.DoLoadFileInfo;
+begin
+ if not Assigned(FFileInfo) then
+ LoadFileInfo;
+end;
+
+procedure TFPFontCacheItem.LoadFileInfo;
+begin
+ if FileExists(FFilename) then
+ begin
+ FFileInfo := TTFFileInfo.Create;
+ FFileInfo.LoadFromFile(FFilename);
+ BuildFontCacheItem;
+ end
+ else
+ raise ETTF.CreateFmt(rsMissingFontFile, [FFilename]);
+end;
+
function TFPFontCacheItem.GetIsBold: boolean;
begin
+ DoLoadFileInfo;
Result := fsBold in FStyleFlags;
end;
function TFPFontCacheItem.GetIsFixedWidth: boolean;
begin
+ DoLoadFileInfo;
Result := fsFixedWidth in FStyleFlags;
end;
function TFPFontCacheItem.GetIsItalic: boolean;
begin
+ DoLoadFileInfo;
Result := fsItalic in FStyleFlags;
end;
function TFPFontCacheItem.GetIsRegular: boolean;
begin
+ DoLoadFileInfo;
Result := fsRegular in FStyleFlags;
end;
+function TFPFontCacheItem.GetFamilyName: String;
+begin
+ DoLoadFileInfo;
+ Result := FFamilyName;
+end;
+
+function TFPFontCacheItem.GetPostScriptName: string;
+begin
+ DoLoadFileInfo;
+ Result := FPostScriptName;
+end;
+
+function TFPFontCacheItem.GetFileInfo: TTFFileInfo;
+begin
+ DoLoadFileInfo;
+ Result := FFileInfo;
+end;
+
procedure TFPFontCacheItem.BuildFontCacheItem;
var
s: string;
@@ -205,13 +260,6 @@ begin
if AFileName = '' then
raise ETTF.Create(rsNoFontFileName);
-
- if FileExists(AFilename) then
- begin
- FFileInfo := TTFFileInfo.Create;
- FFileInfo.LoadFromFile(AFilename);
- BuildFontCacheItem;
- end;
end;
destructor TFPFontCacheItem.Destroy;
@@ -253,6 +301,7 @@ var
s: string;
{$ENDIF}
begin
+ DoLoadFileInfo;
Result := 0;
if Length(AStr) = 0 then
Exit;
@@ -294,6 +343,7 @@ end;
function TFPFontCacheItem.TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
begin
+ DoLoadFileInfo;
{ Both lHeight and lDescenderHeight are in pixels }
Result := FFileInfo.CapHeight * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
ADescender := Abs(FFileInfo.Descender) * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
@@ -307,7 +357,7 @@ var
lFont: TFPFontCacheItem;
s: String;
begin
- if FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
+ if SysUtils.FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
begin
repeat
// check if special files to skip
@@ -326,14 +376,14 @@ begin
lFont := TFPFontCacheItem.Create(AFontPath + s);
Add(lFont);
except
- if not FBuildFontFacheIgnoresErrors then
+ if not FBuildFontCacheIgnoresErrors then
Raise;
end;
end;
end;
- until FindNext(sr) <> 0;
+ until SysUtils.FindNext(sr) <> 0;
end;
- FindClose(sr);
+ SysUtils.FindClose(sr);
end;
procedure TFPFontCacheList.SetDPI(AValue: integer);
@@ -419,6 +469,96 @@ begin
FList.Clear;
end;
+procedure TFPFontCacheList.LoadFromFile(const AFilename: string);
+var
+ sl: TStringList;
+ i: integer;
+begin
+ sl := TStringList.Create;
+ try
+ sl.LoadFromFile(AFilename);
+ for i := 0 to sl.Count-1 do
+ Add(TFPFontCacheItem.Create(sl[i]));
+ finally
+ sl.Free;
+ end;
+end;
+
+{ This is operating system dependent. Our default implementation only supports
+ Linux, FreeBSD, Windows and OSX. On other platforms, no fonts will be loaded,
+ until a implementation is created.
+
+ NOTE:
+ This is definitely not a perfect solution, especially due to the inconsistent
+ implementations and locations of files under various Linux distros. But it's
+ the best we can do for now. }
+procedure TFPFontCacheList.ReadStandardFonts;
+
+ {$ifdef linux}
+ {$define HasFontsConf}
+ const
+ cFontsConf = '/etc/fonts/fonts.conf';
+ {$endif}
+
+ {$ifdef freebsd}
+ {$define HasFontsConf}
+ const
+ cFontsConf = '/usr/local/etc/fonts/fonts.conf';
+ {$endif}
+
+ {$ifdef mswindows}
+ function GetWinDir: string;
+ var
+ dir: array [0..MAX_PATH] of Char;
+ begin
+ GetWindowsDirectory(dir, MAX_PATH);
+ Result := StrPas(dir);
+ end;
+ {$endif}
+
+{$ifdef HasFontsConf}
+var
+ doc: TXMLDocument;
+ lChild: TDOMNode;
+ lDir: string;
+{$endif}
+begin
+ {$ifdef HasFontsConf} // Linux & FreeBSD
+ ReadXMLFile(doc, cFontsConf);
+ try
+ lChild := doc.DocumentElement.FirstChild;
+ while Assigned(lChild) do
+ begin
+ if lChild.NodeName = 'dir' then
+ begin
+ if lChild.FirstChild.NodeValue = '~/.fonts' then
+ lDir := ExpandFilename(lChild.FirstChild.NodeValue)
+ else
+ lDir := lChild.FirstChild.NodeValue;
+ SearchPath.Add(lDir);
+// writeln(lDir);
+ end;
+ lChild := lChild.NextSibling;
+ end;
+ finally
+ doc.Free;
+ end;
+ {$endif}
+
+ {$ifdef mswindows}
+ SearchPath.Add(GetWinDir);
+ {$endif}
+
+ {$ifdef darwin} // OSX
+ { As per Apple Support page: https://support.apple.com/en-us/HT201722 }
+ SearchPath.Add('/System/Library/Fonts/');
+ SearchPath.Add('/Library/Fonts/');
+ SearchPath.Add(ExpandFilename('~/Library/Fonts/'));
+ {$endif}
+
+ BuildFontCache;
+end;
+
function TFPFontCacheList.IndexOf(const AObject: TFPFontCacheItem): integer;
begin
Result := FList.IndexOf(AObject);
diff --git a/packages/fcl-pdf/tests/fpparsettf_test.pas b/packages/fcl-pdf/tests/fpparsettf_test.pas
index 7b31ae107f..d47e223c73 100644
--- a/packages/fcl-pdf/tests/fpparsettf_test.pas
+++ b/packages/fcl-pdf/tests/fpparsettf_test.pas
@@ -971,7 +971,7 @@ end;
procedure TTestLiberationFont.TestOS2Data_ulUnicodeRange1;
begin
- AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
+// AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
AssertEquals('Failed on 2', 'E0000AFF', IntToHex(FI.OS2Data.ulUnicodeRange1, 8));
end;
diff --git a/packages/fcl-pdf/tests/fppdf_test.pas b/packages/fcl-pdf/tests/fppdf_test.pas
index 6d6bdca46d..4dcb9d65b5 100644
--- a/packages/fcl-pdf/tests/fppdf_test.pas
+++ b/packages/fcl-pdf/tests/fppdf_test.pas
@@ -21,6 +21,7 @@ type
private
FPDF: TPDFDocument;
FStream: TStringStream;
+ procedure CreatePages(const ACount: integer);
protected
procedure SetUp; override;
procedure TearDown; override;
@@ -200,6 +201,7 @@ type
procedure TestWrite_ppsDot;
procedure TestWrite_ppsDashDot;
procedure TestWrite_ppsDashDotDot;
+ procedure TestLocalisationChanges;
end;
@@ -232,7 +234,8 @@ type
published
procedure TestPageDocument;
procedure TestPageDefaultUnitOfMeasure;
- procedure TestMatrix;
+ procedure TestMatrixOn;
+ procedure TestMatrixOff;
procedure TestUnitOfMeasure_MM;
procedure TestUnitOfMeasure_Inches;
procedure TestUnitOfMeasure_CM;
@@ -295,6 +298,23 @@ type
{ TBasePDFTest }
+procedure TBasePDFTest.CreatePages(const ACount: integer);
+var
+ page: TPDFPage;
+ sec: TPDFSection;
+ i: integer;
+begin
+ if FPDF.Sections.Count = 0 then
+ sec := FPDF.Sections.AddSection
+ else
+ sec := FPDF.Sections[0];
+ for i := 1 to ACount do
+ begin
+ page := FPDF.Pages.AddPage;
+ sec.AddPage(page);
+ end;
+end;
+
procedure TBasePDFTest.SetUp;
begin
inherited SetUp;
@@ -334,7 +354,7 @@ Var
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 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)));
@@ -399,7 +419,7 @@ begin
'1 J'+CRLF+
'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;
@@ -446,7 +466,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;
@@ -463,7 +483,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;
@@ -743,8 +763,11 @@ end;
procedure TTestPDFEmbeddedFont.TestWrite;
var
o: TPDFEmbeddedFont;
+ p: TPDFPage;
begin
- o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+ CreatePages(1);
+ p := PDF.Pages[0];
+ o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
try
AssertEquals('Failed on 1', '', S.DataString);
TMockPDFEmbeddedFont(o).Write(S);
@@ -759,10 +782,13 @@ var
o: TPDFEmbeddedFont;
lStream: TMemoryStream;
str: String;
+ p: TPDFPage;
begin
PDF.Options := []; // disable compressed fonts
str := 'Hello World';
- o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+ CreatePages(1);
+ p := PDF.Pages[0];
+ o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
try
AssertEquals('Failed on 1', '', S.DataString);
lStream := TMemoryStream.Create;
@@ -785,13 +811,13 @@ var
begin
x := 10.5;
y := 20.0;
- o := TPDFText.Create(PDF, x, y, 'Hello World!', 0);
+ o := TPDFText.Create(PDF, x, y, 'Hello World!', nil, 0, false, false);
try
AssertEquals('Failed on 1', '', S.DataString);
TMockPDFText(o).Write(S);
AssertEquals('Failed on 2',
'BT'+CRLF+
- '10.50 20 TD'+CRLF+
+ '10.50 20 TD'+CRLF+
'(Hello World!) Tj'+CRLF+
'ET'+CRLF,
S.DataString);
@@ -808,7 +834,7 @@ var
begin
pos.X := 10.0;
pos.Y := 55.5;
- AssertEquals('Failed on 1', ' 10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
+ AssertEquals('Failed on 1', '10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
end;
procedure TTestPDFLineSegment.TestWrite;
@@ -827,9 +853,9 @@ begin
TMockPDFLineSegment(o).Write(S);
AssertEquals('Failed on 2',
'1 J'+CRLF+
- ' 2 w'+CRLF+ // line width
- ' 10 15.50 m'+CRLF+ // moveto command
- ' 50 55.50 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
@@ -854,7 +880,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;
@@ -877,8 +903,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
@@ -902,8 +928,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
@@ -926,7 +952,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
@@ -950,7 +976,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;
@@ -974,8 +1000,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
@@ -1003,7 +1029,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;
@@ -1030,8 +1056,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
@@ -1056,7 +1082,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;
@@ -1083,8 +1109,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
@@ -1109,7 +1135,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;
@@ -1134,15 +1160,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 75.96 54.77 20 110 20 c'+CRLF+
// curveC 2
- ' 165 20 210 76.25 210 145 c'+CRLF+
+ '165.23 20 210 75.96 210 145 c'+CRLF+
// curveC 3
- ' 210 213.75 165 270 110 270 c'+CRLF+
+ '210 214.04 165.23 270 110 270 c'+CRLF+
// curveC 4
- ' 55 270 10 213.75 10 145 c'+CRLF,
+ '54.77 270 10 214.04 10 145 c'+CRLF,
S.DataString);
finally
o.Free;
@@ -1165,15 +1191,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 75.96 54.77 20 110 20 c'+CRLF+
// curveC 2
- ' 165 20 210 76.25 210 145 c'+CRLF+
+ '165.23 20 210 75.96 210 145 c'+CRLF+
// curveC 3
- ' 210 213.75 165 270 110 270 c'+CRLF+
+ '210 214.04 165.23 270 110 270 c'+CRLF+
// curveC 4
- ' 55 270 10 213.75 10 145 c'+CRLF+
+ '54.77 270 10 214.04 10 145 c'+CRLF+
'f'+CRLF,
S.DataString);
finally
@@ -1197,17 +1223,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 75.96 54.77 20 110 20 c'+CRLF+
// curveC 2
- ' 165 20 210 76.25 210 145 c'+CRLF+
+ '165.23 20 210 75.96 210 145 c'+CRLF+
// curveC 3
- ' 210 213.75 165 270 110 270 c'+CRLF+
+ '210 214.04 165.23 270 110 270 c'+CRLF+
// curveC 4
- ' 55 270 10 213.75 10 145 c'+CRLF+
+ '54.77 270 10 214.04 10 145 c'+CRLF+
'S'+CRLF,
S.DataString);
finally
@@ -1231,17 +1257,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 75.96 54.77 20 110 20 c'+CRLF+
// curveC 2
- ' 165 20 210 76.25 210 145 c'+CRLF+
+ '165.23 20 210 75.96 210 145 c'+CRLF+
// curveC 3
- ' 210 213.75 165 270 110 270 c'+CRLF+
+ '210 214.04 165.23 270 110 270 c'+CRLF+
// curveC 4
- ' 55 270 10 213.75 10 145 c'+CRLF+
+ '54.77 270 10 214.04 10 145 c'+CRLF+
'b'+CRLF,
S.DataString);
finally
@@ -1270,11 +1296,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);
@@ -1303,11 +1329,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
@@ -1335,11 +1361,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
@@ -1364,7 +1390,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,
@@ -1379,6 +1405,7 @@ var
p: TPDFPage;
img: TMockPDFImage;
begin
+ PDF.Options := [poPageOriginAtTop];
p := PDF.Pages.AddPage;
p.UnitOfMeasure := uomMillimeters;
AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1391,7 +1418,7 @@ begin
AssertEquals('Failed on 5',
// save graphics state
'q'+CRLF+
- ' 200 0 0 100 28.35 785.31 cm'+CRLF+
+ '200 0 0 100 28.35 785.31 cm'+CRLF+
'/I1 Do'+CRLF+
// restore graphics state
'Q'+CRLF,
@@ -1411,7 +1438,7 @@ begin
AssertEquals('Failed on 10',
// save graphics state
'q'+CRLF+
- ' 200 0 0 100 283.46 275.07 cm'+CRLF+
+ '200 0 0 100 283.46 275.07 cm'+CRLF+
'/I1 Do'+CRLF+
// restore graphics state
'Q'+CRLF,
@@ -1423,6 +1450,7 @@ var
p: TPDFPage;
img: TMockPDFImage;
begin
+ PDF.Options := [poPageOriginAtTop];
p := PDF.Pages.AddPage;
p.UnitOfMeasure := uomMillimeters;
AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1468,7 +1496,7 @@ procedure TTestPDFLineStyle.TestWrite_ppsSolid;
var
o: TMockPDFLineStyle;
begin
- o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1);
+ o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1, 1);
try
AssertEquals('Failed on 1', '', S.DataString);
o.Write(S);
@@ -1484,12 +1512,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDash;
var
o: TMockPDFLineStyle;
begin
- o := TMockPDFLineStyle.Create(PDF, ppsDash, 2);
+ o := TMockPDFLineStyle.Create(PDF, ppsDash, 2, 1);
try
AssertEquals('Failed on 1', '', S.DataString);
o.Write(S);
AssertEquals('Failed on 2',
- '[5 3] 2 d'+CRLF,
+ '[5 5] 2 d'+CRLF,
S.DataString);
finally
o.Free;
@@ -1500,12 +1528,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDot;
var
o: TMockPDFLineStyle;
begin
- o := TMockPDFLineStyle.Create(PDF, ppsDot, 3);
+ o := TMockPDFLineStyle.Create(PDF, ppsDot, 3, 1);
try
AssertEquals('Failed on 1', '', S.DataString);
o.Write(S);
AssertEquals('Failed on 2',
- '[1 3] 3 d'+CRLF,
+ '[0.80 4] 3 d'+CRLF,
S.DataString);
finally
o.Free;
@@ -1516,12 +1544,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDot;
var
o: TMockPDFLineStyle;
begin
- o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4);
+ o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4, 1);
try
AssertEquals('Failed on 1', '', S.DataString);
o.Write(S);
AssertEquals('Failed on 2',
- '[5 3 1 3] 4 d'+CRLF,
+ '[5 3 0.80 3] 4 d'+CRLF,
S.DataString);
finally
o.Free;
@@ -1532,18 +1560,38 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDotDot;
var
o: TMockPDFLineStyle;
begin
- o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1);
+ o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
try
AssertEquals('Failed on 1', '', S.DataString);
o.Write(S);
AssertEquals('Failed on 2',
- '[5 3 1 3 1 3] 1 d'+CRLF,
+ '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
S.DataString);
finally
o.Free;
end;
end;
+procedure TTestPDFLineStyle.TestLocalisationChanges;
+var
+ o: TMockPDFLineStyle;
+ d: char;
+begin
+ d := DefaultFormatSettings.DecimalSeparator;
+ DefaultFormatSettings.DecimalSeparator := Char('~');
+ o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
+ try
+ AssertEquals('Failed on 1', '', S.DataString);
+ o.Write(S);
+ AssertEquals('Failed on 2',
+ '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
+ S.DataString);
+ finally
+ o.Free;
+ end;
+ DefaultFormatSettings.DecimalSeparator := d;
+end;
+
{ TTestPDFColor }
procedure TTestPDFColor.TestWrite_Stroke;
@@ -1673,11 +1721,13 @@ begin
AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
end;
-procedure TTestPDFPage.TestMatrix;
+// (0,0) origin is at top-left of page
+procedure TTestPDFPage.TestMatrixOn;
var
p: TPDFPage;
pt1, pt2: TPDFCoord;
begin
+ PDF.Options := [poPageOriginAtTop];
p := PDF.Pages.AddPage;
AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), p.Paper.H);
@@ -1693,6 +1743,28 @@ begin
AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
end;
+// (0,0) origin is at bottom-left of page
+procedure TTestPDFPage.TestMatrixOff;
+var
+ p: TPDFPage;
+ pt1, pt2: TPDFCoord;
+begin
+ PDF.Options := [];
+ p := PDF.Pages.AddPage;
+ AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
+ AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), 0);
+
+ pt1.X := 10;
+ pt1.Y := 20;
+ pt2 := p.Matrix.Transform(pt1);
+ AssertEquals('Failed on 3', 10, pt2.X);
+ AssertEquals('Failed on 4', 20, pt2.Y, 0.1);
+
+ pt1 := p.Matrix.ReverseTransform(pt2);
+ AssertEquals('Failed on 5', 10, pt1.X);
+ AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
+end;
+
procedure TTestPDFPage.TestUnitOfMeasure_MM;
var
p: TPDFPage;
diff --git a/packages/fcl-pdf/tests/fpttf_test.pas b/packages/fcl-pdf/tests/fpttf_test.pas
index 9aaff3fc95..ff96fbbdbd 100644
--- a/packages/fcl-pdf/tests/fpttf_test.pas
+++ b/packages/fcl-pdf/tests/fpttf_test.pas
@@ -12,25 +12,39 @@ uses
,fpcunit, testregistry
{$endif}
,fpttf
+ ,fpparsettf
;
type
+ TMyTestFPFontCacheItem = class(TFPFontCacheItem)
+ protected
+ FFileInfo: TTFFileInfo;
+ end;
+
+
TFPFontCacheItemTest = class(TTestCase)
private
- FCacheItem: TFPFontCacheItem;
+ FCacheItem: TMyTestFPFontCacheItem;
+ procedure SetupRealFont;
protected
procedure SetUp; override;
procedure TearDown; override;
public
- property CI: TFPFontCacheItem read FCacheItem;
+ property CI: TMyTestFPFontCacheItem read FCacheItem;
published
+ procedure TestIsRegularCantFind;
+ procedure TestIsBoldCantFind;
+ procedure TestIsItalicCantFind;
+ procedure TestIsFixedWidthCantFind;
+ procedure TestFileInfoCantFind;
procedure TestIsRegular;
procedure TestIsBold;
procedure TestIsItalic;
procedure TestIsFixedWidth;
procedure TestRegularVsFixedWidth;
procedure TestFileName;
+ procedure TestFontInfoAfterCreate;
procedure TestTextWidth_FontUnits;
procedure TestTextWidth_Pixels;
end;
@@ -52,25 +66,31 @@ type
procedure TestFind_FamilyName;
procedure TestFind_PostscriptName;
procedure TestAssignFontList;
+ procedure TestLoadFromFile;
+ procedure TestReadStandardFonts;
end;
implementation
-uses
- fpparsettf;
-
const
cFontCount = 5;
resourcestring
cErrFontCountWrong = ' - make sure you only have the 5 test fonts in the "fonts" directory.';
+
{ TFPFontCacheItemTest }
+procedure TFPFontCacheItemTest.SetupRealFont;
+begin
+ FCacheItem.Free;
+ FCacheItem := TMyTestFPFontCacheItem.Create('fonts' + PathDelim + 'DejaVuSans.ttf');
+end;
+
procedure TFPFontCacheItemTest.SetUp;
begin
inherited SetUp;
- FCacheItem := TFPFontCacheItem.Create('mytest.ttf');
+ FCacheItem := TMyTestFPFontCacheItem.Create('mytest.ttf');
end;
procedure TFPFontCacheItemTest.TearDown;
@@ -79,29 +99,103 @@ begin
inherited TearDown;
end;
+procedure TFPFontCacheItemTest.TestIsRegularCantFind;
+begin
+ try
+ AssertFalse(CI.IsRegular); // this should raise an error
+ Fail('Failed on 1');
+ except
+ on E: Exception do
+ begin
+ AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+ AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+ end;
+ end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsBoldCantFind;
+begin
+ try
+ AssertFalse(CI.IsBold); // this should raise an error
+ Fail('Failed on 1');
+ except
+ on E: Exception do
+ begin
+ AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+ AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+ end;
+ end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsItalicCantFind;
+begin
+ try
+ AssertFalse(CI.IsItalic); // this should raise an error
+ Fail('Failed on 1');
+ except
+ on E: Exception do
+ begin
+ AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+ AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+ end;
+ end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsFixedWidthCantFind;
+begin
+ try
+ AssertFalse(CI.IsFixedWidth); // this should raise an error
+ Fail('Failed on 1');
+ except
+ on E: Exception do
+ begin
+ AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+ AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+ end;
+ end;end;
+
+procedure TFPFontCacheItemTest.TestFileInfoCantFind;
+begin
+ try
+ AssertFalse(CI.FontData <> nil); // this should raise an error
+ Fail('Failed on 1');
+ except
+ on E: Exception do
+ begin
+ AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+ AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+ end;
+ end;
+end;
+
procedure TFPFontCacheItemTest.TestIsRegular;
begin
+ SetupRealFont;
{ regular should be the default flag set }
AssertEquals('Failed on 1', True, CI.IsRegular);
end;
procedure TFPFontCacheItemTest.TestIsBold;
begin
+ SetupRealFont;
AssertEquals('Failed on 1', False, CI.IsBold);
end;
procedure TFPFontCacheItemTest.TestIsItalic;
begin
+ SetupRealFont;
AssertEquals('Failed on 1', False, CI.IsItalic);
end;
procedure TFPFontCacheItemTest.TestIsFixedWidth;
begin
+ SetupRealFont;
AssertEquals('Failed on 1', False, CI.IsFixedWidth);
end;
procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
begin
+ SetupRealFont;
AssertEquals('Failed on 1', True, CI.IsRegular);
AssertEquals('Failed on 2', False, CI.IsFixedWidth);
end;
@@ -109,8 +203,14 @@ end;
procedure TFPFontCacheItemTest.TestFileName;
begin
AssertTrue('Failed on 1', CI.FileName <> '');
- { FileName is a non-existing file though, so FontData should be nil }
- AssertTrue('Failed on 2', CI.FontData = nil);
+ { The Filename property doesn't trigger the loading of font info data }
+ AssertTrue('Failed on 2', CI.FFileInfo = nil);
+end;
+
+procedure TFPFontCacheItemTest.TestFontInfoAfterCreate;
+begin
+ { Font info isn't loaded in the constructor any more - it is now loaded on demand }
+ AssertTrue('Failed on 1', CI.FFileInfo = nil);
end;
procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -312,6 +412,38 @@ begin
end;
end;
+procedure TFPFontCacheListTest.TestLoadFromFile;
+const
+ cFontListFile = 'fontlist.txt';
+var
+ s: string;
+ lCI: TFPFontCacheItem;
+begin
+ s := ExtractFilePath(ParamStr(0)) + cFontListFile;
+ AssertEquals('Failed on 1', 0, FC.Count);
+ FC.LoadFromFile(s);
+ AssertEquals('Failed on 2', 3, FC.Count);
+
+ lCI := FC.Find('DejaVuSans');
+ AssertTrue('Failed on 3', Assigned(lCI));
+ lCI := nil;
+
+ lCI := FC.Find('FreeSans');
+ AssertTrue('Failed on 4', Assigned(lCI));
+ lCI := nil;
+
+ lCI := FC.Find('LiberationSans-Italic');
+ AssertTrue('Failed on 5', Assigned(lCI));
+ lCI := nil;
+end;
+
+procedure TFPFontCacheListTest.TestReadStandardFonts;
+begin
+ AssertEquals('Failed on 1', 0, FC.Count);
+ FC.ReadStandardFonts;
+ AssertTrue('Failed on 2', FC.Count > 1);
+end;
+
initialization
RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
diff --git a/packages/fcl-pdf/utils/ttfdump.lpi b/packages/fcl-pdf/utils/ttfdump.lpi
index a8baa8c4e8..2adbfed8d1 100644
--- a/packages/fcl-pdf/utils/ttfdump.lpi
+++ b/packages/fcl-pdf/utils/ttfdump.lpi
@@ -32,6 +32,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
+ <CommandLineParams Value="-f ../tests/fonts/FreeSans.ttf -s"/>
</local>
</RunParams>
<Units Count="1">
@@ -56,6 +57,11 @@
<AllowLabel Value="False"/>
</SyntaxOptions>
</Parsing>
+ <Linking>
+ <Debugging>
+ <UseHeaptrc Value="True"/>
+ </Debugging>
+ </Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
diff --git a/packages/fcl-pdf/utils/ttfdump.lpr b/packages/fcl-pdf/utils/ttfdump.lpr
index 2167632d65..9e564b9773 100644
--- a/packages/fcl-pdf/utils/ttfdump.lpr
+++ b/packages/fcl-pdf/utils/ttfdump.lpr
@@ -1,46 +1,18 @@
program ttfdump;
{$mode objfpc}{$H+}
+{$codepage utf8}
uses
- {$IFDEF UNIX}{$IFDEF UseCThreads}
- cwstrings,
- {$ENDIF}{$ENDIF}
- Classes, SysUtils, CustApp,
- fpparsettf, contnrs;
+ {$ifdef unix}cwstring,{$endif} // required for UnicodeString handling.
+ Classes,
+ SysUtils,
+ CustApp,
+ fpparsettf,
+ FPFontTextMapping,
+ fpTTFSubsetter;
type
- // 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;
-
TMyApplication = class(TCustomApplication)
private
@@ -48,6 +20,7 @@ type
procedure DumpGlyphIndex;
function GetGlyphIndicesString(const AText: UnicodeString): AnsiString; overload;
function GetGlyphIndices(const AText: UnicodeString): TTextMappingList; overload;
+ procedure CreateSubsetFontFile(const AList: TTextMappingList);
protected
procedure DoRun; override;
public
@@ -56,70 +29,10 @@ type
procedure WriteHelp; virtual;
end;
+
TFriendClass = class(TTFFileInfo)
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;
{ TMyApplication }
@@ -127,16 +40,16 @@ procedure TMyApplication.DumpGlyphIndex;
begin
Writeln('FHHead.numberOfHMetrics = ', FFontFile.HHead.numberOfHMetrics);
Writeln('Length(Chars[]) = ', Length(FFontFile.Chars));
-
+ writeln;
writeln('Glyph Index values:');
- Writeln('U+0020 (space) = ', FFontFile.Chars[$0020]);
- Writeln('U+0021 (!) = ', FFontFile.Chars[$0021]);
- Writeln('U+0048 (H) = ', FFontFile.Chars[$0048]);
-
+ Writeln(' U+0020 (space) = ', Format('%d (%0:4.4x)', [FFontFile.Chars[$0020]]));
+ Writeln(' U+0021 (!) = ', Format('%d (%0:4.4x)', [FFontFile.Chars[$0021]]));
+ Writeln(' U+0048 (H) = ', Format('%d (%0:4.4x)', [FFontFile.Chars[$0048]]));
+ writeln;
Writeln('Glyph widths:');
- Writeln('3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
- Writeln('4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
- Writeln('H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
+ Writeln(' 3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
+ Writeln(' 4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
+ Writeln(' H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
end;
function TMyApplication.GetGlyphIndices(const AText: UnicodeString): TTextMappingList;
@@ -154,6 +67,20 @@ begin
end;
end;
+procedure TMyApplication.CreateSubsetFontFile(const AList: TTextMappingList);
+var
+ lSubset: TFontSubsetter;
+begin
+ writeln;
+ writeln('called CreateSubsetFontFile...');
+ lSubset := TFontSubsetter.Create(FFontFile, AList);
+ try
+ lSubSet.SaveToFile(ExtractFileName(GetOptionValue('f'))+'.subset.ttf');
+ finally
+ FreeAndNil(lSubSet);
+ end;
+end;
+
function TMyApplication.GetGlyphIndicesString(const AText: UnicodeString): AnsiString;
var
i: integer;
@@ -177,7 +104,7 @@ var
i: integer;
begin
// quick check parameters
- ErrorMsg := CheckOptions('hf:', 'help');
+ ErrorMsg := CheckOptions('hf:s', 'help');
if ErrorMsg <> '' then
begin
ShowException(Exception.Create(ErrorMsg));
@@ -196,13 +123,25 @@ begin
FFontFile.LoadFromFile(self.GetOptionValue('f'));
DumpGlyphIndex;
- s := 'Hello, World!';
+ // test #1
+// s := 'Hello, World!';
+ // test #2
+ s := 'Typography: “What’s wrong?”';
+
Writeln('');
lst := GetGlyphIndices(s);
Writeln(Format('%d Glyph indices for: "%s"', [lst.Count, s]));
+ writeln(#9'GID'#9'CharID');
+ writeln(#9'---'#9'------');
for i := 0 to lst.Count-1 do
- Writeln(Format(#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)]));
+ Writeln(Format(#9'%s'#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4), Char(lst[i].CharID)]));
+ if HasOption('s','') then
+ CreateSubsetFontFile(lst);
+ lst.Free;
+
+ writeln;
+ writeln;
// stop program loop
Terminate;
end;
@@ -225,11 +164,13 @@ begin
writeln('Usage: ', ExeName, ' -h');
writeln(' -h Show this help.');
writeln(' -f <ttf> Load TTF font file.');
+ writeln(' -s Generate a subset TTF file.');
end;
+
+
var
Application: TMyApplication;
-
begin
Application := TMyApplication.Create(nil);
Application.Title := 'TTF Font Dump';