{*
* << P o w e r P d f >> -- PdfDoc.pas
*
* Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
*
* This library is free software; you can redistribute it and/or modify it
* under the terms of the GNU Library General Public License as published
* by the Free Software Foundation; either version 2 of the License, or any
* later version.
*
* This library is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
* details.
*
* You should have received a copy of the GNU Library General Public License
* along with this library.
*
* 2000.09.10 create.
* 2001.06.30 move FloatToStrR method to PdfTypes.pas.
* 2001.07.01 implemented text annotation.
* 2001.07.10 move TPDF_STR_TBL and TPDF_INT_TBL defination to top (for BCB).
* 2001.07.21 changed TPdfDictionaryWrapper's properties(Data and HasData) to
* public.
* 2001.07.28 fixed bug of TPdfCanvas.SetPage.
* 2001.08.01 added TPdfCatalog.PageLayout
* 2001.08.09 moved some constans from PdfTypes.pas.
* 2001.08.12 changed the implementation of outlines.
* 2001.08.12 changed the implementation of annotation.
* 2001.08.18 added GetNextWord routine.
* 2001.08.18 changed the parameter of MoveToTextPoint routine.
* 2001.08.20 added Text utility routines.
* 2001.08.20 added Leading property to TPdfCanvasAttribute.
* 2001.08.22 change the method name MesureText to MeasureText(Spelling mistake :-)
* 2001.08.26 changed some definations and methods to work with kylix.
* 2001.09.01 changed the implementation of the image.
* 2001.09.08 added OpenAction function.
* change AddAnnotation method to CreateAnnotation.
* 2001.09.13 added ViewerPreference functions.
*}
{$IFDEF LAZ_POWERPDF}
{$H+}
{$ENDIF}
unit PdfDoc;
interface
// if use "FlateDecode" compression, comment out the next line.
// (this unit and PdfTypes.pas)
//{$DEFINE NOZLIB}
uses
SysUtils, Classes
{$IFDEF UNIX}
, Types
{$ELSE}
, Windows
{$ENDIF}
{$IFDEF LAZ_POWERPDF}
, LCLProc
{$ENDIF}
, PdfTypes
;
const
POWER_PDF_VERSION_TEXT = 'PowerPdf version 0.9';
{*
* PreDefined page size
*}
PDF_PAGE_WIDTH_A4 = 596;
PDF_PAGE_HEIGHT_A4 = 842;
{*
* Dafault page size.
*}
PDF_DEFAULT_PAGE_WIDTH = PDF_PAGE_WIDTH_A4;
PDF_DEFAULT_PAGE_HEIGHT = PDF_PAGE_HEIGHT_A4;
{*
* collection of flags defining various characteristics of the font.
*}
PDF_FONT_FIXED_WIDTH = 1;
PDF_FONT_SERIF = 2;
PDF_FONT_SYMBOLIC = 4;
PDF_FONT_SCRIPT = 8;
// Reserved = 16
PDF_FONT_STD_CHARSET = 32;
PDF_FONT_ITALIC = 64;
// Reserved = 128
// Reserved = 256
// Reserved = 512
// Reserved = 1024
// Reserved = 2048
// Reserved = 4096
// Reserved = 8192
// Reserved = 16384
// Reserved = 32768
PDF_FONT_ALL_CAP = 65536;
PDF_FONT_SMALL_CAP = 131072;
PDF_FONT_FOURCE_BOLD = 262144;
PDF_DEFAULT_FONT = 'Arial';
PDF_DEFAULT_FONT_SIZE = 10;
PDF_MIN_HORIZONTALSCALING = 10;
PDF_MAX_HORIZONTALSCALING = 300;
PDF_MAX_WORDSPACE = 300;
PDF_MIN_CHARSPACE = -30;
PDF_MAX_CHARSPACE = 300;
PDF_MAX_FONTSIZE = 300;
PDF_MAX_ZOOMSIZE = 10;
PDF_MAX_LEADING = 300;
PDF_PAGE_LAYOUT_NAMES: array[0..3] of string = ('SinglePage',
'OneColumn',
'TwoColumnLeft',
'TwoColumnRight');
PDF_PAGE_MODE_NAMES: array[0..3] of string = ('UseNone',
'UseOutlines',
'UseThumbs',
'FullScreen');
PDF_ANNOTATION_TYPE_NAMES: array[0..12] of string = ('Text',
'Link',
'Sound',
'FreeText',
'Stamp',
'Square',
'Circle',
'StrikeOut',
'Highlight',
'Underline',
'Ink',
'FileAttachment',
'Popup');
PDF_DESTINATION_TYPE_NAMES: array[0..7] of string = ('XYZ',
'Fit',
'FitH',
'FitV',
'FitR',
'FitB',
'FitBH',
'FitBV');
type
{*
* The pagemode determines how the document should appear when opened.
*}
TPdfPageMode = (pmUseNone,
pmUseOutlines,
pmUseThumbs,
pmFullScreen);
{*
* The line cap style specifies the shape to be used at the ends of open
* subpaths when they are stroked.
*}
TLineCapStyle = (lcButt_End,
lcRound_End,
lcProjectingSquareEnd);
{*
* The line join style specifies the shape to be used at the corners of paths
* that are stroked.
*}
TLineJoinStyle = (ljMiterJoin,
ljRoundJoin,
ljBevelJoin);
{*
* The text rendering mode determines whether text is stroked, filled, or used
* as a clipping path.
*}
TTextRenderingMode = (trFill,
trStroke,
trFillThenStroke,
trInvisible,
trFillClipping,
trStrokeClipping,
trFillStrokeClipping,
trClipping);
{*
* The annotation types determines the valid annotation subtype of TPdfDoc.
*}
TPdfAnnotationSubType = (asTextNotes,
asLink);
{*
* The TPdfDestinationType determines default user space coordinate system of
* Explicit destinations.
*}
TPdfDestinationType = (dtXYZ,
dtFit,
dtFitH,
dtFitV,
dtFitR,
dtFitB,
dtFitBH,
dtFitBV);
{*
* TPdfPageLayout specifying the page layout to be used when the document is
* opened:
*}
TPdfPageLayout = (plSinglePage,
plOneColumn,
plTwoColumnLeft,
plTwoColumnRight);
TPdfViewerPreference = (vpHideToolbar,
vpHideMenubar,
vpHideWindowUI,
vpFitWindow,
vpCenterWindow);
TPdfViewerPreferences = set of TPdfViewerPreference;
{$IFDEF NOZLIB}
TPdfCompressionMethod = (cmNone);
{$ELSE}
TPdfCompressionMethod = (cmNone, cmFlateDecode);
{$ENDIF}
TPdfColor = -$7FFFFFFF-1..$7FFFFFFF;
TXObjectID = integer;
TPDF_STR_TBL = record
KEY: string;
VAL: string;
end;
TPDF_INT_TBL = record
KEY: string;
VAL: integer;
end;
TPdfHeader = class(TObject)
protected
procedure WriteToStream(const AStream: TStream);
end;
TPdfTrailer = class(TObject)
private
FAttributes: TPdfDictionary;
FXrefAddress: integer;
protected
procedure WriteToStream(const AStream: TStream);
public
constructor Create(AObjectMgr: TPdfObjectMgr);
destructor Destroy; override;
property XrefAddress: integer read FXrefAddress write FXrefAddress;
property Attributes: TPdfDictionary read FAttributes;
end;
TPdfXrefEntry = class(TObject)
private
FEntryType: string;
FByteOffset: integer;
FGenerationNumber: integer;
FValue: TPdfObject;
function GetAsString: string;
public
constructor Create(AValue: TPdfObject);
destructor Destroy; override;
property EntryType: string read FEntryType write FEntryType;
property ByteOffset: integer read FByteOffSet write FByteOffset;
property GenerationNumber: integer
read FGenerationNumber write FGenerationNumber;
property AsString: string read GetAsString;
property Value: TPdfObject read FValue;
end;
TPdfXref = class(TPdfObjectMgr)
private
FXrefEntries: TList;
function GetItem(ObjectID: integer): TPdfXrefEntry;
function GetItemCount: integer;
protected
procedure WriteToStream(const AStream: TStream);
public
constructor Create;
destructor Destroy; override;
procedure AddObject(AObject: TPdfObject); override;
function GetObject(ObjectID: integer): TPdfObject; override;
property Items[ObjectID: integer]: TPdfXrefEntry read GetItem;
property ItemCount: integer read GetItemCount;
end;
TPdfCanvas = class;
TPdfInfo = class;
TPdfCatalog = class;
TPdfFont = class;
TPdfDestination = class;
// TPdfLink = class;
TPdfOutlineEntry = class;
TPdfOutlineRoot = class;
TAbstractPReport = class(TComponent);
TPdfDoc = class(TObject)
private
FRoot: TPdfCatalog;
FCurrentPages: TPdfDictionary;
FCanvas: TPdfCanvas;
FHeader: TPdfHeader;
FTrailer: TPdfTrailer;
FXref: TPdfXref;
FInfo: TPdfInfo;
FHasDoc: boolean;
FFontList: TList;
FObjectList: TList;
FOutlineRoot: TPdfOutlineRoot;
FXObjectList: TPdfArray;
FDefaultPageWidth: Word;
FDefaultPageHeight: Word;
FCompressionMethod: TPdfCompressionMethod;
FUseOutlines: boolean;
function GetCanvas: TPdfCanvas;
function GetInfo: TPdfInfo;
function GetRoot: TPdfCatalog;
function GetOutlineRoot: TPdfOutlineRoot;
protected
procedure CreateInfo;
procedure CreateOutlines;
function CreateCatalog: TPdfDictionary;
function CreateFont(FontName: string): TPdfFont;
function CreatePages(Parent: TPdfDictionary): TPdfDictionary;
public
procedure RegisterXObject(AObject: TPdfXObject; AName: string);
constructor Create;
destructor Destroy; override;
procedure NewDoc;
procedure FreeDoc;
procedure AddPage;
procedure AddXObject(AName: string; AXObject: TPdfXObject);
procedure SaveToStream(AStream: TStream);
procedure SetVirtualMode;
function GetFont(FontName: string): TPdfFont;
function GetXObject(AName: string): TPdfXObject;
function CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
function CreateDestination: TPdfDestination;
property HasDoc: boolean read FHasDoc;
property Canvas: TPdfCanvas read GetCanvas;
property Info: TPdfInfo read GetInfo;
property Root: TPdfCatalog read GetRoot;
property OutlineRoot: TPdfOutlineRoot read GetOutlineRoot;
property ObjectMgr: TPdfXRef read FXRef;
property DefaultPageWidth: word read FDefaultPageWidth write FDefaultPageWidth;
property DefaultPageHeight: word read FDefaultPageHeight write FDefaultPageHeight;
property CompressionMethod: TPdfCompressionMethod
read FCompressionMethod write FCompressionMethod;
property UseOutlines: boolean read FUseoutlines write FUseoutlines;
end;
TPdfCanvasAttribute = class(TObject)
private
FWordSpace: Single;
FCharSpace: Single;
FFontSize: Single;
FFont: TPdfFont;
FLeading: Single;
FHorizontalScaling: Word;
FFontUnderline: boolean;
procedure SetWordSpace(Value: Single);
procedure SetCharSpace(Value: Single);
procedure SetFontSize(Value: Single);
procedure SetHorizontalScaling(Value: Word);
procedure SetLeading(Value: Single);
public
function TextWidth(Text: string): Single;
function MeasureText(Text: string; Width: Single): integer;
property WordSpace: Single read FWordSpace write SetWordSpace;
property CharSpace: Single read FCharSpace write SetCharSpace;
property HorizontalScaling: Word read FHorizontalScaling
write SetHorizontalScaling;
property Leading: Single read FLeading write SetLeading;
property FontSize: Single read FFontSize write SetFontSize;
property Font: TPdfFont read FFont write FFont;
property FontUnderline: boolean read FFontUnderline write FFontUnderline;
end;
{ TPdfCanvas }
TPdfCanvas = class(TObject)
private
FContents: TPdfStream;
FPage: TPdfDictionary;
FPdfDoc: TPdfDoc;
FAttr: TPdfCanvasAttribute;
FIsVirtual: boolean;
procedure SetPageWidth(AValue: integer);
procedure SetPageHeight(AValue: integer);
procedure WriteString(S: string);
function GetDoc: TPdfDoc;
function GetPage: TPdfDictionary;
function GetPageWidth: Integer;
function GetPageHeight: Integer;
function GetColorStr(Color: TPdfColor): string;
protected
public
constructor Create(APdfDoc: TPdfDoc);
destructor Destroy; override;
{* Special Graphics State *}
procedure GSave; { q }
procedure GRestore; { Q }
procedure Concat(a, b, c, d, e, f: Single); { cm }
{* General Graphics State *}
procedure SetFlat(flatness: Byte); { i }
procedure SetLineCap(linecap: TLineCapStyle); { J }
procedure SetDash(aarray: array of Byte; phase: Byte); { d }
procedure SetLineJoin(linejoin: TLineJoinStyle); { j }
procedure SetLineWidth(linewidth: Single); { w }
procedure SetMiterLimit(miterlimit: Byte); { M }
{* Paths *}
procedure MoveTo(x, y: Single); { m }
procedure LineTo(x, y: Single); { l }
procedure CurveToC(x1, y1, x2, y2, x3, y3: Single); { c }
procedure CurveToV(x2, y2, x3, y3: Single); { v }
procedure CurveToY(x1, y1, x3, y3: Single); { y }
procedure Rectangle(x, y, width, height: Single); { re }
procedure Closepath; { h }
procedure NewPath; { n }
procedure Stroke; { S }
procedure ClosePathStroke; { s }
procedure Fill; { f }
procedure Eofill; { f* }
procedure FillStroke; { B }
procedure ClosepathFillStroke; { b }
procedure EofillStroke; { B* }
procedure ClosepathEofillStroke; { b* }
procedure Clip; { W }
procedure Eoclip; { W* }
{* Test state *}
procedure SetCharSpace(charSpace: Single); { Tc }
procedure SetWordSpace(wordSpace: Single); { Tw }
procedure SetHorizontalScaling(hScaling: Word); { Tz }
procedure SetLeading(leading: Single); { TL }
procedure SetFontAndSize(fontname: string; size: Single); { Tf }
procedure SetTextRenderingMode(mode: TTextRenderingMode); { Tr }
procedure SetTextRise(rise: Word); { Ts }
procedure BeginText; { BT }
procedure EndText; { ET }
procedure MoveTextPoint(tx, ty: Single); { Td }
procedure SetTextMatrix(a, b, c, d, x, y: Single); { Tm }
procedure MoveToNextLine; { T* }
procedure ShowText(s: string); { Tj }
procedure ShowTextNextLine(s: string); { ' }
{* external objects *}
procedure ExecuteXObject(xObject: string); { Do }
{* Device-dependent color space operators *}
procedure SetRGBFillColor(Value: TPdfColor); { rg }
procedure SetRGBStrokeColor(Value: TPdfColor); { RG }
{* utility routines *}
procedure SetPage(APage: TPdfDictionary);
procedure SetFont(AName: string; ASize: Single);
procedure TextOut(X, Y: Single; Text: string);
procedure TextRect(ARect: TPdfRect; Text: string;
Alignment: TPdfAlignment; Clipping: boolean);
procedure MultilineTextRect(ARect: TPdfRect;
Text: string; WordWrap: boolean);
procedure DrawXObject(X, Y, AWidth, AHeight: Single;
AXObjectName: string);
procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
procedure Ellipse(x, y, width, height: Single);
procedure RoundRect(x, y, width, height, rx, ry: Single; SqrCorners:TPdfCorners=[]);
function TextWidth(Text: string): Single;
function MeasureText(Text: string; AWidth: Single): integer;
function GetNextWord(const S: string; var Index: integer): string;
property Attribute: TPdfCanvasAttribute read FAttr;
property Contents: TPdfStream read FContents;
property Page: TPdfDictionary read GetPage;
property Doc: TPdfDoc read GetDoc;
property PageWidth: integer read GetPageWidth write SetPageWidth;
property PageHeight: integer read GetPageHeight write SetPageHeight;
{* Text rotated up *}
procedure TextOutRotatedUp(X, Y: Single; Text: string);
end;
TPdfDictionaryWrapper = class(TPersistent)
private
FData: TPdfDictionary;
function GetHasData: boolean;
protected
procedure SetData(AData: TPdfDictionary); virtual;
public
property Data: TPdfDictionary read FData write SetData;
property HasData: boolean read GetHasData;
end;
TPdfInfo = class(TPdfDictionaryWrapper)
private
function GetAuthor: string;
procedure SetAuthor(Value: string);
function GetCreationDate: TDateTime;
procedure SetCreationDate(Value: TDateTime);
function GetCreator: string;
procedure SetCreator(Value: string);
function GetKeywords: string;
procedure SetKeywords(Value: string);
function GetSubject: string;
procedure SetSubject(Value: string);
function GetTitle: string;
procedure SetTitle(Value: string);
function GetModDate: TDateTime;
procedure SetModDate(Value: TDateTime);
public
property Author: string read GetAuthor write SetAuthor;
property CreationDate: TDateTime read GetCreationDate write SetCreationDate;
property Creator: string read GetCreator write SetCreator;
property Keywords: string read GetKeywords write SetKeywords;
property ModDate: TDateTime read GetModDate write SetModDate;
property Subject: string read GetSubject write SetSubject;
property Title: string read GetTitle write SetTitle;
end;
TPdfCatalog = class(TPdfDictionaryWrapper)
private
FOpenAction: TPdfDestination;
procedure SetPageLayout(Value: TPdfPageLayout);
procedure SetPageMode(Value: TPdfPageMode);
procedure SetNonFullScreenPageMode(Value: TPdfPageMode);
procedure SetViewerPreference(Value: TPdfViewerPreferences);
procedure SetPages(APage: TPdfDictionary);
function GetPageLayout: TPdfPageLayout;
function GetPageMode: TPdfPageMode;
function GetNonFullScreenPageMode: TPdfPageMode;
function GetViewerPreference: TPdfViewerPreferences;
function GetPages: TPdfDictionary;
protected
procedure SaveOpenAction;
public
property OpenAction: TPdfDestination read FOpenAction write FOpenAction;
property PageLayout: TPdfPageLayout read GetPageLayout write SetPageLayout;
property NonFullScreenPageMode: TPdfPageMode
read GetNonFullScreenPageMode write SetNonFullScreenPageMode;
property PageMode: TPdfPageMode read GetPageMode write SetPageMode;
property ViewerPreference: TPdfViewerPreferences
read GetViewerPreference write SetViewerPreference;
property Pages: TPdfDictionary read GetPages write SetPages;
end;
{ TPdfFont }
TPdfFont = class(TPdfDictionaryWrapper)
private
FName: string;
FUnderlinePosition: Integer;
FUnderlineThickness: Integer;
protected
procedure AddStrElements(ADic: TPdfDictionary; ATable: array of TPDF_STR_TBL);
procedure AddIntElements(ADic: TPdfDictionary; ATable: array of TPDF_INT_TBL);
public
constructor Create(AXref: TPdfXref; AName: string); virtual;
function GetCharWidth(AText: string; APos: integer): integer; virtual;
property Name: string read FName;
property UnderlinePosition: Integer read FUnderlinePosition write FUnderlinePosition;
property UnderlineThickness: Integer read FUnderlineThickness write FUnderlineThickness;
end;
TPdfDestination = class(TObject)
private
FDoc: TPdfDoc;
FPage: TPdfDictionary;
FType: TPdfDestinationType;
FValues: array[0..3] of Integer;
FZoom: Single;
FReference: TObject;
procedure SetElement(Index: integer; Value: Integer);
procedure SetZoom(Value: Single);
function GetElement(Index: integer): Integer;
function GetPageWidth: Integer;
function GetPageHeight: Integer;
public
constructor Create(APdfDoc: TPdfDoc);
destructor Destroy; override;
function GetValue: TPdfArray;
property DestinationType: TPdfDestinationType read FType write FType;
property Doc: TPdfDoc read FDoc;
property Left: Integer index 0 read GetElement write SetElement;
property Top: Integer index 1 read GetElement write SetElement;
property Right: Integer index 2 read GetElement write SetElement;
property Bottom: Integer index 3 read GetElement write SetElement;
property PageHeight: Integer read GetPageHeight;
property PageWidth: Integer read GetPageWidth;
property Zoom: Single read FZoom write SetZoom;
property Reference: TObject read FReference write FReference;
end;
TPdfOutlineEntry = class(TPdfDictionaryWrapper)
private
FParent: TPdfOutlineEntry;
FNext: TPdfOutlineEntry;
FPrev: TPdfOutlineEntry;
FFirst: TPdfOutlineEntry;
FLast: TPdfOutlineEntry;
FDest: TPdfDestination;
FDoc: TPdfDoc;
FTitle: string;
FOpened: boolean;
FCount: integer;
FReference: TObject;
protected
constructor CreateEntry(AParent: TPdfOutlineEntry); virtual;
procedure Save; virtual;
public
destructor Destroy; override;
function AddChild: TPdfOutlineEntry;
property Doc: TPdfDoc read FDoc;
property Parent: TPdfOutlineEntry read FParent;
property Next: TPdfOutlineEntry read FNext;
property Prev: TPdfOutlineEntry read FPrev;
property First: TPdfOutlineEntry read FFirst;
property Last: TPdfOutlineEntry read FLast;
property Dest: TPdfDestination read FDest write FDest;
property Title: string read FTitle write FTitle;
property Opened: boolean read FOpened write FOpened;
property Reference: TObject read FReference write FReference;
end;
TPdfOutlineRoot = class(TPdfOutlineEntry)
protected
constructor CreateRoot(ADoc: TPdfDoc); virtual;
public
procedure Save; override;
end;
implementation
{ Utility functions }
// _Pages_AddKids
procedure _Pages_AddKids(AParent: TPdfDictionary; AKid: TPdfDictionary);
var
FKids: TPdfArray;
begin
// adding page object to the parent pages object.
FKids := AParent.PdfArrayByName('Kids');
FKids.AddItem(AKid);
AParent.PdfNumberByName('Count').Value := FKids.ItemCount;
end;
// _Page_GetResources
function _Page_GetResources(APage: TPdfDictionary; AName: string): TPdfDictionary;
var
FResources: TPdfDictionary;
begin
FResources := APage.PdfDictionaryByName('Resources');
Result := FResources.PdfDictionaryByName(AName);
end;
{ TPdfHeader }
// WriteToStream
procedure TPdfHeader.WriteToStream(const AStream: TStream);
begin
_WriteString('%PDF-1.2 '#13#10, AStream);
end;
{ TPdfTrailer }
// WriteToStream
procedure TPdfTrailer.WriteToStream(const AStream: TStream);
begin
_WriteString('trailer' + CRLF, AStream);
FAttributes.WriteToStream(AStream);
_WriteString(CRLF + 'startxref' + CRLF, AStream);
_WriteString(IntToStr(FXrefAddress) + CRLF, AStream);
_WriteString('%%EOF' + CRLF, AStream);
end;
// Create
constructor TPdfTrailer.Create(AObjectMgr: TPdfObjectMgr);
begin
inherited Create;
FAttributes := TPdfDictionary.CreateDictionary(AObjectMgr);
FAttributes.AddItem('Size', TPdfNumber.CreateNumber(0));
end;
// Destroy
destructor TPdfTrailer.Destroy;
begin
FAttributes.Free;
inherited;
end;
{ TPdfXrefEntry }
// Create
constructor TPdfXrefEntry.Create(AValue: TPdfObject);
begin
FByteOffset := -1;
if AValue <> nil then
begin
FEntryType := PDF_IN_USE_ENTRY;
FGenerationNumber := AValue.GenerationNumber;
FValue := AValue;
end
else
begin
FEntryType := PDF_FREE_ENTRY;
FGenerationNumber := 0;
end;
end;
// Destroy
destructor TPdfXrefEntry.Destroy;
begin
if FEntryType = PDF_IN_USE_ENTRY then
FValue.Free;
inherited;
end;
// GetAsString
function TPdfXrefEntry.GetAsString: string;
function FormatIntToString(Value: integer; Len: integer): string;
var
S: string;
i, j: integer;
begin
Result := '';
if Value < 0 then
S := '0'
else
S := IntToStr(Value);
i := Len - Length(S);
for j := 0 to i - 1 do
Result := Result + '0';
Result := Result + S;
end;
begin
Result := FormatIntToString(FByteOffset, 10) +
' ' +
FormatIntToString(FGenerationNumber, 5) +
' ' +
FEntryType;
end;
{ TPdfXref }
// Create
constructor TPdfXref.Create;
var
RootEntry: TPdfXrefEntry;
begin
FXrefEntries := TList.Create;
RootEntry := TPdfXrefEntry.Create(nil);
RootEntry.GenerationNumber := PDF_MAX_GENERATION_NUM;
FXrefEntries.Add(RootEntry);
end;
// Destroy
destructor TPdfXref.Destroy;
var
i: integer;
begin
for i := 0 to FXrefEntries.Count - 1 do
GetItem(i).Free;
FXrefEntries.Free;
inherited;
end;
// AddObject
procedure TPdfXref.AddObject(AObject: TPdfObject);
var
ObjectNumber: integer;
XrefEntry: TPdfXrefEntry;
begin
// register object to xref table, and set objectnumber.
if AObject.ObjectType <> otDirectObject then
raise EPdfInvalidOperation.Create('AddObject --wrong object type.');
XrefEntry := TPdfXrefEntry.Create(AObject);
ObjectNumber := FXrefEntries.Add(XrefEntry);
AObject.SetObjectNumber(ObjectNumber);
end;
// GetItem
function TPdfXref.GetItem(ObjectID: integer): TPdfXrefEntry;
begin
Result := TPdfXrefEntry(FXrefEntries.Items[ObjectID]);
end;
// GetItemCount
function TPdfXref.GetItemCount: integer;
begin
Result := FXrefEntries.Count;
end;
// GetObject
function TPdfXref.GetObject(ObjectID: integer): TPdfObject;
begin
Result := GetItem(ObjectID).Value;
end;
// WriteToStream
procedure TPdfXref.WriteToStream(const AStream: TStream);
var
i: integer;
S: string;
Count: integer;
begin
Count := FXrefEntries.Count;
S := 'xref' +
CRLF +
'0 ' +
IntToStr(Count) +
CRLF;
for i := 0 to Count - 1 do
S := S + Items[i].AsString + CRLF;
_WriteString(S, AStream);
end;
{ TPdfDoc }
// Create
constructor TPdfDoc.Create;
begin
inherited Create;
FHasDoc := false;
FCanvas := TPdfCanvas.Create(Self);
FDefaultPageWidth := PDF_DEFAULT_PAGE_WIDTH;
FDefaultPageHeight := PDF_DEFAULT_PAGE_HEIGHT;
FInfo := nil;
FRoot := nil;
end;
// GetCanvas
function TPdfDoc.GetCanvas: TPdfCanvas;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('GetCanvas --Document is null');
Result := FCanvas;
end;
// GetInfo
function TPdfDoc.GetInfo: TPdfInfo;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('GetInfo --this method can not use this state..');
if FInfo = nil then
CreateInfo;
Result := FInfo;
end;
// GetRoot
function TPdfDoc.GetRoot: TPdfCatalog;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('GetRoot --this method can not use this state..');
Result := FRoot;
end;
// GetOutlineRoot
function TPdfDoc.GetOutlineRoot: TPdfOutlineRoot;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('GetOutlineRoot --document is null..');
if not UseOutlines then
raise EPdfInvalidOperation.Create('GetOutlineRoot --not use outline mode..');
Result := FOutlineRoot;
end;
// Destroy
destructor TPdfDoc.Destroy;
begin
FreeDoc;
FCanvas.Free;
inherited;
end;
// CreateCatalog
function TPdfDoc.CreateCatalog: TPdfDictionary;
begin
// create catalog object and register to xref.
Result := TPdfDictionary.CreateDictionary(FXref);
FXref.AddObject(Result);
Result.AddItem('Type', TPdfName.CreateName('Catalog'));
FTrailer.Attributes.AddItem('Root', Result);
end;
// CreateFont
function TPdfDoc.CreateFont(FontName: string): TPdfFont;
var
PdfFont: TPdfFont;
begin
// create new font (not regist to xref -- because font object registed by
// TPdfFont).
{$IFDEF LAZ_POWERPDF}
PdfFont := TPdfFont(PdfLazFindClass(FontName).Create);
{$ELSE}
PdfFont := TPdfFont(FindClass(FontName).Create);
{$ENDIF}
if PdfFont = nil then
raise Exception.Create('CreateFont --InvalidFontName:' + FontName);
Result := PdfFont.Create(FXref, FontName);
Result.Data.AddItem('Name',
TPdfName.CreateName('F' + IntToStr(FFontList.Count)));
FFontList.Add(Result);
end;
// RegisterXObject
procedure TPdfDoc.RegisterXObject(AObject: TPdfXObject; AName: string);
begin
// check object and register it.
if AObject = nil then
raise EPdfInvalidValue.Create('RegisterXObject --AObject is null');
if _GetTypeOf(AObject.Attributes) <> 'XObject' then
raise EPdfInvalidValue.Create('RegisterXObject --not XObject');
if AObject.ObjectType <> otIndirectObject then
FXref.AddObject(AObject);
if AObject.Attributes.ValueByName('Name') = nil then
begin
if GetXObject(AName) <> nil then
raise EPdfInvalidValue.Createfmt('RegisterXObject --dupulicate name: %s', [AName]);
FXObjectList.AddItem(AObject);
AObject.Attributes.AddItem('Name', TPdfName.CreateName(AName));
end;
end;
// CreateInfo
procedure TPdfDoc.CreateInfo;
var
FInfoDictionary: TPdfDictionary;
begin
FInfoDictionary := TPdfDictionary.CreateDictionary(FXref);
FXref.AddObject(FInfoDictionary);
FInfoDictionary.AddItem('Producer', TPdfText.CreateText(POWER_PDF_VERSION_TEXT));
FTrailer.Attributes.AddItem('Info', FInfoDictionary);
FInfo := TPdfInfo.Create;
FInfo.SetData(FInfoDictionary);
FObjectList.Add(FInfo);
end;
// CreatePages
function TPdfDoc.CreatePages(Parent: TPdfDictionary): TPdfDictionary;
begin
// create pages object and register to xref.
result := TPdfDictionary.CreateDictionary(FXref);
FXref.AddObject(Result);
with Result do
begin
AddItem('Type', TPdfName.CreateName('Pages'));
AddItem('Kids', TPdfArray.CreateArray(FXref));
AddItem('Count', TPdfNumber.CreateNumber(0));
end;
if (Parent <> nil) and (_GetTypeOf(Parent) = 'Pages') then
_Pages_AddKids(Parent, Result)
else
FRoot.Pages := Result;
end;
// CreateOutlines
procedure TPdfDoc.CreateOutlines;
begin
FOutlineRoot := TPdfOutlineRoot.CreateRoot(Self);
FRoot.Data.AddItem('Outlines', FOutlineRoot.Data);
end;
// GetFont
function TPdfDoc.GetFont(FontName: string): TPdfFont;
var
FFont: TPdfFont;
i :integer;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('GetFont --document is null.');
// if specified font exists in fontlist, return it. otherwise, create the font.
Result := nil;
for i := 0 to FFontList.Count - 1 do
begin
FFont := TPdfFont(FFontList.Items[i]);
if FFont.Name = FontName then
begin
Result := FFont;
Break;
end;
end;
if Result = nil then
Result := CreateFont(FontName);
end;
// GetXObject
function TPdfDoc.GetXObject(AName: string): TPdfXObject;
var
FXObject: TPdfXObject;
i :integer;
begin
// return the XObject which name is muched with specified name.
Result := nil;
for i := 0 to FXObjectList.ItemCount - 1 do
begin
FXObject := TPdfXObject(FXObjectList.Items[i]);
if TPdfName(FXObject.Attributes.ValueByName('Name')).Value = AName then
begin
Result := FXObject;
Break;
end;
end;
end;
// CreateAnnotation
function TPdfDoc.CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
var
FAnnotation: TPdfDictionary;
FArray: TPdfArray;
FPage: TPdfDictionary;
begin
if not HasDoc then
raise EPdfInvalidOperation.Create('AddAnotation --document is null.');
// create new annotation and set the properties.
FAnnotation := TPdfDictionary.CreateDictionary(FXref);
FXref.AddObject(FAnnotation);
with FAnnotation do
begin
AddItem('Type', TPdfName.CreateName('Annot'));
AddItem('Subtype', TPdfName.CreateName(PDF_ANNOTATION_TYPE_NAMES[ord(AType)]));
FArray := TPdfArray.CreateArray(nil);
with FArray, ARect do
begin
AddItem(TPdfReal.CreateReal(Left));
AddItem(TPdfReal.CreateReal(Top));
AddItem(TPdfReal.CreateReal(Right));
AddItem(TPdfReal.CreateReal(Bottom));
end;
AddItem('Rect', FArray);
end;
// adding annotation to the current page
FPage := FCanvas.Page;
FArray := FPage.PdfArrayByName('Annots');
if FArray = nil then
begin
FArray := TPdfArray.CreateArray(nil);
FPage.AddItem('Annots', FArray);
end;
FArray.AddItem(FAnnotation);
Result := FAnnotation;
end;
// CreateDestination
function TPdfDoc.CreateDestination: TPdfDestination;
begin
Result := TPdfDestination.Create(Self);
FObjectList.Add(Result);
end;
// NewDoc
procedure TPdfDoc.NewDoc;
begin
{*
* create new document.
*}
FreeDoc;
FXref := TPdfXref.Create;
FHeader := TPdfHeader.Create;
FTrailer := TPdfTrailer.Create(FXref);
FFontList := TList.Create;
FXObjectList := TPdfArray.CreateArray(FXref);
FObjectList := TList.Create;
FRoot := TPdfCatalog.Create;
FRoot.SetData(CreateCatalog);
FObjectList.Add(FRoot);
if UseOutlines then
CreateOutlines;
CreateInfo;
FInfo.CreationDate := now;
FCurrentPages := CreatePages(nil);
FRoot.SetPages(FCurrentPages);
FHasDoc := true;
end;
// AddXObject
procedure TPdfDoc.AddXObject(AName: string; AXObject: TPdfXObject);
begin
if GetXObject(AName) <> nil then
raise Exception.CreateFmt('AddImage --the image named %s is already exists..', [AName]);
// check whether AImage is valid PdfImage or not.
if (AXObject = nil) or (AXObject.Attributes = nil) or
(_GetTypeOf(AXObject.Attributes) <> 'XObject') or
(AXObject.Attributes.PdfNameByName('Subtype').Value <> 'Image') then
raise Exception.Create('AddImage --the image is not valid TPdfImage..');
FXref.AddObject(AXObject);
RegisterXObject(AXObject, AName);
end;
// AddPage
procedure TPdfDoc.AddPage;
var
FPage: TPdfDictionary;
FMediaBox: TPdfArray;
FContents: TPdfStream;
FResources: TPdfDictionary;
FProcSet: TPdfArray;
FFontArray: TPdfDictionary;
FXObjectArray: TPdfDictionary;
{$IFNDEF NOZLIB}
FFilter: TPdfArray;
{$ENDIF}
begin
if FCurrentPages = nil then
raise EPdfInvalidOperation.Create('AddPage --current pages null.');
// create new page object and add it to the current pages object.
FPage := TPdfDictionary.CreateDictionary(FXref);
FXref.AddObject(FPage);
_Pages_AddKids(FCurrentPages, FPage);
FPage.AddItem('Type', TPdfName.CreateName('Page'));
FPage.AddItem('Parent', FCurrentPages);
FMediaBox := TPdfArray.CreateArray(FXref);
with FMediabox do
begin
AddItem(TPdfNumber.CreateNumber(0));
AddItem(TPdfNumber.CreateNumber(0));
AddItem(TPdfNumber.CreateNumber(DefaultPageWidth));
AddItem(TPdfNumber.CreateNumber(DefaultPageHeight));
end;
FPage.AddItem('MediaBox', FMediaBox);
FResources := TPdfDictionary.CreateDictionary(FXref);
FPage.AddItem('Resources', FResources);
FFontArray := TPdfDictionary.CreateDictionary(FXref);
FResources.AddItem('Font', FFontArray);
FXObjectArray := TPdfDictionary.CreateDictionary(FXref);
FResources.AddItem('XObject', FXObjectArray);
FProcSet := TPdfArray.CreateArray(FXref);
with FProcSet do
begin
AddItem(TPdfName.CreateName('PDF'));
AddItem(TPdfName.CreateName('Text'));
AddItem(TPdfName.CreateName('ImageC'));
end;
FResources.AddItem('ProcSet', FProcSet);
FContents := TPdfStream.CreateStream(FXref);
FXref.AddObject(FContents);
{$IFNDEF NOZLIB}
FFilter := FContents.Attributes.PdfArrayByName('Filter');
if FCompressionMethod = cmFlateDecode then
FFilter.AddItem(TPdfName.CreateName('FlateDecode'));
{$ENDIF}
FPage.AddItem('Contents', FContents);
FCanvas.SetPage(FPage);
end;
// FreeDoc
procedure TPdfDoc.FreeDoc;
var
i: integer;
begin
if FHasDoc then
begin
FXObjectList.Free;
for i := FFontList.Count - 1 downto 0 do
TObject(FFontList.Items[i]).Free;
FFontList.Free;
for i := FObjectList.Count - 1 downto 0 do
TObject(FObjectList.Items[i]).Free;
FObjectList.Free;
FXref.Free;
FHeader.Free;
FTrailer.Free;
FInfo := nil;
FRoot := nil;
FOutlineRoot := nil;
FHasDoc := false;
end;
end;
// SaveToStream
procedure TPdfDoc.SaveToStream(AStream: TStream);
var
i: integer;
Pos: integer;
PdfNumber: TPdfNumber;
begin
if not HasDoc or (FCanvas.Page = nil) then
raise EPdfInvalidOperation.Create('SaveToStream --there is no document to save.');
// write all objects to specified stream.
FInfo.ModDate := Now;
FRoot.SaveOpenAction;
// saving outline tree.
if UseOutlines then
FOutlineRoot.Save;
AStream.Position := 0;
FHeader.WriteToStream(AStream);
for i := 1 to FXref.ItemCount - 1 do
begin
Pos := AStream.Position;
FXref.Items[i].Value.WriteValueToStream(AStream);
FXref.Items[i].ByteOffset := Pos;
end;
FTrailer.XrefAddress := AStream.Position;
FXref.WriteToStream(AStream);
PdfNumber := FTrailer.Attributes.PdfNumberByName('Size');
PdfNumber.Value := FXref.ItemCount;
FTrailer.WriteToStream(AStream);
end;
// SetVirtualMode
procedure TPdfDoc.SetVirtualMode;
begin
NewDoc;
AddPage;
FCanvas.FIsVirtual := true;
end;
{ TPdfCanvasAttribute }
// SetWordSpace
procedure TPdfCanvasAttribute.SetWordSpace(Value: Single);
begin
if Value < 0 then
raise EPdfInvalidValue.Create('SetWordSpace --invalid word space');
if Value <> FWordSpace then
FWordSpace := Value;
end;
// SetCharSpace
procedure TPdfCanvasAttribute.SetCharSpace(Value: Single);
begin
if (Value < PDF_MIN_CHARSPACE) or (VALUE > PDF_MAX_CHARSPACE) then
raise EPdfInvalidValue.Create('SetCharSpace --invalid char space');
if Value <> FCharSpace then
FCharSpace := Value;
end;
// SetFontSize
procedure TPdfCanvasAttribute.SetFontSize(Value: Single);
begin
if (Value < 0) or (Value > PDF_MAX_FONTSIZE) then
raise EPdfInvalidValue.Create('SetCharSpace --invalid font size');
if Value <> FFontSize then
FFontSize := Value;
end;
// SetHorizontalScaling
procedure TPdfCanvasAttribute.SetHorizontalScaling(Value: Word);
begin
if (Value < PDF_MIN_HORIZONTALSCALING) or
(Value > PDF_MAX_HORIZONTALSCALING) then
raise EPdfInvalidValue.Create('SetHorizontalScaling --invalid font size');
if Value <> FHorizontalScaling then
FHorizontalScaling := Value;
end;
// SetLeading
procedure TPdfCanvasAttribute.SetLeading(Value: Single);
begin
if (Value < 0) or (Value > PDF_MAX_LEADING) then
raise EPdfInvalidValue.Create('SetLeading --invalid font size');
if Value <> FLeading then
FLeading := Value;
end;
// TextWidth
function TPdfCanvasAttribute.TextWidth(Text: string): Single;
var
i: integer;
ch: char;
tmpWidth: Single;
begin
Result := 0;
{$IFDEF LAZ_POWERPDF}
// for invalid char, any value less than 32 will make FFont.GetCharWidth
// to return a default missing width for that font.
Text := _UTF8ToWinAnsi(Text, #31);
{$ENDIF}
// calculate width of specified text from current attributes
for i := 1 to Length(Text) do
begin
ch := Text[i];
tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
if FHorizontalScaling <> 100 then
tmpWidth := tmpWidth * FHorizontalScaling / 100;
if tmpWidth > 0 then
tmpWidth := tmpWidth + FCharSpace
else
tmpWidth := 0;
if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
tmpWidth := tmpWidth + FWordSpace;
Result := Result + tmpWidth;
end;
Result := Result - FCharSpace;
end;
// MeasureText
function TPdfCanvasAttribute.MeasureText(Text: string; Width: Single): integer;
var
i: integer;
ch: char;
tmpWidth: Single;
tmpTotalWidth: Single;
begin
Result := 0;
tmpTotalWidth := 0;
{$IFDEF LAZ_POWERPDF}
Text := _UTF8ToWinAnsi(Text, #31);
{$ENDIF}
// calculate number of charactor contain in the specified width.
for i := 1 to Length(Text) do
begin
ch := Text[i];
tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
if FHorizontalScaling <> 100 then
tmpWidth := tmpWidth * FHorizontalScaling / 100;
if tmpWidth > 0 then
tmpWidth := tmpWidth + FCharSpace
else
tmpWidth := 0;
if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
tmpWidth := tmpWidth + FWordSpace;
tmpTotalWidth := tmpTotalWidth + tmpWidth;
if tmpTotalWidth > Width then
Break;
inc(Result);
end;
end;
{ TPdfCanvas }
// Create
constructor TPdfCanvas.Create(APdfDoc: TPdfDoc);
begin
FPdfDoc := APdfDoc;
FPage := nil;
FContents := nil;
FAttr := TPdfCanvasAttribute.Create;
FIsVirtual := false;
end;
// Destroy
destructor TPdfCanvas.Destroy;
begin
FAttr.Free;
inherited;
end;
// SetPageWidth
procedure TPdfCanvas.SetPageWidth(AValue: integer);
var
FMediaBox: TPdfArray;
begin
FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
if FMediaBox <> nil then
TPdfNumber(FMediaBox.Items[2]).Value := AValue
else
EPdfInvalidOperation.Create('Can not chenge width of this page..');
end;
// SetPageHeight
procedure TPdfCanvas.SetPageHeight(AValue: integer);
var
FMediaBox: TPdfArray;
begin
FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
if FMediaBox <> nil then
TPdfNumber(FMediaBox.Items[3]).Value := AValue
else
EPdfInvalidOperation.Create('Can not chenge width of this page..');
end;
// WriteString
procedure TPdfCanvas.WriteString(S: string);
begin
if (not FIsVirtual) and (FContents <> nil) then
_WriteString(S, FContents.Stream);
end;
// GetPage
function TPdfCanvas.GetPage: TPdfDictionary;
begin
if FPage <> nil then
result := FPage
else
raise EPdfInvalidOperation.Create('GetPage --the Page is nil');
end;
// GetPageWidth
function TPdfCanvas.GetPageWidth: Integer;
var
FMediaBox: TPdfArray;
begin
FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
if FMediaBox <> nil then
result := TPdfNumber(FMediaBox.Items[2]).Value
else
result := FPdfDoc.DefaultPageWidth;
end;
// GetPageHeight
function TPdfCanvas.GetPageHeight: Integer;
var
FMediaBox: TPdfArray;
begin
FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
if FMediaBox <> nil then
result := TPdfNumber(FMediaBox.Items[3]).Value
else
result := FPdfDoc.DefaultPageHeight;
end;
// GetColorStr
function TPDFCanvas.GetColorStr(Color: TPdfColor): string;
var
X: array[0..3] of Byte;
rgb: integer;
begin
if Color > 0 then
rgb := integer(Color)
else
rgb := 0;
Move(rgb, x[0], 4);
result := _FloatToStrR(X[0] / 255) + ' ' +
_FloatToStrR(X[1] / 255) + ' ' +
_FloatToStrR(X[2] / 255);
end;
// SetPage
procedure TPdfCanvas.SetPage(APage: TPdfDictionary);
procedure GetCurrentFont;
var
AFont: TPdfName;
begin
AFont := Page.PdfNameByName('_Font');
with FAttr do
if AFont <> nil then
begin
Font := FPdfDoc.GetFont(AFont.Value);
FontSize := FPage.PdfNumberByName('_Font_Size').Value;
WordSpace := FPage.PdfRealByName('_Word_Space').Value;
CharSpace := FPage.PdfRealByName('_Char_Space').Value;
HorizontalScaling := FPage.PdfNumberByName('_HScalling').Value;
Leading := FPage.PdfNumberByName('_Leading').Value;
end
else
begin
Font := nil;
SetFont(PDF_DEFAULT_FONT, PDF_DEFAULT_FONT_SIZE);
CharSpace := 0;
WordSpace := 0;
HorizontalScaling := 100;
Leading := 0;
end;
end;
begin
// save current canvas attributes to internal objects.
if FPage <> nil then
with FPage do
begin
AddInternalItem('_Font', TPdfName.CreateName(FAttr.Font.Name));
AddInternalItem('_Font_Size', TPdfReal.CreateReal(FAttr.FontSize));
AddInternalItem('_Word_Space', TPdfReal.CreateReal(FAttr.WordSpace));
AddInternalItem('_Char_Space', TPdfReal.CreateReal(FAttr.CharSpace));
AddInternalItem('_HScalling', TPdfNumber.CreateNumber(FAttr.HorizontalScaling));
AddInternalItem('_Leading', TPdfReal.CreateReal(FAttr.Leading));
end;
FPage := APage;
FContents := TPdfStream(FPage.ValueByName('Contents'));
GetCurrentFont;
end;
// SetFont
procedure TPdfCanvas.SetFont(AName: string; ASize: Single);
var
FFont: TPdfFont;
FFontList: TPdfDictionary;
FFontName: string;
begin
// get font object from pdfdoc object, then find fontlist from page object
// by internal name. if font is not registered, register it to page object.
FFont := FPdfDoc.GetFont(AName);
if (FAttr.Font = FFont) and (FAttr.FontSize = ASize) then Exit;
FFontList := _Page_GetResources(FPage, 'Font');
FFontName := FFont.Data.PdfNameByName('Name').Value;
if FFontList.ValueByName(FFontName) = nil then
FFontList.AddItem(FFontName, FFont.Data);
if FContents <> nil then
SetFontAndSize('/' + FFontName, ASize);
FAttr.Font := FFont;
FAttr.FontSize := ASize;
end;
// TextOut
procedure TPdfCanvas.TextOut(X, Y: Single; Text: string);
var
UPos, UWidth: Single;
begin
BeginText;
MoveTextPoint(X, Y);
ShowText(Text);
EndText;
//TODO: Check Underline
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
Rectangle(X, Y+UPos, FAttr.TextWidth(Text), UWidth);
Fill;
end;
end;
// TextRect
procedure TPdfCanvas.TextRect(ARect: TPdfRect; Text: string;
Alignment: TPdfAlignment; Clipping: boolean);
var
tmpWidth: Single;
XPos,YPos,UPos,UWidth: Single;
begin
// calculate text width.
tmpWidth := TextWidth(Text);
case Alignment of
paCenter: XPos := Round((ARect.Right - ARect.Left - tmpWidth) / 2);
paRightJustify: XPos := ARect.Right - ARect.Left - Round(tmpWidth);
else
XPos := 0;
end;
// clipping client rect if needed.
if Clipping then
begin
GSave;
with ARect do
begin
MoveTo(Left, Top);
LineTo(Left, Bottom);
LineTo(Right, Bottom);
LineTo(Right, Top);
end;
ClosePath;
Clip;
NewPath;
end;
YPos := ARect.Top - FAttr.FontSize * 0.85;
BeginText;
MoveTextPoint(ARect.Left + XPos, YPos);
ShowText(Text);
EndText;
//TODO: Check Underline
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
Rectangle(ARect.Left + XPos, YPos + UPos, FAttr.TextWidth(Text), UWidth);
Fill;
end;
if Clipping then
GRestore;
end;
// MultilineTextRect
procedure TPdfCanvas.MultilineTextRect(ARect: TPdfRect; Text: string;
WordWrap: boolean);
var
i: integer;
S1, S2: string;
XPos, YPos, UPos, UWidth: Single;
tmpXPos: Single;
tmpWidth: Single;
ln: integer;
FourceReturn: boolean;
FText: string;
procedure InternalShowText(S: string; AWidth: Single);
var
i: Integer;
begin
i := MeasureText(S, AWidth);
{$IFDEF LAZ_POWERPDF}
S := UTF8Copy(S, 1, i);
{$ELSE}
S := Copy(S, 1, i);
{$ENDIF}
ShowText(S);
end;
procedure WriteText;
begin
if FAttr.FontUnderline then
begin
BeginText;
MoveTextPoint(ARect.Left, YPos);
InternalShowText(S2, ARect.Right - ARect.Left);
EndText;
Rectangle(ARect.Left, YPos+UPos, XPos-ARect.Left, UWidth);
Fill;
end else
InternalShowText(S2, ARect.Right - ARect.Left);
end;
begin
YPos := ARect.Top - FAttr.FontSize*0.85;
XPos := ARect.Left;
FText := Text;
if FAttr.FontUnderline then
begin
UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
end else
begin
BeginText;
MoveTextPoint(XPos, YPos);
end;
i := 1;
S2 := GetNextWord(FText, i);
XPos := XPos + TextWidth(S2);
if (Length(S2) > 0) and (S2[Length(S2)] = ' ') then
XPos := XPos + FAttr.WordSpace;
while i <= Length(FText) do
begin
ln := Length(S2);
if (ln >= 2) and (S2[ln] = #10) and (S2[ln-1] = #13) then
begin
S2 := Copy(S2, 1, ln - 2);
FourceReturn := true;
end
else
FourceReturn := false;
S1 := GetNextWord(FText, i);
tmpWidth := TextWidth(S1);
TmpXPos := XPos + tmpWidth;
if (WordWrap and (TmpXPos > ARect.Right)) or
FourceReturn then
begin
if S2 <> '' then
WriteText;
S2 := '';
if not FAttr.FontUnderline then
MoveToNextLine;
ARect.Top := ARect.Top - FAttr.Leading;
if ARect.Top < ARect.Bottom + FAttr.FontSize then
Break;
XPos := ARect.Left;
end;
XPos := XPos + tmpWidth;
if (Length(S1) > 0) and (S1[Length(S1)] = ' ') then
XPos := XPos + FAttr.WordSpace;
S2 := S2 + S1;
end;
if S2 <> '' then
WriteText;
if not FAttr.FontUnderline then
EndText;
end;
// DrawXObject
procedure TPdfCanvas.DrawXObject(X, Y, AWidth, AHeight: Single;
AXObjectName: string);
var
XObject: TPdfXObject;
FXObjectList: TPdfDictionary;
begin
// drawing object must be registered. check object name.
XObject := FPdfDoc.GetXObject(AXObjectName);
if XObject = nil then
raise EPdfInvalidValue.CreateFmt('DrawXObject --XObject not found: %s', [AXObjectName]);
FXObjectList := _Page_GetResources(FPage, 'XObject');
if FXObjectList.ValueByName(AXObjectName) = nil then
FXObjectList.AddItem(AXObjectName, XObject);
GSave;
Concat(AWidth, 0, 0, AHeight, X, Y);
ExecuteXObject(XObject.Attributes.PdfNameByName('Name').Value);
GRestore;
end;
// DrawXObjectEx
procedure TPdfCanvas.DrawXObjectEx(X, Y, AWidth, AHeight: Single;
ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
var
XObject: TPdfXObject;
FXObjectList: TPdfDictionary;
begin
// drawing object must be registered. check object name.
XObject := FPdfDoc.GetXObject(AXObjectName);
if XObject = nil then
raise EPdfInvalidValue.CreateFmt('DrawXObjectEx --XObject not found: %s', [AXObjectName]);
FXObjectList := _Page_GetResources(FPage, 'XObject');
if FXObjectList.ValueByName(AXObjectName) = nil then
FXObjectList.AddItem(AXObjectName, XObject);
GSave;
Rectangle(ClipX, ClipY, ClipWidth, ClipHeight);
Clip;
NewPath;
Concat(AWidth, 0, 0, AHeight, X, Y);
ExecuteXObject(XObject.Attributes.PdfNameByName('Name').Value);
GRestore;
end;
{* Special Graphics State *}
// GSave
procedure TPdfCanvas.GSave;
begin
WriteString('q'#10);
end;
// GRestore
procedure TPdfCanvas.GRestore;
begin
WriteString('Q'#10);
end;
// Concat
procedure TPdfCanvas.Concat(a, b, c, d, e, f: Single);
var
S: string;
begin
S := _FloatToStrR(a) + ' ' +
_FloatToStrR(b) + ' ' +
_FloatToStrR(c) + ' ' +
_FloatToStrR(d) + ' ' +
_FloatToStrR(e) + ' ' +
_FloatToStrR(f) + ' cm'#10;
WriteString(S);
end;
{* General Graphics State *}
// SetFlat
procedure TPdfCanvas.SetFlat(flatness: Byte);
var
S: string;
begin
S := IntToStr(flatness) + ' i'#10;
WriteString(S);
end;
// SetLineCap
procedure TPdfCanvas.SetLineCap(linecap: TLineCapStyle);
var
S: string;
begin
S := IntToStr(ord(linecap)) + ' J'#10;
WriteString(S);
end;
// SetDash
procedure TPdfCanvas.SetDash(aarray: array of Byte; phase: Byte);
var
S: string;
i: integer;
begin
S := '[';
if (High(aarray) >= 0) and (aarray[0] <> 0) then
for i := 0 to High(aarray) do
S := S + IntToStr(aarray[i]) + ' ';
S := S + '] ' + IntToStr(phase) + ' d'#10;
WriteString(S);
end;
// SetLineJoin
procedure TPdfCanvas.SetLineJoin(linejoin: TLineJoinStyle);
var
S: string;
begin
S := IntToStr(ord(linejoin)) + ' j'#10;
WriteString(S);
end;
// SetLineWidth
procedure TPdfCanvas.SetLineWidth(linewidth: Single);
var
S: string;
begin
S := _FloatToStrR(linewidth) + ' w'#10;
WriteString(S);
end;
// SetMiterLimit
procedure TPdfCanvas.SetMiterLimit(miterlimit: Byte);
var
S: string;
begin
S := IntToStr(miterlimit) + ' M'#10;
WriteString(S);
end;
{* Paths *}
// MoveTo
procedure TPdfCanvas.MoveTo(x, y: Single);
var
S: string;
begin
S := _FloatToStrR(x) + ' ' + _FloatToStrR(y) + ' m'#10;
WriteString(S);
end;
// LineTo
procedure TPdfCanvas.LineTo(x, y: Single);
var
S: string;
begin
S := _FloatToStrR(x) + ' ' + _FloatToStrR(y) + ' l'#10;
WriteString(S);
end;
// CurveToC
procedure TPdfCanvas.CurveToC(x1, y1, x2, y2, x3, y3: Single);
var
S: string;
begin
S := _FloatToStrR(x1) + ' ' +
_FloatToStrR(y1) + ' ' +
_FloatToStrR(x2) + ' ' +
_FloatToStrR(y2) + ' ' +
_FloatToStrR(x3) + ' ' +
_FloatToStrR(y3) + ' c'#10;
WriteString(S);
end;
// CurveToV
procedure TPdfCanvas.CurveToV(x2, y2, x3, y3: Single);
var
S: string;
begin
S := _FloatToStrR(x2) + ' ' +
_FloatToStrR(y2) + ' ' +
_FloatToStrR(x3) + ' ' +
_FloatToStrR(y3) + ' v'#10;
WriteString(S);
end;
// CurveToY
procedure TPdfCanvas.CurveToY(x1, y1, x3, y3: Single);
var
S: string;
begin
S := _FloatToStrR(x1) + ' ' +
_FloatToStrR(y1) + ' ' +
_FloatToStrR(x3) + ' ' +
_FloatToStrR(y3) + ' y'#10;
WriteString(S);
end;
// Rectangle
procedure TPdfCanvas.Rectangle(x, y, width, height: Single);
var
S: string;
begin
S := _FloatToStrR(x) + ' ' +
_FloatToStrR(y) + ' ' +
_FloatToStrR(width) + ' ' +
_FloatToStrR(height) + ' re'#10;
WriteString(S);
end;
// Closepath
procedure TPdfCanvas.Closepath;
begin
WriteString('h'#10);
end;
// NewPath
procedure TPdfCanvas.NewPath;
begin
WriteString('n'#10);
end;
// Stroke
procedure TPdfCanvas.Stroke;
begin
WriteString('S'#10);
end;
// ClosePathStroke
procedure TPdfCanvas.ClosePathStroke;
begin
WriteString('s'#10);
end;
// Fill
procedure TPdfCanvas.Fill;
begin
WriteString('f'#10);
end;
// Eofill
procedure TPdfCanvas.Eofill;
begin
WriteString('f*'#10);
end;
// FillStroke
procedure TPdfCanvas.FillStroke;
begin
WriteString('B'#10);
end;
// ClosepathFillStroke
procedure TPdfCanvas.ClosepathFillStroke;
begin
WriteString('b'#10);
end;
// EofillStroke
procedure TPdfCanvas.EofillStroke;
begin
WriteString('B*'#10);
end;
// ClosepathEofillStroke
procedure TPdfCanvas.ClosepathEofillStroke;
begin
WriteString('b*'#10);
end;
// Clip
procedure TPdfCanvas.Clip;
begin
WriteString('W'#10);
end;
// Eoclip
procedure TPdfCanvas.Eoclip;
begin
WriteString('W*'#10);
end;
{* Test state *}
// SetCharSpace
procedure TPdfCanvas.SetCharSpace(charSpace: Single);
begin
if FAttr.CharSpace = charSpace then Exit;
FAttr.SetCharSpace(charSpace);
if Contents <> nil then
WriteString(_FloatToStrR(charSpace) + ' Tc'#10);
end;
// SetWordSpace
procedure TPdfCanvas.SetWordSpace(wordSpace: Single);
begin
if FAttr.WordSpace = wordSpace then Exit;
FAttr.SetWordSpace(wordSpace);
if Contents <> nil then
WriteString(_FloatToStrR(wordSpace) + ' Tw'#10);
end;
// SetHorizontalScaling
procedure TPdfCanvas.SetHorizontalScaling(hScaling: Word);
begin
if FAttr.HorizontalScaling = hScaling then Exit;
FAttr.SetHorizontalScaling(hScaling);
WriteString(IntToStr(hScaling) + ' Tz'#10);
end;
// SetLeading
procedure TPdfCanvas.SetLeading(leading: Single);
begin
if FAttr.Leading = leading then Exit;
FAttr.SetLeading(leading);
WriteString(_FloatToStrR(leading) + ' TL'#10);
end;
// SetFontAndSize
procedure TPdfCanvas.SetFontAndSize(fontname: string; size: Single);
var
S: string;
begin
S := fontname + ' ' +
_FloatToStrR(size) + ' Tf'#10;
WriteString(S);
end;
// SetTextRenderingMode
procedure TPdfCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
begin
WriteString(IntToStr(ord(mode)) + ' Tr'#10);
end;
// SetTextRise
procedure TPdfCanvas.SetTextRise(rise: Word);
begin
WriteString(IntToStr(rise) + ' Ts'#10);
end;
// BeginText
procedure TPdfCanvas.BeginText;
begin
WriteString('BT'#10);
end;
// EndText
procedure TPdfCanvas.EndText;
begin
WriteString('ET'#10);
end;
// MoveTextPoint
procedure TPdfCanvas.MoveTextPoint(tx, ty: Single);
var
S: string;
begin
S := _FloatToStrR(tx) + ' ' +
_FloatToStrR(ty) + ' Td'#10;
WriteString(S);
end;
// SetTextMatrix
procedure TPdfCanvas.SetTextMatrix(a, b, c, d, x, y: Single);
var
S: string;
begin
S := _FloatToStrR(a) + ' ' +
_FloatToStrR(b) + ' ' +
_FloatToStrR(c) + ' ' +
_FloatToStrR(d) + ' ' +
_FloatToStrR(x) + ' ' +
_FloatToStrR(y) + ' Tm'#10;
WriteString(S);
end;
// MoveToNextLine
procedure TPdfCanvas.MoveToNextLine;
begin
WriteString('T*'#10);
end;
// ShowText
procedure TPdfCanvas.ShowText(s: string);
var
FString: string;
begin
if _HasMultiByteString(s) then
FString := '<' + _StrToHex(s) + '>'
else
FString := '(' + _EscapeText(s) + ')';
WriteString(FString + ' Tj'#10);
end;
// ShowTextNextLine
procedure TPdfCanvas.ShowTextNextLine(s: string);
var
FString: string;
begin
if _HasMultiByteString(s) then
FString := '<' + _StrToHex(s) + '>'
else
FString := '(' + _EscapeText(s) + ')';
WriteString(FString + ' '''#10);
end;
{* external objects *}
// ExecuteXObject
procedure TPdfCanvas.ExecuteXObject(xObject: string);
var
S: string;
begin
S := '/' + xObject + ' Do'#10;
WriteString(S);
end;
{* Device-dependent color space operators *}
// SetRGBFillColor
procedure TPdfCanvas.SetRGBFillColor(Value: TPdfColor);
var
S: string;
begin
S := GetColorStr(Value) + ' rg'#10;
WriteString(S);
end;
// SetRGBStrokeColor
procedure TPdfCanvas.SetRGBStrokeColor(Value: TPdfColor);
var
S: string;
begin
S := GetColorStr(Value) + ' RG'#10;
WriteString(S);
end;
{ TPdfCanvas common routine }
// TextWidth
function TPdfCanvas.TextWidth(Text: string): Single;
begin
result := FAttr.TextWidth(Text);
end;
// MeasureText
function TPdfCanvas.MeasureText(Text: string; AWidth: Single): integer;
begin
result := FAttr.MeasureText(Text, AWidth);
end;
// Ellipse
procedure TPdfCanvas.Ellipse(x, y, width, height: Single);
begin
MoveTo(x, y+height/2);
CurveToC(x,
y+height/2-height/2*11/20,
x+width/2-width/2*11/20,
y,
x+width/2,
y);
CurveToC(x+width/2+width/2*11/20,
y,
x+width,
y+height/2-height/2*11/20,
x+width,
y+height/2);
CurveToC(x+width,
y+height/2+height/2*11/20,
x+width/2+width/2*11/20,
y+height,
x+width/2,
y+height);
CurveToC(x+width/2-width/2*11/20,
y+height,
x,
y+height/2+height/2*11/20,
x,
y+height/2);
end;
procedure TPdfCanvas.RoundRect(x, y, width, height, rx, ry: Single;
SqrCorners:TPdfCorners=[]);
var
h1,w1:single;
begin
if 2*rx>width then
rx := width/2;
if 2*ry>height then
ry := height/2;
h1 := ry*11/20;
w1 := rx*11/20;
MoveTo(x, y+ry);
if pcBottomLeft in SqrCorners then
LineTo(x, y)
else
CurveToC(x, y+ry-h1, x+rx-w1, y, x+rx, y);
LineTo(x+width-rx, y);
if pcBottomRight in SqrCorners then
LineTo(x+width, y)
else
CurveToC(x+width-rx+w1, y, x+width, y+ry-h1, x+width, y+ry);
LineTo(x+width, y+height-ry);
if pcTopRight in SqrCorners then
LineTo(x+width, y+height)
else
CurveToC(x+width, y+height-ry+h1, x+width-rx+w1, y+height, x+width-rx, y+height);
LineTo(x+rx, y+height);
if pcTopLeft in SqrCorners then
LineTo(x, y+height)
else
CurveToC(x+rx-w1, y+height, x, y+height-ry+h1, x, y+height-ry);
LineTo(x, y+ry);
end;
// GetNextWord
function TPdfCanvas.GetNextWord(const S: string;
var Index: integer): string;
var
ln: integer;
i: integer;
begin
// getting a word from text.
result := '';
ln := Length(S);
if Index > ln then
Exit;
i := Index;
while true do
if (S[i] = #10) and (S[i-1] = #13) or (S[i] = ' ') then
begin
result := Copy(S, Index, i - (Index -1));
break;
end
else
if i >= ln then
begin
result := Copy(S, Index, i - (Index - 1));
break;
end
{$IFDEF USE_JPFONTS}
else
if ByteType(S, i) = mbTrailByte then
if ((Copy(S, i+1, 2) <> #129#66) and
(Copy(S, i+1, 2) <> #129#65)) then
begin
result := Copy(S, Index, i - (Index - 1));
break;
end
else
inc(i)
else
if ((i < ln) and (ByteType(S, i + 1) = mbLeadByte)) then
begin
result := Copy(S, Index, i - (Index - 1));
break;
end
{$ENDIF}
else
inc(i);
Index := i + 1;
end;
procedure TPdfCanvas.TextOutRotatedUp(X, Y: Single; Text: string);
begin
BeginText;
SetTextMatrix(0, 1, -1, 0, X, Y); // down to up
ShowText(Text);
EndText;
end;
// GetDoc
function TPdfCanvas.GetDoc: TPdfDoc;
begin
result := nil;
if FPdfDoc <> nil then
result := FPdfDoc
else
EPdfInvalidOperation.Create('ERROR: GetDoc documant is nil.');
end;
{ TPdfDictionaryWrapper }
// SetData
procedure TPdfDictionaryWrapper.SetData(AData: TPdfDictionary);
begin
FData := AData;
end;
// GetHasData
function TPdfDictionaryWrapper.GetHasData: boolean;
begin
result := (FData = nil);
end;
{ TPdfInfo }
// SetAuthor
procedure TPdfInfo.SetAuthor(Value: string);
begin
FData.AddItem('Author', TPdfText.CreateText(Value));
end;
// SetCreationDate
procedure TPdfInfo.SetCreationDate(Value: TDateTime);
begin
FData.AddItem('CreationDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
end;
// SetModDate
procedure TPdfInfo.SetModDate(Value: TDateTime);
begin
FData.AddItem('ModDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
end;
// SetCreator
procedure TPdfInfo.SetCreator(Value: string);
begin
FData.AddItem('Creator', TPdfText.CreateText(Value));
end;
// SetTitle
procedure TPdfInfo.SetTitle(Value: string);
begin
FData.AddItem('Title', TPdfText.CreateText(Value));
end;
// SetSubject
procedure TPdfInfo.SetSubject(Value: string);
begin
FData.AddItem('Subject', TPdfText.CreateText(Value));
end;
// SetKeywords
procedure TPdfInfo.SetKeywords(Value: string);
begin
FData.AddItem('Keywords', TPdfText.CreateText(Value));
end;
// GetAuthor
function TPdfInfo.GetAuthor: string;
begin
if FData.ValueByName('Author') <> nil then
result := FData.PdfTextByName('Author').Value
else
result := '';
end;
// GetCreationDate
function TPdfInfo.GetCreationDate: TDateTime;
begin
if FData.ValueByName('CreationDate') <> nil then
try
result := _PdfDateToDateTime(FData.PdfTextByName('CreationDate').Value);
except
result := 0;
end
else
result := 0;
end;
// GetModDate
function TPdfInfo.GetModDate: TDateTime;
begin
if FData.ValueByName('ModDate') <> nil then
try
result := _PdfDateToDateTime(FData.PdfTextByName('ModDate').Value);
except
result := 0;
end
else
result := 0;
end;
// GetCreator
function TPdfInfo.GetCreator: string;
begin
if FData.ValueByName('Creator') <> nil then
result := FData.PdfTextByName('Creator').Value
else
result := '';
end;
// GetTitle
function TPdfInfo.GetTitle: string;
begin
if FData.ValueByName('Title') <> nil then
result := FData.PdfTextByName('Title').Value
else
result := '';
end;
// GetSubject
function TPdfInfo.GetSubject: string;
begin
if FData.ValueByName('Subject') <> nil then
result := FData.PdfTextByName('Subject').Value
else
result := '';
end;
// GetKeywords
function TPdfInfo.GetKeywords: string;
begin
if FData.ValueByName('Keywords') <> nil then
result := FData.PdfTextByName('Keywords').Value
else
result := '';
end;
{ TPdfCatalog }
// SaveOpenAction
procedure TPdfCatalog.SaveOpenAction;
begin
if (FOpenAction = nil) then
FData.RemoveItem('OpenAction')
else
FData.AddItem('OpenAction', FOpenAction.GetValue);
end;
// SetPageLayout
procedure TPdfCatalog.SetPageLayout(Value: TPdfPageLayout);
var
FPageLayout: TPdfName;
begin
FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
FData.AddItem('PageLayout', TPdfName.CreateName(PDF_PAGE_LAYOUT_NAMES[Ord(Value)]))
else
FPageLayout.Value := PDF_PAGE_LAYOUT_NAMES[Ord(Value)];
end;
// GetPageLayout
function TPdfCatalog.GetPageLayout: TPdfPageLayout;
var
FPageLayout: TPdfName;
S: string;
i: integer;
begin
result := plSinglePage;
FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
Exit
else
begin
S := FPageLayout.Value;
for i := 0 to High(PDF_PAGE_LAYOUT_NAMES) do
if PDF_PAGE_LAYOUT_NAMES[i] = S then
begin
result := TPdfPageLayout(i);
Break;
end;
end;
end;
function TPdfCatalog.GetNonFullScreenPageMode: TPdfPageMode;
var
FDictionary: TPdfDictionary;
FPageMode: TPdfName;
S: string;
i: integer;
begin
result := pmUseNone;
FDictionary := TPdfDictionary(FData.ValueByName('NonFullScreenPageMode'));
if FDictionary = nil then
Exit;
FPageMode := TPdfName(FDictionary.ValueByName('NonFullScreenPageMode'));
if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
Exit;
S := FPageMode.Value;
for i := 0 to High(PDF_PAGE_MODE_NAMES) do
if PDF_PAGE_MODE_NAMES[i] = S then
begin
result := TPdfPageMode(i);
Break;
end;
end;
function TPdfCatalog.GetViewerPreference: TPdfViewerPreferences;
var
FDictionary: TPdfDictionary;
FValue: TPdfBoolean;
begin
result := [];
FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreference'));
if FDictionary = nil then
Exit;
FValue := FData.PdfBooleanByName('HideToolbar');
if (FValue <> nil) or FValue.Value then
result := result + [vpHideToolbar];
FValue := FData.PdfBooleanByName('HideMenubar');
if (FValue <> nil) or FValue.Value then
result := result + [vpHideMenubar];
FValue := FData.PdfBooleanByName('HideWindowUI');
if (FValue <> nil) or FValue.Value then
result := result + [vpHideWindowUI];
FValue := FData.PdfBooleanByName('FitWindow');
if (FValue <> nil) or FValue.Value then
result := result + [vpFitWindow];
FValue := FData.PdfBooleanByName('CenterWindow');
if (FValue <> nil) or FValue.Value then
result := result + [vpCenterWindow];
end;
// SetPageMode
procedure TPdfCatalog.SetPageMode(Value: TPdfPageMode);
var
FPageMode: TPdfName;
begin
FPageMode := TPdfName(FData.ValueByName('PageMode'));
if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
FData.AddItem('PageMode', TPdfName.CreateName(PDF_PAGE_MODE_NAMES[Ord(Value)]))
else
FPageMode.Value := PDF_PAGE_MODE_NAMES[Ord(Value)];
end;
procedure TPdfCatalog.SetNonFullScreenPageMode(Value: TPdfPageMode);
var
FDictionary: TPdfDictionary;
FPageMode: TPdfName;
begin
FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreferences'));
if FDictionary = nil then
begin
FDictionary := TPdfDictionary.CreateDictionary(Data.ObjectMgr);
Data.AddItem('ViewerPreferences', FDictionary);
end;
// if Value is pmFullScreen, remove 'PageMode' element(use default value).
if (Value = pmFullScreen) or (Value = pmUseNone) then
FDictionary.RemoveItem('NonFullScreenPageMode')
else
begin
FPageMode := TPdfName(FDictionary.ValueByName('NonFullScreenPageMode'));
if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
FDictionary.AddItem('NonFullScreenPageMode',
TPdfName.CreateName(PDF_PAGE_MODE_NAMES[Ord(Value)]))
else
FPageMode.Value := PDF_PAGE_MODE_NAMES[Ord(Value)];
end;
end;
procedure TPdfCatalog.SetViewerPreference(Value: TPdfViewerPreferences);
var
FDictionary: TPdfDictionary;
begin
FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreferences'));
if (FDictionary = nil) and (Value <> []) then
begin
FDictionary := TPdfDictionary.CreateDictionary(Data.ObjectMgr);
FData.AddItem('ViewerPreferences', FDictionary);
end;
if (vpHideToolbar in Value) then
FDictionary.AddItem('HideToolbar', TPdfBoolean.CreateBoolean(true))
else
FDictionary.RemoveItem('HideToolbar');
if (vpHideMenubar in Value) then
FDictionary.AddItem('HideMenubar', TPdfBoolean.CreateBoolean(true))
else
FDictionary.RemoveItem('HideMenubar');
if (vpHideWindowUI in Value) then
FDictionary.AddItem('HideWindowUI', TPdfBoolean.CreateBoolean(true))
else
FDictionary.RemoveItem('HideWindowUI');
if (vpFitWindow in Value) then
FDictionary.AddItem('FitWindow', TPdfBoolean.CreateBoolean(true))
else
FDictionary.RemoveItem('FitWindow');
if (vpCenterWindow in Value) then
FDictionary.AddItem('CenterWindow', TPdfBoolean.CreateBoolean(true))
else
FDictionary.RemoveItem('CenterWindow');
end;
// GetPageMode
function TPdfCatalog.GetPageMode: TPdfPageMode;
var
FPageMode: TPdfName;
S: string;
i: integer;
begin
result := pmUseNone;
FPageMode := TPdfName(FData.ValueByName('PageMode'));
if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
Exit
else
begin
S := FPageMode.Value;
for i := 0 to High(PDF_PAGE_MODE_NAMES) do
if PDF_PAGE_MODE_NAMES[i] = S then
begin
result := TPdfPageMode(i);
Break;
end;
end;
end;
// GetPages
function TPdfCatalog.GetPages: TPdfDictionary;
begin
result := TPdfDictionary(FData.ValueByName('Pages'));
if result = nil then
raise EPdfInvalidOperation.Create('GetPages --page object is null..');
end;
// SetPages
procedure TPdfCatalog.SetPages(APage: TPdfDictionary);
begin
if _GetTypeOf(APage) = 'Pages' then
FData.AddItem('Pages', APage);
end;
{ TPdfFont }
// AddStrElements
procedure TPdfFont.AddStrElements(ADic: TPdfDictionary;
ATable: array of TPDF_STR_TBL);
var
i: integer;
begin
{ utility routine for making font dictinary. }
for i := 0 to High(ATable) do
ADic.AddItem(ATable[i].KEY, TPdfName.CreateName(ATable[i].VAL));
end;
// AddIntElements
procedure TPdfFont.AddIntElements(ADic: TPdfDictionary;
ATable: array of TPDF_INT_TBL);
var
i: integer;
begin
{ utility routine for making font dictionary. }
for i := 0 to High(ATable) do
ADic.AddItem(ATable[i].KEY, TPdfNumber.CreateNumber(ATable[i].VAL));
end;
// GetCharWidth
function TPdfFont.GetCharWidth(AText: string; APos: integer): integer;
begin
result := 0;
end;
// Create
constructor TPdfFont.Create(AXref: TPdfXref; AName: string);
begin
inherited Create;
FName := AName;
FUnderlinePosition := -150;
FUnderlineThickness := 50;
end;
{ PdfDestination }
// Create
constructor TPdfDestination.Create(APdfDoc: TPdfDoc);
var
i: integer;
begin
inherited Create;
FDoc := APdfDoc;
if (FDoc = nil) or (not FDoc.HasDoc) then
raise EPdfInvalidOperation.Create('TPdfDestination --cannot destination object.');
FPage := FDoc.Canvas.Page;
for i := 0 to 4 do
FValues[i] := 0;
FZoom := 1;
end;
// Destroy
destructor TPdfDestination.Destroy;
begin
if FReference <> nil then
FReference.Free;
inherited;
end;
// GetElement
function TPdfDestination.GetElement(Index: integer): Integer;
begin
result := FValues[Index];
end;
// SetElement
procedure TPdfDestination.SetElement(Index: integer; Value: Integer);
begin
if FValues[Index] <> Value then
if Value < 0 then
FValues[Index] := -1
else
FValues[Index] := Value;
end;
// SetZoom
procedure TPdfDestination.SetZoom(Value: Single);
begin
if Value <> FZoom then
if Value < 0 then
raise EPdfInvalidValue.Create('Zoom property cannot set to under 0.')
else
if Value > PDF_MAX_ZOOMSIZE then
raise EPdfInvalidValue.CreateFmt('Zoom property cannot set to over %d.', [PDF_MAX_ZOOMSIZE])
else
FZoom := Value;
end;
// GetPageWidth
function TPdfDestination.GetPageWidth: Integer;
var
FMediaBox: TPdfArray;
begin
FMediaBox := FPage.PdfArrayByName('MediaBox');
if FMediaBox <> nil then
result := TPdfNumber(FMediaBox.Items[2]).Value
else
result := FDoc.DefaultPageWidth;
end;
// GetPageHeight
function TPdfDestination.GetPageHeight: Integer;
var
FMediaBox: TPdfArray;
begin
FMediaBox := FPage.PdfArrayByName('MediaBox');
if FMediaBox <> nil then
result := TPdfNumber(FMediaBox.Items[3]).Value
else
result := FDoc.DefaultPageHeight;
end;
// GetValue
function TPdfDestination.GetValue: TPdfArray;
const
DEST_MAX_VALUE = 100;
begin
// create TPdfArray object from the specified values.
// the values which are not used are ignored.
result := TPdfArray.CreateArray(FDoc.FXref);
with result do
begin
AddItem(FPage);
AddItem(TPdfName.CreateName(PDF_DESTINATION_TYPE_NAMES[ord(FType)]));
case FType of
// if the type is dtXYZ, only Left, Top and Zoom values are used,
// other properties are ignored.
dtXYZ:
begin
if FValues[0] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Left))
else
AddItem(TPdfNull.Create);
if FValues[1] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Top))
else
AddItem(TPdfNull.Create);
if FZoom < 0 then
FZoom := 0;
AddItem(TPdfReal.CreateReal(FZoom));
end;
// if the type is dtFitR, all values except Zoom are used.
dtFitR:
begin
if FValues[0] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Left))
else
AddItem(TPdfNull.Create);
if FValues[1] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Bottom))
else
AddItem(TPdfNull.Create);
if FValues[2] >= 0 then
AddItem(TPdfNumber.CreateNumber(Right))
else
AddItem(TPdfNull.Create);
if FValues[3] >= 0 then
AddItem(TPdfNumber.CreateNumber(Top))
else
AddItem(TPdfNull.Create);
end;
// if the type is dtFitH or dtFitBH, only Top property is used.
dtFitH, dtFitBH:
if FValues[1] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Top))
else
AddItem(TPdfNull.Create);
// if the type is dtFitV or dtFitBV, only Top property is used.
dtFitV, dtFitBV:
if FValues[0] >= -DEST_MAX_VALUE then
AddItem(TPdfNumber.CreateNumber(Left))
else
AddItem(TPdfNull.Create);
end;
end;
end;
{ TPdfOutlineEntry }
// CreateEntry
constructor TPdfOutlineEntry.CreateEntry(AParent: TPdfOutlineEntry);
begin
inherited Create;
if AParent = nil then
Raise Exception.Create('CreateEntry --invalid parent.');
FParent := AParent;
FCount := 0;
FDoc := AParent.Doc;
Data := TPdfDictionary.CreateDictionary(FDoc.FXref);
FDoc.FXref.AddObject(Data);
FDoc.FObjectList.Add(Self);
end;
// Destroy
destructor TPdfOutlineEntry.Destroy;
begin
if FReference <> nil then
FReference.Free;
inherited;
end;
// AddChild
function TPdfOutlineEntry.AddChild: TPdfOutlineEntry;
var
TmpEntry: TPdfOutlineEntry;
begin
// increment Count variable recursive.
inc(FCount);
TmpEntry := Parent;
while TmpEntry <> nil do
begin
TmpEntry.FCount := TmpEntry.FCount + 1;
TmpEntry := TmpEntry.Parent;
end;
result := TPdfOutlineEntry.CreateEntry(Self);
if FFirst = nil then
FFirst := Result;
if FLast <> nil then
FLast.FNext := Result;
Result.FPrev := FLast;
FLast := Result;
end;
// Save
procedure TPdfOutlineEntry.Save;
begin
if Opened then
Data.AddItem('Count', TPdfNumber.CreateNumber(FCount))
else
Data.AddItem('Count', TPdfNumber.CreateNumber(-FCount));
Data.AddItem('Title', TPdfText.CreateText(FTitle));
if FDest <> nil then
Data.AddItem('Dest', FDest.GetValue);
if FFirst <> nil then
begin
Data.AddItem('First', FFirst.Data);
FFirst.Save;
end;
if FLast <> nil then
Data.AddItem('Last', FLast.Data);
if FPrev <> nil then
Data.AddItem('Prev', FPrev.Data);
if FNext <> nil then
begin
Data.AddItem('Next', FNext.Data);
FNext.Save;
end;
end;
{ TPdfOutlineRoot }
// CreateRoot
constructor TPdfOutlineRoot.CreateRoot(ADoc: TPdfDoc);
begin
inherited Create;
FCount := 0;
FDoc := ADoc;
FOpened := true;
Data := TPdfDictionary.CreateDictionary(ADoc.FXref);
FDoc.FXref.AddObject(Data);
with Data do
AddItem('Type', TPdfName.CreateName('Outlines'));
FDoc.FObjectList.Add(Self);
end;
// Save
procedure TPdfOutlineRoot.Save;
begin
if Opened then
Data.AddItem('Count', TPdfNumber.CreateNumber(FCount))
else
Data.AddItem('Count', TPdfNumber.CreateNumber(-FCount));
if FFirst <> nil then
begin
Data.AddItem('First', FFirst.Data);
FFirst.Save;
end;
if FLast <> nil then
Data.AddItem('Last', FLast.Data);
end;
end.