mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 22:14:25 +02:00
--- 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:
parent
e8cc741cb3
commit
f09f916a5a
@ -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;
|
||||||
|
@ -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));
|
||||||
|
@ -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;
|
||||||
|
@ -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.');
|
||||||
|
@ -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
|
||||||
|
@ -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];
|
||||||
|
Loading…
Reference in New Issue
Block a user