瀏覽代碼

* Some updates from Graeme Geldenhuys
- pdf: updates demo with a landscape page.
- pdf: Intenal Coordinate Matrix was not always adjusted when needed.
eg: When the Page.Orientation was changed, PaperType was changed and so on.
- pdf: Extra sanity check to prevent a possible AV.
- TTF: new FixPathDelimiters() to fix font search paths.

git-svn-id: trunk@33779 -

michael 9 年之前
父節點
當前提交
a1e5c122f2
共有 3 個文件被更改,包括 65 次插入7 次删除
  1. 46 6
      packages/fcl-pdf/examples/testfppdf.lpr
  2. 8 1
      packages/fcl-pdf/src/fppdf.pp
  3. 11 0
      packages/fcl-pdf/src/fpttf.pp

+ 46 - 6
packages/fcl-pdf/examples/testfppdf.lpr

@@ -21,7 +21,8 @@ uses
   fpimage,
   fpreadjpeg,
   fppdf,
-  fpparsettf;
+  fpparsettf,
+  typinfo;
 
 type
 
@@ -42,6 +43,7 @@ type
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
+    procedure   SampleLandscape(D: TPDFDocument; APage: integer);
   protected
     procedure   DoRun; override;
   public
@@ -81,7 +83,7 @@ begin
 
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
-  lPageCount := 6;
+  lPageCount := 7;
   if Fpg <> -1 then
     lPageCount := 1;
   for i := 1 to lPageCount do
@@ -426,6 +428,42 @@ begin
   OutputSample;
 end;
 
+procedure TPDFTestApp.SampleLandscape(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
+  FtTitle: integer;
+
+    function PaperTypeToString(AEnum: TPDFPaperType): string;
+    begin
+      result := GetEnumName(TypeInfo(TPDFPaperType), Ord(AEnum));
+    end;
+
+    function PixelsToMM(AValue: integer): integer;
+    begin
+      Result := Round((AValue / 72) * 25.4);
+    end;
+
+begin
+  P:=D.Pages[APage];
+  P.Orientation := ppoLandscape;
+
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica', clBlack);
+
+  { Page title }
+  P.SetFont(FtTitle,23);
+  P.SetColor(clBlack);
+  P.WriteText(25, 20, 'Landscape Page');
+
+  P.SetFont(FtTitle, 12);
+  P.WriteText(100, 80, 'Page PaperType:');
+  P.WriteText(145, 80, PaperTypeToString(P.PaperType));
+
+  P.WriteText(100, 90, 'Page Size:');
+  P.WriteText(145, 90, Format('%d x %d  (pixels)', [P.Paper.W, P.Paper.H]));
+  P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
+end;
+
 { TPDFTestApp }
 
 procedure TPDFTestApp.DoRun;
@@ -474,9 +512,9 @@ begin
   if HasOption('p', '') then
   begin
     Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > 5) then
+    if (Fpg < 1) or (Fpg > 7) then
     begin
-      Writeln('Error in -p parameter. Valid range is 1-5.');
+      Writeln('Error in -p parameter. Valid range is 1-7.');
       Writeln('');
       Terminate;
       Exit;
@@ -500,6 +538,7 @@ begin
       SimpleLinesRaw(FDoc, 3);
       SimpleImage(FDoc, 4);
       SampleMatrixTransform(FDoc, 5);
+      SampleLandscape(FDoc, 6);
     end
     else
     begin
@@ -510,6 +549,7 @@ begin
         4:  SimpleLinesRaw(FDoc, 0);
         5:  SimpleImage(FDoc, 0);
         6:  SampleMatrixTransform(FDoc, 0);
+        7:  SampleLandscape(FDoc, 0);
       end;
     end;
 
@@ -526,8 +566,8 @@ procedure TPDFTestApp.WriteHelp;
 begin
   writeln('Usage:');
   writeln('    -h          Show this help.');
-  writeln('    -p <n>      Generate only one page. Valid range is 1-5.' + LineEnding +
-          '                If this option is not specified, then all 5 pages are' + LineEnding +
+  writeln('    -p <n>      Generate only one page. Valid range is 1-7.' + LineEnding +
+          '                If this option is not specified, then all 7 pages are' + LineEnding +
           '                generated.');
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');

+ 8 - 1
packages/fcl-pdf/src/fppdf.pp

@@ -14,7 +14,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit fppdf;
+unit fpPDF;
 
 {$mode objfpc}{$H+}
 
@@ -1560,6 +1560,7 @@ begin
   if FOrientation=AValue then Exit;
   FOrientation:=AValue;
   CalcPaperSize;
+  AdjustMatrix;
 end;
 
 procedure TPDFPage.CalcPaperSize;
@@ -1590,6 +1591,7 @@ begin
   if FPaperType=AValue then Exit;
   FPaperType:=AValue;
   CalcPaperSize;
+  AdjustMatrix;
 end;
 
 procedure TPDFPage.AddTextToLookupLists(AText: UTF8String);
@@ -2113,6 +2115,11 @@ function TPDFImageItem.Equals(AImage: TFPCustomImage): boolean;
 var
   x, y: Integer;
 begin
+  if AImage = nil then
+  begin
+    Result := False;
+    exit;
+  end;
   Result := True;
   for x := 0 to Image.Width-1 do
     for y := 0 to Image.Height-1 do

+ 11 - 0
packages/fcl-pdf/src/fpttf.pp

@@ -72,6 +72,8 @@ type
     FDPI: integer;
     procedure   SearchForFonts(const AFontPath: String);
     procedure   SetDPI(AValue: integer);
+    { Set any / or \ path delimiters to the OS specific delimiter }
+    procedure   FixPathDelimiters;
   protected
     function    GetCount: integer; virtual;
     function    GetItem(AIndex: Integer): TFPFontCacheItem; virtual;
@@ -322,6 +324,14 @@ begin
   FDPI := AValue;
 end;
 
+procedure TFPFontCacheList.FixPathDelimiters;
+var
+  i: integer;
+begin
+  for i := 0 to FSearchPath.Count-1 do
+    FSearchPath[i] := SetDirSeparators(FSearchPath[i]);
+end;
+
 function TFPFontCacheList.GetCount: integer;
 begin
   Result := FList.Count;
@@ -360,6 +370,7 @@ begin
   if FSearchPath.Count < 1 then
     raise ETTF.Create(rsNoSearchPathDefined);
 
+  FixPathDelimiters;
   for i := 0 to FSearchPath.Count-1 do
   begin
     lPath := FSearchPath[i];