Browse Source

--- Merging r33761 into '.':
U packages/fcl-db/tests/testbasics.pas
U packages/fcl-db/src/base/dsparams.inc
--- Recording mergeinfo for merge of r33761 into '.':
U .
--- Merging r33778 into '.':
U packages/fcl-image/src/ftfont.pp
--- Recording mergeinfo for merge of r33778 into '.':
G .
--- Merging r33779 into '.':
U packages/fcl-pdf/examples/testfppdf.lpr
U packages/fcl-pdf/src/fppdf.pp
U packages/fcl-pdf/src/fpttf.pp
--- Recording mergeinfo for merge of r33779 into '.':
G .

# revisions: 33761,33778,33779

git-svn-id: branches/fixes_3_0@33811 -

marco 9 years ago
parent
commit
f09f916a5a

+ 7 - 4
packages/fcl-db/src/base/dsparams.inc

@@ -257,14 +257,17 @@ begin
         if p^='*' then // /* */ comment
         begin
           Result := True;
-          repeat
-            Inc(p);
+          Inc(p);
+          while p^ <> #0 do
+          begin
             if p^='*' then // possible end of comment
             begin
               Inc(p);
               if p^='/' then Break; // end of comment
-            end;
-          until p^=#0;
+            end
+            else
+              Inc(p);
+          end;
           if p^='/' then Inc(p); // skip final /
         end;
       end;

+ 2 - 0
packages/fcl-db/tests/testbasics.pas

@@ -145,6 +145,8 @@ begin
   // Bracketed comment
   AssertEquals(     'select * from table where id=/*comment :c*/$1-$2',
     Params.ParseSQL('select * from table where id=/*comment :c*/:a-:b', True, True, True, psPostgreSQL));
+  AssertEquals(     'select * from table where id=/*comment :c**/$1-$2',
+    Params.ParseSQL('select * from table where id=/*comment :c**/:a-:b', True, True, True, psPostgreSQL));
   // Consecutive comments, with quote in second comment
   AssertEquals(     '--c1'#10'--c'''#10'select '':a'' from table where id=$1',
     Params.ParseSQL('--c1'#10'--c'''#10'select '':a'' from table where id=:id', True, True, True, psPostgreSQL));

+ 2 - 3
packages/fcl-image/src/ftfont.pp

@@ -59,7 +59,7 @@ type
   end;
 
 var
-  FontMgr : TFontManager;
+  FontMgr : TFontManager = nil;
 
 procedure InitEngine;
 procedure DoneEngine;
@@ -78,8 +78,7 @@ end;
 
 procedure DoneEngine;
 begin
-  if assigned (FontMgr) then
-    FontMgr.Free;
+  FreeAndNil(FontMgr);
 end;
 
 constructor TFreeTypeFont.Create;

+ 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];