mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 11:29:37 +02:00
* Annotations (and HTML links) support
git-svn-id: trunk@33998 -
This commit is contained in:
parent
d31d24ed16
commit
e022ba1b53
@ -145,6 +145,9 @@ begin
|
|||||||
P.SetFont(FtTitle, 12);
|
P.SetFont(FtTitle, 12);
|
||||||
P.SetColor(clBlue, false);
|
P.SetColor(clBlue, false);
|
||||||
P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
|
P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
|
||||||
|
P.SetColor(clBlack, false);
|
||||||
|
P.WriteText(25, 57, 'Click the URL: http://www.freepascal.org');
|
||||||
|
P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
|
||||||
|
|
||||||
P.SetFont(ftText2,16);
|
P.SetFont(ftText2,16);
|
||||||
P.SetColor($c00000, false);
|
P.SetColor($c00000, false);
|
||||||
|
@ -49,7 +49,11 @@ type
|
|||||||
TPDFOptions = set of TPDFOption;
|
TPDFOptions = set of TPDFOption;
|
||||||
|
|
||||||
EPDF = Class(Exception);
|
EPDF = Class(Exception);
|
||||||
TPDFDocument = Class;
|
|
||||||
|
// forward declarations
|
||||||
|
TPDFDocument = class;
|
||||||
|
TPDFAnnotList = class;
|
||||||
|
|
||||||
TARGBColor = Cardinal;
|
TARGBColor = Cardinal;
|
||||||
TPDFFloat = Single;
|
TPDFFloat = Single;
|
||||||
|
|
||||||
@ -209,6 +213,18 @@ type
|
|||||||
constructor Create(Const ADocument : TPDFDocument; const AValue: UTF8String; const AFontIndex: integer); overload;
|
constructor Create(Const ADocument : TPDFDocument; const AValue: UTF8String; const AFontIndex: integer); overload;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ Is useful to populate an array with free-form space separated values. This
|
||||||
|
class is similar to TPDFString, except it doesn't wrap the string content with
|
||||||
|
'(' and ')' symbols and doesn't escape the content. }
|
||||||
|
TPDFFreeFormString = class(TPDFAbstractString)
|
||||||
|
private
|
||||||
|
FValue: string;
|
||||||
|
protected
|
||||||
|
procedure Write(const AStream: TStream); override;
|
||||||
|
public
|
||||||
|
constructor Create(Const ADocument: TPDFDocument; const AValue: string); overload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
TPDFArray = class(TPDFDocumentObject)
|
TPDFArray = class(TPDFDocumentObject)
|
||||||
private
|
private
|
||||||
@ -218,6 +234,7 @@ type
|
|||||||
procedure AddItem(const AValue: TPDFObject);
|
procedure AddItem(const AValue: TPDFObject);
|
||||||
// Add integers in S as TPDFInteger elements to the array
|
// Add integers in S as TPDFInteger elements to the array
|
||||||
Procedure AddIntArray(S : String);
|
Procedure AddIntArray(S : String);
|
||||||
|
procedure AddFreeFormArrayValues(S: string);
|
||||||
public
|
public
|
||||||
constructor Create(Const ADocument : TPDFDocument); override;
|
constructor Create(Const ADocument : TPDFDocument); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -500,9 +517,11 @@ type
|
|||||||
FFontIndex: integer;
|
FFontIndex: integer;
|
||||||
FUnitOfMeasure: TPDFUnitOfMeasure;
|
FUnitOfMeasure: TPDFUnitOfMeasure;
|
||||||
FMatrix: TPDFMatrix;
|
FMatrix: TPDFMatrix;
|
||||||
|
FAnnots: TPDFAnnotList;
|
||||||
procedure CalcPaperSize;
|
procedure CalcPaperSize;
|
||||||
function GetO(AIndex : Integer): TPDFObject;
|
function GetO(AIndex : Integer): TPDFObject;
|
||||||
function GetObjectCount: Integer;
|
function GetObjectCount: Integer;
|
||||||
|
function CreateAnnotList: TPDFAnnotList; virtual;
|
||||||
procedure SetOrientation(AValue: TPDFPaperOrientation);
|
procedure SetOrientation(AValue: TPDFPaperOrientation);
|
||||||
procedure SetPaperType(AValue: TPDFPaperType);
|
procedure SetPaperType(AValue: TPDFPaperType);
|
||||||
procedure AddTextToLookupLists(AText: UTF8String);
|
procedure AddTextToLookupLists(AText: UTF8String);
|
||||||
@ -542,13 +561,15 @@ type
|
|||||||
cause the ellpise to draw to the left of the origin point. }
|
cause the ellpise to draw to the left of the origin point. }
|
||||||
Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
|
Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
|
||||||
Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
|
Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
|
||||||
|
{ Define a rectangle that becomes a clickable hotspot, referencing the URI argument. }
|
||||||
|
Procedure AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const AURI: string; ABorder: boolean = false);
|
||||||
{ This returns the paper height, converted to whatever UnitOfMeasure is set too }
|
{ This returns the paper height, converted to whatever UnitOfMeasure is set too }
|
||||||
function GetPaperHeight: TPDFFloat;
|
function GetPaperHeight: TPDFFloat;
|
||||||
Function HasImages : Boolean;
|
Function HasImages : Boolean;
|
||||||
// Quick settings for Paper.
|
// Quick settings for Paper.
|
||||||
Property PaperType : TPDFPaperType Read FPaperType Write SetPaperType default ptA4;
|
Property PaperType : TPDFPaperType Read FPaperType Write SetPaperType default ptA4;
|
||||||
Property Orientation : TPDFPaperOrientation Read FOrientation Write SetOrientation;
|
Property Orientation : TPDFPaperOrientation Read FOrientation Write SetOrientation;
|
||||||
// Set this if you want custom paper size.
|
// Set this if you want custom paper size. You must set this before setting PaperType = ptCustom.
|
||||||
Property Paper : TPDFPaper Read FPaper Write FPaper;
|
Property Paper : TPDFPaper Read FPaper Write FPaper;
|
||||||
// Unit of Measure - how the PDF Page should convert the coordinates and dimensions
|
// Unit of Measure - how the PDF Page should convert the coordinates and dimensions
|
||||||
property UnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write SetUnitOfMeasure default uomMillimeters;
|
property UnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write SetUnitOfMeasure default uomMillimeters;
|
||||||
@ -558,6 +579,7 @@ type
|
|||||||
property FontIndex: integer read FFontIndex;
|
property FontIndex: integer read FFontIndex;
|
||||||
{ A 3x3 matrix used to translate the PDF Cartesian coordinate system to an Image coordinate system. }
|
{ A 3x3 matrix used to translate the PDF Cartesian coordinate system to an Image coordinate system. }
|
||||||
property Matrix: TPDFMatrix read FMatrix write FMatrix;
|
property Matrix: TPDFMatrix read FMatrix write FMatrix;
|
||||||
|
property Annots: TPDFAnnotList read FAnnots;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -665,17 +687,49 @@ type
|
|||||||
|
|
||||||
TPDFPages = Class(TPDFDocumentObject)
|
TPDFPages = Class(TPDFDocumentObject)
|
||||||
private
|
private
|
||||||
FList : TFPObjectList;
|
FList: TFPObjectList;
|
||||||
function GetP(AIndex : Integer): TPDFPage;
|
function GetP(AIndex: Integer): TPDFPage;
|
||||||
|
function GetPageCount: integer;
|
||||||
public
|
public
|
||||||
Destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
Function AddPage : TPDFPage;
|
function AddPage: TPDFPage;
|
||||||
procedure Add(APage: TPDFPage);
|
procedure Add(APage: TPDFPage);
|
||||||
Property Pages[AIndex : Integer] : TPDFPage Read GetP; Default;
|
property Count: integer read GetPageCount;
|
||||||
|
property Pages[AIndex: Integer]: TPDFPage read GetP; default;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TPDFAnnot = class(TPDFObject)
|
||||||
|
private
|
||||||
|
FLeft: TPDFFloat;
|
||||||
|
FBottom: TPDFFloat;
|
||||||
|
FWidth: TPDFFloat;
|
||||||
|
FHeight: TPDFFloat;
|
||||||
|
FURI: string;
|
||||||
|
FBorder: boolean;
|
||||||
|
public
|
||||||
|
constructor Create(const ADocument: TPDFDocument); override; overload;
|
||||||
|
constructor Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat; const AURI: String; const ABorder: Boolean = false); overload;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TPDFAnnotList = class(TPDFDocumentObject)
|
||||||
|
private
|
||||||
|
FList: TFPObjectList;
|
||||||
|
procedure CheckList;
|
||||||
|
function GetAnnot(AIndex: integer): TPDFAnnot;
|
||||||
|
public
|
||||||
|
destructor Destroy; override;
|
||||||
|
function AddAnnot: TPDFAnnot;
|
||||||
|
function Count: integer;
|
||||||
|
procedure Add(AAnnot: TPDFAnnot);
|
||||||
|
property Annots[AIndex: integer]: TPDFAnnot read GetAnnot; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
TPDFImageCompression = (icNone, icDeflate, icJPEG);
|
TPDFImageCompression = (icNone, icDeflate, icJPEG);
|
||||||
|
|
||||||
|
|
||||||
TPDFImageItem = Class(TCollectionItem)
|
TPDFImageItem = Class(TCollectionItem)
|
||||||
private
|
private
|
||||||
FImage: TFPCustomImage;
|
FImage: TFPCustomImage;
|
||||||
@ -753,15 +807,13 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TPDFDocument }
|
|
||||||
|
|
||||||
TPDFDocument = class(TComponent)
|
TPDFDocument = class(TComponent)
|
||||||
private
|
private
|
||||||
FCatalogue: integer;
|
FCatalogue: integer;
|
||||||
FCurrentColor: string;
|
FCurrentColor: string;
|
||||||
FCurrentWidth: string;
|
FCurrentWidth: string;
|
||||||
FDefaultOrientation: TPDFPaperOrientation;
|
FDefaultOrientation: TPDFPaperOrientation;
|
||||||
FDefaultPaperType: TPDFPaperTYpe;
|
FDefaultPaperType: TPDFPaperType;
|
||||||
FFontDirectory: string;
|
FFontDirectory: string;
|
||||||
FFontFiles: TStrings;
|
FFontFiles: TStrings;
|
||||||
FFonts: TPDFFontDefs;
|
FFonts: TPDFFontDefs;
|
||||||
@ -779,6 +831,7 @@ type
|
|||||||
FGlobalXRefs: TFPObjectList; // list of TPDFXRef
|
FGlobalXRefs: TFPObjectList; // list of TPDFXRef
|
||||||
function GetX(AIndex : Integer): TPDFXRef;
|
function GetX(AIndex : Integer): TPDFXRef;
|
||||||
function GetXC: Integer;
|
function GetXC: Integer;
|
||||||
|
function GetTotalAnnotsCount: integer;
|
||||||
procedure SetFontFiles(AValue: TStrings);
|
procedure SetFontFiles(AValue: TStrings);
|
||||||
procedure SetFonts(AValue: TPDFFontDefs);
|
procedure SetFonts(AValue: TPDFFontDefs);
|
||||||
procedure SetInfos(AValue: TPDFInfos);
|
procedure SetInfos(AValue: TPDFInfos);
|
||||||
@ -802,7 +855,8 @@ type
|
|||||||
procedure CreateTrailer;virtual;
|
procedure CreateTrailer;virtual;
|
||||||
procedure CreateFontEntries; virtual;
|
procedure CreateFontEntries; virtual;
|
||||||
procedure CreateImageEntries; virtual;
|
procedure CreateImageEntries; virtual;
|
||||||
function CreateContentsEntry: integer;virtual;
|
procedure CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary); virtual;
|
||||||
|
function CreateContentsEntry(const APageNum: integer): integer;virtual;
|
||||||
function CreateCatalogEntry: integer;virtual;
|
function CreateCatalogEntry: integer;virtual;
|
||||||
procedure CreateInfoEntry;virtual;
|
procedure CreateInfoEntry;virtual;
|
||||||
procedure CreatePreferencesEntry;virtual;
|
procedure CreatePreferencesEntry;virtual;
|
||||||
@ -820,6 +874,7 @@ type
|
|||||||
procedure CreateToUnicode(const EmbeddedFontNum: integer);virtual;
|
procedure CreateToUnicode(const EmbeddedFontNum: integer);virtual;
|
||||||
procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual;
|
procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual;
|
||||||
procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
|
procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
|
||||||
|
function CreateAnnotEntry(const APageNum, AnnotNum: integer): integer; virtual;
|
||||||
procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
|
procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
|
||||||
Function CreateString(Const AValue : String) : TPDFString;
|
Function CreateString(Const AValue : String) : TPDFString;
|
||||||
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
|
Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
|
||||||
@ -834,8 +889,8 @@ type
|
|||||||
Property CurrentWidth: string Read FCurrentWidth Write FCurrentWidth;
|
Property CurrentWidth: string Read FCurrentWidth Write FCurrentWidth;
|
||||||
public
|
public
|
||||||
constructor Create(AOwner : TComponent); override;
|
constructor Create(AOwner : TComponent); override;
|
||||||
procedure StartDocument;
|
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
procedure StartDocument;
|
||||||
procedure SaveToStream(const AStream: TStream);
|
procedure SaveToStream(const AStream: TStream);
|
||||||
// Create objects, owned by this document.
|
// Create objects, owned by this document.
|
||||||
Function CreateEmbeddedFont(AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
|
Function CreateEmbeddedFont(AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
|
||||||
@ -938,6 +993,7 @@ Resourcestring
|
|||||||
SerrInvalidSectionPage = 'Error: Invalid section page index.';
|
SerrInvalidSectionPage = 'Error: Invalid section page index.';
|
||||||
SErrNoGlobalDict = 'Error: no global XRef named "%s".';
|
SErrNoGlobalDict = 'Error: no global XRef named "%s".';
|
||||||
SErrInvalidPageIndex = 'Invalid page index: %d';
|
SErrInvalidPageIndex = 'Invalid page index: %d';
|
||||||
|
SErrInvalidAnnotIndex = 'Invalid annot index: %d';
|
||||||
SErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
|
SErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -1107,14 +1163,6 @@ begin
|
|||||||
Result := APixels / cDefaultDPI;
|
Result := APixels / cDefaultDPI;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TPDFInfos }
|
|
||||||
|
|
||||||
constructor TPDFInfos.Create;
|
|
||||||
begin
|
|
||||||
inherited Create;
|
|
||||||
FProducer := 'fpGUI Toolkit 0.8';
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ TPDFMatrix }
|
{ TPDFMatrix }
|
||||||
|
|
||||||
function TPDFMatrix.Transform(APoint: TPDFCoord): TPDFCoord;
|
function TPDFMatrix.Transform(APoint: TPDFCoord): TPDFCoord;
|
||||||
@ -1519,6 +1567,11 @@ begin
|
|||||||
Raise EListError.CreateFmt(SErrInvalidPageIndex,[AIndex]);
|
Raise EListError.CreateFmt(SErrInvalidPageIndex,[AIndex]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TPDFPages.GetPageCount: integer;
|
||||||
|
begin
|
||||||
|
result := FList.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
destructor TPDFPages.Destroy;
|
destructor TPDFPages.Destroy;
|
||||||
begin
|
begin
|
||||||
FreeAndNil(FList);
|
FreeAndNil(FList);
|
||||||
@ -1540,6 +1593,69 @@ begin
|
|||||||
FList.Add(APage);
|
FList.Add(APage);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TPDFAnnot }
|
||||||
|
|
||||||
|
constructor TPDFAnnot.Create(const ADocument: TPDFDocument);
|
||||||
|
begin
|
||||||
|
inherited Create(ADocument);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPDFAnnot.Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat;
|
||||||
|
const AURI: String; const ABorder: Boolean);
|
||||||
|
begin
|
||||||
|
Create(ADocument);
|
||||||
|
FLeft := ALeft;
|
||||||
|
FBottom := ABottom;
|
||||||
|
FWidth := AWidth;
|
||||||
|
FHeight := AHeight;
|
||||||
|
FURI := AURI;
|
||||||
|
FBorder := ABorder;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TPDFAnnotList }
|
||||||
|
|
||||||
|
procedure TPDFAnnotList.CheckList;
|
||||||
|
begin
|
||||||
|
if (FList = nil) then
|
||||||
|
FList := TFPObjectList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPDFAnnotList.GetAnnot(AIndex: integer): TPDFAnnot;
|
||||||
|
begin
|
||||||
|
if Assigned(FList) then
|
||||||
|
Result := TPDFAnnot(FList[AIndex])
|
||||||
|
else
|
||||||
|
raise EListError.CreateFmt(SErrInvalidAnnotIndex, [AIndex]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TPDFAnnotList.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FList);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPDFAnnotList.AddAnnot: TPDFAnnot;
|
||||||
|
begin
|
||||||
|
CheckList;
|
||||||
|
Result := TPDFAnnot.Create(Document);
|
||||||
|
FList.Add(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPDFAnnotList.Count: integer;
|
||||||
|
begin
|
||||||
|
if Assigned(FList) then
|
||||||
|
result := FList.Count
|
||||||
|
else
|
||||||
|
result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPDFAnnotList.Add(AAnnot: TPDFAnnot);
|
||||||
|
begin
|
||||||
|
CheckList;
|
||||||
|
FList.Add(AAnnot);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TPDFPage }
|
{ TPDFPage }
|
||||||
|
|
||||||
function TPDFPage.GetO(AIndex : Integer): TPDFObject;
|
function TPDFPage.GetO(AIndex : Integer): TPDFObject;
|
||||||
@ -1555,6 +1671,11 @@ begin
|
|||||||
Result:=FObjects.Count;
|
Result:=FObjects.Count;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TPDFPage.CreateAnnotList: TPDFAnnotList;
|
||||||
|
begin
|
||||||
|
result := TPDFAnnotList.Create(Document);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TPDFPage.SetOrientation(AValue: TPDFPaperOrientation);
|
procedure TPDFPage.SetOrientation(AValue: TPDFPaperOrientation);
|
||||||
begin
|
begin
|
||||||
if FOrientation=AValue then Exit;
|
if FOrientation=AValue then Exit;
|
||||||
@ -1672,11 +1793,14 @@ begin
|
|||||||
FMatrix._20 := 0;
|
FMatrix._20 := 0;
|
||||||
FMatrix._11 := -1; // flip coordinates
|
FMatrix._11 := -1; // flip coordinates
|
||||||
AdjustMatrix; // sets FMatrix._21 value
|
AdjustMatrix; // sets FMatrix._21 value
|
||||||
|
|
||||||
|
FAnnots := CreateAnnotList;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TPDFPage.Destroy;
|
destructor TPDFPage.Destroy;
|
||||||
begin
|
begin
|
||||||
FreeAndNil(FObjects);
|
FreeAndNil(FObjects);
|
||||||
|
FreeAndNil(FAnnots);
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1839,6 +1963,21 @@ begin
|
|||||||
DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke);
|
DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TPDFPage.AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat;
|
||||||
|
const AURI: string; ABorder: boolean);
|
||||||
|
var
|
||||||
|
an: TPDFAnnot;
|
||||||
|
p1, p2: TPDFCoord;
|
||||||
|
begin
|
||||||
|
p1 := Matrix.Transform(APosX, APosY);
|
||||||
|
DoUnitConversion(p1);
|
||||||
|
p2.X := AWidth;
|
||||||
|
p2.Y := AHeight;
|
||||||
|
DoUnitConversion(p2);
|
||||||
|
an := TPDFAnnot.Create(Document, p1.X, p1.Y, p2.X, p2.Y, AURI, ABorder);
|
||||||
|
Annots.Add(an);
|
||||||
|
end;
|
||||||
|
|
||||||
function TPDFPage.GetPaperHeight: TPDFFloat;
|
function TPDFPage.GetPaperHeight: TPDFFloat;
|
||||||
begin
|
begin
|
||||||
case FUnitOfMeasure of
|
case FUnitOfMeasure of
|
||||||
@ -2123,7 +2262,7 @@ begin
|
|||||||
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
|
||||||
if Image.Pixels[x, y] <> AImage.Pixels[x, y] then
|
if Image.Colors[x, y] <> AImage.Colors[x, y] then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
Exit;
|
Exit;
|
||||||
@ -2447,6 +2586,23 @@ begin
|
|||||||
FFontIndex := AFontIndex;
|
FFontIndex := AFontIndex;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TPDFFreeFormString }
|
||||||
|
|
||||||
|
procedure TPDFFreeFormString.Write(const AStream: TStream);
|
||||||
|
var
|
||||||
|
s: AnsiString;
|
||||||
|
begin
|
||||||
|
s := Utf8ToAnsi(FValue);
|
||||||
|
WriteString(s, AStream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TPDFFreeFormString.Create(const ADocument: TPDFDocument; const AValue: string);
|
||||||
|
begin
|
||||||
|
inherited Create(ADocument);
|
||||||
|
FValue := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TPDFArray }
|
{ TPDFArray }
|
||||||
|
|
||||||
procedure TPDFArray.Write(const AStream: TStream);
|
procedure TPDFArray.Write(const AStream: TStream);
|
||||||
@ -2485,6 +2641,11 @@ begin
|
|||||||
AddItem(Document.CreateInteger(StrToInt(S)));
|
AddItem(Document.CreateInteger(StrToInt(S)));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TPDFArray.AddFreeFormArrayValues(S: string);
|
||||||
|
begin
|
||||||
|
AddItem(TPDFFreeFormString.Create(nil, S));
|
||||||
|
end;
|
||||||
|
|
||||||
constructor TPDFArray.Create(const ADocument: TPDFDocument);
|
constructor TPDFArray.Create(const ADocument: TPDFDocument);
|
||||||
begin
|
begin
|
||||||
inherited Create(ADocument);
|
inherited Create(ADocument);
|
||||||
@ -3028,6 +3189,15 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TPDFInfos }
|
||||||
|
|
||||||
|
constructor TPDFInfos.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FProducer := 'fpGUI Toolkit 0.8';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TPDFToUnicode }
|
{ TPDFToUnicode }
|
||||||
|
|
||||||
procedure TPDFToUnicode.Write(const AStream: TStream);
|
procedure TPDFToUnicode.Write(const AStream: TStream);
|
||||||
@ -3102,6 +3272,15 @@ begin
|
|||||||
Result:=FGlobalXRefs.Count;
|
Result:=FGlobalXRefs.Count;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TPDFDocument.GetTotalAnnotsCount: integer;
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
for i := 0 to Pages.Count-1 do
|
||||||
|
Result := Result + Pages[i].Annots.Count;
|
||||||
|
end;
|
||||||
|
|
||||||
function TPDFDocument.IndexOfGlobalXRef(const AValue: string): integer;
|
function TPDFDocument.IndexOfGlobalXRef(const AValue: string): integer;
|
||||||
var
|
var
|
||||||
i: integer;
|
i: integer;
|
||||||
@ -3255,22 +3434,25 @@ var
|
|||||||
PDict,ADict: TPDFDictionary;
|
PDict,ADict: TPDFDictionary;
|
||||||
Arr : TPDFArray;
|
Arr : TPDFArray;
|
||||||
PP : TPDFPage;
|
PP : TPDFPage;
|
||||||
|
AnnotArr: TPDFArray;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
// add xref entry
|
// add xref entry
|
||||||
PP:=Pages[PageNum];
|
PP:=Pages[PageNum];
|
||||||
PDict:=CreateGlobalXRef.Dict;
|
PDict:=CreateGlobalXRef.Dict;
|
||||||
|
|
||||||
PDict.AddName('Type','Page');
|
PDict.AddName('Type','Page');
|
||||||
PDict.AddReference('Parent',Parent);
|
PDict.AddReference('Parent',Parent);
|
||||||
ADict:=GlobalXRefs[Parent].Dict;
|
ADict:=GlobalXRefs[Parent].Dict;
|
||||||
(ADict.ValueByName('Count') as TPDFInteger).Inc;
|
(ADict.ValueByName('Count') as TPDFInteger).Inc;
|
||||||
(ADict.ValueByName('Kids') as TPDFArray).AddItem(CreateReference(GLobalXRefCount-1));
|
(ADict.ValueByName('Kids') as TPDFArray).AddItem(CreateReference(GlobalXRefCount-1));
|
||||||
Arr:=CreateArray;
|
Arr:=CreateArray;
|
||||||
Arr.AddItem(CreateInteger(0));
|
Arr.AddItem(CreateInteger(0));
|
||||||
Arr.AddItem(CreateInteger(0));
|
Arr.AddItem(CreateInteger(0));
|
||||||
Arr.AddItem(CreateInteger(PP.Paper.W));
|
Arr.AddItem(CreateInteger(PP.Paper.W));
|
||||||
Arr.AddItem(CreateInteger(PP.Paper.H));
|
Arr.AddItem(CreateInteger(PP.Paper.H));
|
||||||
PDict.AddElement('MediaBox',Arr);
|
PDict.AddElement('MediaBox',Arr);
|
||||||
|
CreateAnnotEntries(PageNum, PDict);
|
||||||
ADict:=CreateDictionary;
|
ADict:=CreateDictionary;
|
||||||
PDict.AddElement('Resources',ADict);
|
PDict.AddElement('Resources',ADict);
|
||||||
Arr:=CreateArray; // procset
|
Arr:=CreateArray; // procset
|
||||||
@ -3282,7 +3464,8 @@ begin
|
|||||||
ADict.AddElement('Font',CreateDictionary);
|
ADict.AddElement('Font',CreateDictionary);
|
||||||
if PP.HasImages then
|
if PP.HasImages then
|
||||||
ADict.AddElement('XObject', CreateDictionary);
|
ADict.AddElement('XObject', CreateDictionary);
|
||||||
Result:=GLobalXRefCount-1;
|
|
||||||
|
Result:=GlobalXRefCount-1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TPDFDocument.CreateOutlines: integer;
|
function TPDFDocument.CreateOutlines: integer;
|
||||||
@ -3517,15 +3700,64 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TPDFDocument.CreateContentsEntry: integer;
|
function TPDFDocument.CreateAnnotEntry(const APageNum, AnnotNum: integer): integer;
|
||||||
|
var
|
||||||
|
lDict, ADict: TPDFDictionary;
|
||||||
|
an: TPDFAnnot;
|
||||||
|
ar: TPDFArray;
|
||||||
|
lXRef: TPDFXRef;
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
an := Pages[APageNum].Annots[AnnotNum];
|
||||||
|
lXRef := CreateGlobalXRef;
|
||||||
|
lDict := lXRef.Dict;
|
||||||
|
lDict.AddName('Type', 'Annot');
|
||||||
|
lDict.AddName('Subtype', 'Link');
|
||||||
|
{ Invert link on click - PDF 1.3 spec pg.410. It is the default value, but
|
||||||
|
some PDF viewers don't apply that if not explicity specified. }
|
||||||
|
lDict.AddName('H', 'I');
|
||||||
|
|
||||||
|
{ Border array consists of 3 or 4 values. The first three elements describe
|
||||||
|
the horizontal corner radius, the vertical corner radius and the border
|
||||||
|
width. A 0 border width means no border is drawn. The optional 4th element
|
||||||
|
is an array defining a dash pattern. For example: /Border [16 16 2 [2 1]] }
|
||||||
|
ar := CreateArray;
|
||||||
|
lDict.AddElement('Border', ar);
|
||||||
|
if an.FBorder then
|
||||||
|
s := '1'
|
||||||
|
else
|
||||||
|
s := '0';
|
||||||
|
ar.AddFreeFormArrayValues('0 0 ' + s);
|
||||||
|
|
||||||
|
ar := CreateArray;
|
||||||
|
lDict.AddElement('Rect', ar);
|
||||||
|
s := ar.FloatStr(an.FLeft);
|
||||||
|
s := s + ' ' + ar.FloatStr(an.FBottom);
|
||||||
|
s := s + ' ' + ar.FloatStr(an.FLeft + an.FWidth);
|
||||||
|
s := s + ' ' + ar.FloatStr(an.FBottom + an.FHeight);
|
||||||
|
ar.AddFreeFormArrayValues(s);
|
||||||
|
|
||||||
|
ADict := CreateDictionary;
|
||||||
|
lDict.AddElement('A', ADict);
|
||||||
|
ADict.AddName('Type', 'Action');
|
||||||
|
ADict.AddName('S', 'URI');
|
||||||
|
ADict.AddString('URI', an.FURI);
|
||||||
|
|
||||||
|
result := GlobalXRefCount-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPDFDocument.CreateContentsEntry(const APageNum: integer): integer;
|
||||||
var
|
var
|
||||||
Contents: TPDFXRef;
|
Contents: TPDFXRef;
|
||||||
|
i: integer;
|
||||||
begin
|
begin
|
||||||
Contents:=CreateGlobalXRef;
|
Contents:=CreateGlobalXRef;
|
||||||
Contents.FStream:=CreateStream(False);
|
Contents.FStream:=CreateStream(False);
|
||||||
Result:=GlobalXRefCount-1;
|
Result:=GlobalXRefCount-1;
|
||||||
GlobalXrefs[GlobalXRefCount-2].Dict.AddReference('Contents',Result);
|
{ TODO: This is terrible code. See if we can make a better plan getting hold
|
||||||
|
of the reference to the Page dictionary. }
|
||||||
|
i := 2 + Pages[APageNum].Annots.Count; // + GetTotalAnnotsCount;
|
||||||
|
GlobalXrefs[GlobalXRefCount-i].Dict.AddReference('Contents',Result);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TPDFDocument.CreatePageStream(APage : TPDFPage; PageNum: integer);
|
procedure TPDFDocument.CreatePageStream(APage : TPDFPage; PageNum: integer);
|
||||||
@ -3553,7 +3785,6 @@ begin
|
|||||||
Result:=FGlobalXRefs.Add(AXRef);
|
Result:=FGlobalXRefs.Add(AXRef);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TPDFDocument.GlobalXRefByName(const AName: String): TPDFXRef;
|
function TPDFDocument.GlobalXRefByName(const AName: String): TPDFXRef;
|
||||||
begin
|
begin
|
||||||
Result:=FindGlobalXRef(AName);
|
Result:=FindGlobalXRef(AName);
|
||||||
@ -3561,38 +3792,32 @@ begin
|
|||||||
Raise EPDF.CreateFmt(SErrNoGlobalDict,[AName]);
|
Raise EPDF.CreateFmt(SErrNoGlobalDict,[AName]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreateLineStyles : TPDFLineStyleDefs;
|
function TPDFDocument.CreateLineStyles: TPDFLineStyleDefs;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=TPDFLineStyleDefs.Create(TPDFLineStyleDef);
|
Result:=TPDFLineStyleDefs.Create(TPDFLineStyleDef);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreateSectionList : TPDFSectionList;
|
function TPDFDocument.CreateSectionList: TPDFSectionList;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=TPDFSectionList.Create(TPDFSection)
|
Result:=TPDFSectionList.Create(TPDFSection)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreateFontDefs : TPDFFontDefs;
|
function TPDFDocument.CreateFontDefs: TPDFFontDefs;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := TPDFFontDefs.Create(TPDFFont);
|
Result := TPDFFontDefs.Create(TPDFFont);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreatePDFInfos : TPDFInfos;
|
function TPDFDocument.CreatePDFInfos: TPDFInfos;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=TPDFInfos.Create;
|
Result:=TPDFInfos.Create;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreatePDFImages : TPDFImages;
|
function TPDFDocument.CreatePDFImages: TPDFImages;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=TPDFImages.Create(Self,TPDFImageItem);
|
Result:=TPDFImages.Create(Self,TPDFImageItem);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TPDFDocument.CreatePDFPages : TPDFPages;
|
function TPDFDocument.CreatePDFPages: TPDFPages;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result:=TPDFPages.Create(Self);
|
Result:=TPDFPages.Create(Self);
|
||||||
end;
|
end;
|
||||||
@ -3764,7 +3989,7 @@ begin
|
|||||||
Arr.AddItem(CreateReference(GLobalXRefCount-1));
|
Arr.AddItem(CreateReference(GLobalXRefCount-1));
|
||||||
Arr.AddItem(CreateName('XYZ null null '+TPDFObject.FloatStr(StrToInt(FZoomValue) / 100), False));
|
Arr.AddItem(CreateName('XYZ null null '+TPDFObject.FloatStr(StrToInt(FZoomValue) / 100), False));
|
||||||
end;
|
end;
|
||||||
PageNum:=CreateContentsEntry; // pagenum = object number in the pdf file
|
PageNum:=CreateContentsEntry(k); // pagenum = object number in the pdf file
|
||||||
CreatePageStream(S.Pages[k],PageNum);
|
CreatePageStream(S.Pages[k],PageNum);
|
||||||
if (Sections.Count>1) and (poOutline in Options) then
|
if (Sections.Count>1) and (poOutline in Options) then
|
||||||
begin
|
begin
|
||||||
@ -3820,6 +4045,23 @@ begin
|
|||||||
CreateImageEntry(Images[i].Width,Images[i].Height,i);
|
CreateImageEntry(Images[i].Width,Images[i].Height,i);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TPDFDocument.CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary);
|
||||||
|
var
|
||||||
|
i: integer;
|
||||||
|
refnum: integer;
|
||||||
|
ar: TPDFArray;
|
||||||
|
begin
|
||||||
|
if GetTotalAnnotsCount = 0 then
|
||||||
|
Exit;
|
||||||
|
ar := CreateArray;
|
||||||
|
APageDict.AddElement('Annots', ar);
|
||||||
|
for i := 0 to Pages[APageNum].Annots.Count-1 do
|
||||||
|
begin
|
||||||
|
refnum := CreateAnnotEntry(APageNum, i);
|
||||||
|
ar.AddItem(CreateReference(refnum));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TPDFDocument.SaveToStream(const AStream: TStream);
|
procedure TPDFDocument.SaveToStream(const AStream: TStream);
|
||||||
|
|
||||||
var
|
var
|
||||||
|
@ -65,8 +65,11 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TFPFontCacheList }
|
||||||
|
|
||||||
TFPFontCacheList = class(TObject)
|
TFPFontCacheList = class(TObject)
|
||||||
private
|
private
|
||||||
|
FBuildFontFacheIgnoresErrors: Boolean;
|
||||||
FList: TObjectList;
|
FList: TObjectList;
|
||||||
FSearchPath: TStringList;
|
FSearchPath: TStringList;
|
||||||
FDPI: integer;
|
FDPI: integer;
|
||||||
@ -95,6 +98,7 @@ type
|
|||||||
property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
|
property Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
|
||||||
property SearchPath: TStringList read FSearchPath;
|
property SearchPath: TStringList read FSearchPath;
|
||||||
property DPI: integer read FDPI write SetDPI;
|
property DPI: integer read FDPI write SetDPI;
|
||||||
|
Property BuildFontFacheIgnoresErrors : Boolean Read FBuildFontFacheIgnoresErrors Write FBuildFontFacheIgnoresErrors;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -309,8 +313,13 @@ begin
|
|||||||
if (lowercase(ExtractFileExt(s)) = '.ttf') or
|
if (lowercase(ExtractFileExt(s)) = '.ttf') or
|
||||||
(lowercase(ExtractFileExt(s)) = '.otf') then
|
(lowercase(ExtractFileExt(s)) = '.otf') then
|
||||||
begin
|
begin
|
||||||
lFont := TFPFontCacheItem.Create(AFontPath + s);
|
try
|
||||||
Add(lFont);
|
lFont := TFPFontCacheItem.Create(AFontPath + s);
|
||||||
|
Add(lFont);
|
||||||
|
except
|
||||||
|
if not FBuildFontFacheIgnoresErrors then
|
||||||
|
Raise;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
until FindNext(sr) <> 0;
|
until FindNext(sr) <> 0;
|
||||||
|
Loading…
Reference in New Issue
Block a user