--- 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 -
This commit is contained in:
marco 2016-05-26 12:47:14 +00:00
parent e8cc741cb3
commit f09f916a5a
6 changed files with 76 additions and 14 deletions

View File

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

View File

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

View File

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

View File

@ -21,7 +21,8 @@ uses
fpimage, fpimage,
fpreadjpeg, fpreadjpeg,
fppdf, fppdf,
fpparsettf; fpparsettf,
typinfo;
type type
@ -42,6 +43,7 @@ type
procedure SimpleImage(D: TPDFDocument; APage: integer); procedure SimpleImage(D: TPDFDocument; APage: integer);
procedure SimpleShapes(D: TPDFDocument; APage: integer); procedure SimpleShapes(D: TPDFDocument; APage: integer);
procedure SampleMatrixTransform(D: TPDFDocument; APage: integer); procedure SampleMatrixTransform(D: TPDFDocument; APage: integer);
procedure SampleLandscape(D: TPDFDocument; APage: integer);
protected protected
procedure DoRun; override; procedure DoRun; override;
public public
@ -81,7 +83,7 @@ begin
Result.StartDocument; Result.StartDocument;
S := Result.Sections.AddSection; // we always need at least one section S := Result.Sections.AddSection; // we always need at least one section
lPageCount := 6; lPageCount := 7;
if Fpg <> -1 then if Fpg <> -1 then
lPageCount := 1; lPageCount := 1;
for i := 1 to lPageCount do for i := 1 to lPageCount do
@ -426,6 +428,42 @@ begin
OutputSample; OutputSample;
end; 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 } { TPDFTestApp }
procedure TPDFTestApp.DoRun; procedure TPDFTestApp.DoRun;
@ -474,9 +512,9 @@ begin
if HasOption('p', '') then if HasOption('p', '') then
begin begin
Fpg := StrToInt(GetOptionValue('p', '')); Fpg := StrToInt(GetOptionValue('p', ''));
if (Fpg < 1) or (Fpg > 5) then if (Fpg < 1) or (Fpg > 7) then
begin begin
Writeln('Error in -p parameter. Valid range is 1-5.'); Writeln('Error in -p parameter. Valid range is 1-7.');
Writeln(''); Writeln('');
Terminate; Terminate;
Exit; Exit;
@ -500,6 +538,7 @@ begin
SimpleLinesRaw(FDoc, 3); SimpleLinesRaw(FDoc, 3);
SimpleImage(FDoc, 4); SimpleImage(FDoc, 4);
SampleMatrixTransform(FDoc, 5); SampleMatrixTransform(FDoc, 5);
SampleLandscape(FDoc, 6);
end end
else else
begin begin
@ -510,6 +549,7 @@ begin
4: SimpleLinesRaw(FDoc, 0); 4: SimpleLinesRaw(FDoc, 0);
5: SimpleImage(FDoc, 0); 5: SimpleImage(FDoc, 0);
6: SampleMatrixTransform(FDoc, 0); 6: SampleMatrixTransform(FDoc, 0);
7: SampleLandscape(FDoc, 0);
end; end;
end; end;
@ -526,8 +566,8 @@ procedure TPDFTestApp.WriteHelp;
begin begin
writeln('Usage:'); writeln('Usage:');
writeln(' -h Show this help.'); writeln(' -h Show this help.');
writeln(' -p <n> Generate only one page. Valid range is 1-5.' + LineEnding + writeln(' -p <n> Generate only one page. Valid range is 1-7.' + LineEnding +
' If this option is not specified, then all 5 pages are' + LineEnding + ' If this option is not specified, then all 7 pages are' + LineEnding +
' generated.'); ' generated.');
writeln(' -f <0|1> Toggle embedded font compression. A value of 0' + LineEnding + writeln(' -f <0|1> Toggle embedded font compression. A value of 0' + LineEnding +
' disables compression. A value of 1 enables compression.'); ' disables compression. A value of 1 enables compression.');

View File

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

View File

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