paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-25 18:12:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Several improvements in PDF generator:

Browse Source 
- Removed TTextDictionary class.
 - adds code comments and fixes a spelling mistake.
 - Removes TFontDef definition - we don't need it any more.
 - refactored TPDFDocument Text API to overloaded methods CreateText()
 - test: update test project to reflect the latest API changes.
 - unittests: update tests to match recent API changes.

git-svn-id: trunk@33483 -
This commit is contained in:
michael 2016-04-11 18:27:34 +00:00
parent b30a809fdd
commit b46969cfa8
4 changed files with 75 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
packages/fcl-pdf/examples/testfppdf.lpr
View File

@ -144,22 +144,22 @@ begin
P.SetFont(ftText3, 13);
P.SetColor(clBlack, false);
P.WriteUTF8Text(15, 120, 'Languages: English: Hello, World!');
P.WriteUTF8Text(40, 130, 'Greek: Γειά σου κόσμος');
P.WriteUTF8Text(40, 140, 'Polish: Witaj świecie');
P.WriteUTF8Text(40, 150, 'Portuguese: Olá mundo');
P.WriteUTF8Text(40, 160, 'Russian: Здравствуйте мир');
P.WriteUTF8Text(40, 170, 'Vietnamese: Xin chào thế giới');
P.WriteText(15, 120, 'Languages: English: Hello, World!');
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.WriteUTF8Text(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
P.WriteUTF8Text(15, 200, 'Typography: “What’s wrong?”');
P.WriteUTF8Text(40, 210, '£17.99 vs £17·99');
P.WriteUTF8Text(40, 220, '€17.99 vs €17·99');
P.WriteUTF8Text(40, 230, 'OK then… êçèûÎÐð£¢ß');
P.WriteText(15, 200, 'Typography: “What’s wrong?”');
P.WriteText(40, 210, '£17.99 vs £17·99');
P.WriteText(40, 220, '€17.99 vs €17·99');
P.WriteText(40, 230, 'OK then… êçèûÎÐð£¢ß');
P.WriteUTF8Text(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
end;
procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);

130
packages/fcl-pdf/src/fppdf.pp
View File

@ -18,6 +18,9 @@ unit fppdf;
{$mode objfpc}{$H+}
{ enable compiler define for extra console debug output }
{.$define gdebug}
interface
uses
@ -172,8 +175,11 @@ type
TPDFAbstractString = class(TPDFDocumentObject)
protected
FFontIndex: integer;
// These symbols must be preceded by a backslash: "(", ")", "\"
function InsertEscape(const AValue: string): string;
public
property FontIndex: integer read FFontIndex;
end;
@ -190,14 +196,12 @@ type
TPDFUTF8String = class(TPDFAbstractString)
private
FValue: UTF8String;
FFontIndex: integer;
{ Remap each character to the equivalant dictionary character code }
function RemapedText: AnsiString;
protected
procedure Write(const AStream: TStream); override;
public
constructor Create(Const ADocument : TPDFDocument; const AValue: UTF8String; const AFontIndex: integer); overload;
property FontIndex: integer read FFontIndex;
end;
@ -244,14 +248,16 @@ type
FX: TPDFFloat;
FY: TPDFFloat;
FString: TPDFString;
FFontIndex: integer;
protected
procedure Write(const AStream: TStream); override;
public
constructor Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: string); overload;
constructor Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString; const AFontIndex: integer); 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;
end;
@ -500,6 +506,8 @@ type
procedure AdjustMatrix;
protected
procedure DoUnitConversion(var APoint: TPDFCoord); virtual;
procedure CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; AFontIndex: integer); virtual;
procedure CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; AFontIndex: integer); virtual;
Public
Constructor Create(Const ADocument : TPDFDocument); override;
Destructor Destroy; override;
@ -509,9 +517,9 @@ type
// used for stroking and nonstroking colors - purpose determined by the AStroke parameter
Procedure SetColor(AColor : TARGBColor; AStroke : Boolean = True);
Procedure SetPenStyle(AStyle : TPDFPenStyle);
Procedure WriteText(X, Y: TPDFFloat; AText : String); overload;
Procedure WriteText(APos: TPDFCoord; AText : String); overload;
Procedure WriteUTF8Text(X, Y: TPDFFloat; AText : UTF8String);
{ output coordinate is the font baseline. }
Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String); overload;
Procedure WriteText(APos: TPDFCoord; AText : UTF8String); overload;
procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat); overload;
procedure DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat); overload;
Procedure DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer); overload;
@ -601,14 +609,6 @@ type
property GlyphID: uint16 read FGlyphID write FGlyphID;
end;
TTextDictionary = class(TObject)
private
FChar: UnicodeChar;
FCodePoint: AnsiString;
public
property Char: UnicodeChar read FChar write FChar;
property CodePoint: AnsiString read FCodePoint write FCodePoint;
end;
TPDFFont = CLass(TCollectionItem)
private
@ -702,25 +702,6 @@ type
end;
TFontDef = record
FType: string;
FName: string;
FAscent: string;
FDescent: string;
FCapHeight: string;
FFlags: string;
FFontBBox: string;
FItalicAngle: string;
FStemV: string;
FMissingWidth: string;
FEncoding: string;
FFile: string;
FOriginalSize: string;
FDiffs: WideString;
FCharWidth: WideString;
end;
TPDFToUnicode = class(TPDFDocumentObject)
private
FEmbeddedFontNum: integer;
@ -812,6 +793,8 @@ type
procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual;
procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
Function CreateString(Const AValue : String) : TPDFString;
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
Function CreateGlobalXRef: TPDFXRef;
Function AddGlobalXRef(AXRef : TPDFXRef) : Integer;
function IndexOfGlobalXRef(const AValue: string): integer;
@ -828,15 +811,13 @@ type
procedure SaveToStream(const AStream: TStream);
// Create objects, owned by this document.
Function CreateEmbeddedFont(AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
Function CreateText(X,Y : TPDFFloat; AText : String) : TPDFText;
Function CreateUTF8Text(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer) : TPDFUTF8Text;
Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFontIndex: integer) : TPDFText; overload;
Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer) : TPDFUTF8Text; overload;
Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
Function CreateBoolean(AValue : Boolean) : TPDFBoolean;
Function CreateInteger(AValue : Integer) : TPDFInteger;
Function CreateReference(AValue : Integer) : TPDFReference;
Function CreateString(Const AValue : String) : TPDFString;
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
Function CreateLineStyle(APenStyle: TPDFPenStyle) : TPDFLineStyle;
Function CreateName(AValue : String) : TPDFName;
Function CreateStream(OwnsObjects : Boolean = True) : TPDFStream;
@ -1606,6 +1587,23 @@ begin
end;
end;
procedure TPDFPage.CreateStdFontText(X: TPDFFloat; Y: TPDFFloat; AText: AnsiString; AFontIndex: integer);
var
T: TPDFText;
begin
T := Document.CreateText(X, Y, AText, AFontIndex);
AddObject(T);
end;
procedure TPDFPage.CreateTTFFontText(X: TPDFFloat; Y: TPDFFloat; AText: UTF8String; AFontIndex: integer);
var
T: TPDFUTF8Text;
begin
AddTextToLookupLists(AText);
T := Document.CreateText(X, Y, AText, FFontIndex);
AddObject(T);
end;
procedure TPDFPage.SetUnitOfMeasure(AValue: TPDFUnitOfMeasure);
begin
if FUnitOfMeasure = AValue then
@ -1682,34 +1680,23 @@ begin
AddObject(L);
end;
procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: String);
procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String);
var
T: TPDFText;
p: TPDFCoord;
begin
p := Matrix.Transform(X, Y);
DoUnitConversion(p);
T := Document.CreateText(p.X, p.Y, AText);
AddObject(T);
end;
procedure TPDFPage.WriteText(APos: TPDFCoord; AText: String);
begin
WriteText(APos.X, APos.Y, AText);
end;
procedure TPDFPage.WriteUTF8Text(X, Y: TPDFFloat; AText: UTF8String);
var
T: TPDFUTF8Text;
p: TPDFCoord;
begin
if FFontIndex = -1 then
raise EPDF.Create(SErrNoFontIndex);
p := Matrix.Transform(X, Y);
DoUnitConversion(p);
AddTextToLookupLists(AText);
T := Document.CreateUTF8Text(p.X, p.Y, AText, FFontIndex);
AddObject(T);
if Document.Fonts[FFontIndex].IsStdFont then
CreateStdFontText(p.X, p.Y, AText, FFontIndex)
else
CreateTTFFontText(p.X, p.Y, AText, FFontIndex);
end;
procedure TPDFPage.WriteText(APos: TPDFCoord; AText: UTF8String);
begin
WriteText(APos.X, APos.Y, AText);
end;
procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat);
@ -2205,13 +2192,11 @@ end;
procedure TPDFString.Write(const AStream: TStream);
var
s: AnsiString;
// cs: AnsiString;
begin
s := Utf8ToAnsi(FValue);
if poCompressText in Document.Options then
begin
// do nothing yet
// CompressString(s, cs);
// TODO: Implement text compression
WriteString('('+s+')', AStream);
end
else
@ -2240,7 +2225,7 @@ procedure TPDFUTF8String.Write(const AStream: TStream);
begin
if poCompressText in Document.Options then
begin
// do nothing yet
// TODO: Implement text compression
WriteString('<'+RemapedText+'>', AStream)
end
else
@ -2380,11 +2365,13 @@ begin
WriteString('ET'+CRLF, AStream);
end;
constructor TPDFText.Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: string);
constructor TPDFText.Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString;
const AFontIndex: integer);
begin
inherited Create(ADocument);
FX:=AX;
FY:=AY;
FFontIndex := AFontIndex;
FString:=ADocument.CreateString(AText);
end;
@ -2406,7 +2393,7 @@ begin
end;
constructor TPDFUTF8Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String;
const AFontIndex: integer);
const AFontIndex: integer);
begin
inherited Create(ADocument);
FX := AX;
@ -3626,13 +3613,19 @@ begin
Result:=TPDFEmbeddedFont.Create(Self,AFontIndex,IntToStr(AFontSize))
end;
function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: String): TPDFText;
function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFontIndex: integer): TPDFText;
begin
Result:=TPDFText.Create(Self,X,Y,AText);
{$ifdef gdebug}
writeln('TPDFDocument.CreateText( AnsiString ) ', AFontIndex);
{$endif}
Result:=TPDFText.Create(Self,X,Y,AText,AFontIndex);
end;
function TPDFDocument.CreateUTF8Text(X, Y: TPDFFloat; AText: UTF8String; const AFontIndex: integer): TPDFUTF8Text;
function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UTF8String; const AFontIndex: integer): TPDFUTF8Text;
begin
{$ifdef gdebug}
writeln('TPDFDocument.CreateText( UTF8String ) ', AFontIndex);
{$endif}
Result := TPDFUTF8Text.Create(Self,X,Y,AText,AFontIndex);
end;
@ -3641,8 +3634,7 @@ begin
Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
end;
function TPDFDocument.CreateColor(AColor: TARGBColor; AStroke: Boolean
): TPDFColor;
function TPDFDocument.CreateColor(AColor: TARGBColor; AStroke: Boolean): TPDFColor;
begin
Result:=TPDFColor.Create(Self,AStroke,AColor);
end;

2
packages/fcl-pdf/src/fpttf.pp
View File

@ -96,7 +96,7 @@ type
function IndexOf(const AObject: TFPFontCacheItem): integer;
function Find(const AFontCacheItem: TFPFontCacheItem): integer;
function Find(const AFamilyName: string; ABold: boolean = False; AItalic: boolean = False): TFPFontCacheItem;
{ not used: utility function doing a conversion for use. }
{ not used: utility function doing a conversion for us. }
function PointSizeInPixels(const APointSize: single): single;
property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
property SearchPath: TStringList read FSearchPath;

2
packages/fcl-pdf/tests/fppdf_test.pas
View File

@ -679,7 +679,7 @@ var
begin
x := 10.5;
y := 20.0;
o := TPDFText.Create(PDF, x, y, 'Hello World!');
o := TPDFText.Create(PDF, x, y, 'Hello World!', 0);
try
AssertEquals('Failed on 1', '', S.DataString);
TMockPDFText(o).Write(S);