Skip to content

/ mORMot

Permalink
master
Switch branches/tags

mORMot/SynPdf.pas

Go to file
 
 
Cannot retrieve contributors at this time
11054 lines (10284 sloc) 395 KB
Raw Blame
/// PDF file generation
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynPdf;
{
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2021 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2021
the Initial Developer. All Rights Reserved.
Contributor(s):
Achim Kalwa
Alexander (chaa)
aweste
CoMPi
Damien (ddemars)
David Mead (MDW)
David Heffernan
FalconB
Florian Grummel
Harald Simon
Josh Kelley (joshkel)
Karel (vandrovnik)
Kukhtin Igor
LoukaO
Marsh
MChaos
Mehrdad Momeni (nosa)
mogulza
Nzsolt
Ondrej (reddwarf)
Pierre le Riche
Sinisa (sinisav)
Sundazer
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
Sponsors: https://synopse.info/fossil/wiki?name=HelpDonate
Ongoing development and maintenance of the SynPDF library was sponsored
in part by:
https://www.helpndoc.com
Easy to use yet powerful help authoring environment which can generate
various documentation formats from a single source.
Thanks for your contribution!
}
{$I Synopse.inc} // define HASINLINE CPU32 CPU64
{$ifndef MSWINDOWS}
{ disable features requiring OS specific APIs
- until they are implemented }
{$define NO_USE_SYNGDIPLUS}
{$define NO_USE_UNISCRIBE}
{$define NO_USE_METAFILE}
{$define NO_USE_BITMAP}
{$endif}
{$define USE_PDFSECURITY}
{ - if defined, the TPdfDocument*.Create() constructor will have an additional
AEncryption: TPdfEncryption parameter able to create secured PDF files
- this feature will link the SynCrypto unit for MD5 and RC4 algorithms }
{$ifdef NO_USE_PDFSECURITY}
{ this special conditional can be set globaly for an application which doesn't
need the security features, therefore dependency to SynCrypto unit }
{$undef USE_PDFSECURITY}
{$endif}
{$define USE_UNISCRIBE}
{ - if defined, the PDF engine will use the Windows Uniscribe API to
render Ordering and Shaping of the text (useful for Hebrew, Arabic and
some Asiatic languages)
- this feature need the TPdfDocument.UseUniscribe property to be forced to true
according to the language of the text you want to render
- can be undefined to safe some KB if you're sure you won't need it }
{$ifdef NO_USE_UNISCRIBE}
{ this special conditional can be set globaly for an application which doesn't
need the UniScribe features }
{$undef USE_UNISCRIBE}
{$endif}
{$define USE_SYNGDIPLUS}
{ - if defined, the PDF engine will use SynGdiPlus to handle all
JPG, TIF, PNG and GIF image types (prefered way, but need XP or later OS)
- if you'd rather use the default jpeg unit (and add some more code to your
executable), undefine this conditional }
{$ifdef NO_USE_SYNGDIPLUS}
{ this special conditional can be set globaly for an application which doesn't
need the SynGdiPlus features (like TMetaFile drawing), and would rather
use the default jpeg unit }
{$undef USE_SYNGDIPLUS}
{$endif}
{$define USE_SYNZIP}
{ - if defined, the PDF engine will use SynZip to handle the ZIP/deflate
compression schema (this unit is faster than the default ZLib unit,
and used by other units of the framework)
- if you'd rather use the default ZLib unit (and add some more code to your
executable), undefine this conditional }
{$ifdef NO_USE_SYNZIP}
{ this special conditional can be set globaly for an application for which
standard ZLib unit is enough (not to be used with a mORMot application) }
{$undef USE_SYNZIP}
{$endif}
{$define USE_BITMAP}
{ - if defined, the PDF engine will support TBitmap
- it would induce a dependency to the VCL.Graphics unit }
{$ifdef NO_USE_BITMAP}
{ this special conditional can be set globaly for an application which doesn't
need the TBitmap features }
{$undef USE_BITMAP}
{$endif}
{$define USE_METAFILE}
{ - if defined, the PDF engine will support TMetaFile/TMetaFileCanvas
- it would induce a dependency to the VCL.Graphics unit }
{$ifdef NO_USE_METAFILE}
{ this special conditional can be set globaly for an application which doesn't
need the TMetaFile features }
{$undef USE_METAFILE}
{$endif}
{$define USE_ARC}
{ - if defined, the PDF engine will support ARC, inducing a dependency to Math.pas }
{$ifdef NO_USE_ARC}
{$undef USE_ARC}
{$endif}
{$ifdef USE_BITMAP}
{$define USE_GRAPHICS_UNIT}
{$endif}
{$ifdef USE_METAFILE}
{$define USE_GRAPHICS_UNIT}
{$endif}
interface
uses
{$ifdef MSWINDOWS}
Windows,
WinSpool,
{$ifdef USE_GRAPHICS_UNIT}
{$ifdef ISDELPHIXE2}
VCL.Graphics,
{$else}
Graphics,
{$endif}
{$endif}
{$endif MSWINDOWS}
{$ifdef USE_SYNGDIPLUS}
SynGdiPlus, // use our GDI+ library for handling TJpegImage and such
{$else}
jpeg,
{$endif}
SysConst,
SysUtils,
Classes,
{$ifdef USE_ARC}
Math,
{$endif}
{$ifdef ISDELPHIXE3}
System.Types,
System.AnsiStrings,
{$else}
{$ifdef HASINLINE}
Types,
{$endif}
{$endif}
{$ifdef USE_SYNZIP}
SynZip,
{$else}
ZLib,
{$endif}
{$ifdef USE_PDFSECURITY}
SynCrypto,
{$endif}
SynCommons,
SynLZ;
const
MWT_IDENTITY = 1;
MWT_LEFTMULTIPLY = 2;
MWT_RIGHTMULTIPLY = 3;
MWT_SET = 4;
{$NODEFINE MWT_IDENTITY}
{$NODEFINE MWT_LEFTMULTIPLY}
{$NODEFINE MWT_RIGHTMULTIPLY}
{ some low-level record definition for True Type format table reading }
type
PSmallIntArray = ^TSmallIntArray;
TSmallIntArray = array[byte] of SmallInt;
PPointArray = ^TPointArray;
TPointArray = array[word] of TPoint;
PSmallPointArray = ^TSmallPointArray;
TSmallPointArray = array[word] of TSmallPoint;
/// The 'cmap' table begins with an index containing the table version number
// followed by the number of encoding tables. The encoding subtables follow.
TCmapHeader = packed record
/// Version number (Set to zero)
version: word;
/// Number of encoding subtables
numberSubtables: word;
end;
/// points to every 'cmap' encoding subtables
TCmapSubTableArray = packed array[byte] of packed record
/// Platform identifier
platformID: word;
/// Platform-specific encoding identifier
platformSpecificID: word;
/// Offset of the mapping table
offset: Cardinal;
end;
/// The 'hhea' table contains information needed to layout fonts whose
// characters are written horizontally, that is, either left to right or
// right to left
TCmapHHEA = packed record
version: longint;
ascent: word;
descent: word;
lineGap: word;
advanceWidthMax: word;
minLeftSideBearing: word;
minRightSideBearing: word;
xMaxExtent: word;
caretSlopeRise: SmallInt;
caretSlopeRun: SmallInt;
caretOffset: SmallInt;
reserved: Int64;
metricDataFormat: SmallInt;
numOfLongHorMetrics: word;
end;
/// The 'head' table contains global information about the font
TCmapHEAD = packed record
version: longint;
fontRevision: longint;
checkSumAdjustment: cardinal;
magicNumber: cardinal;
flags: word;
unitsPerEm: word;
createdDate: Int64;
modifiedDate: Int64;
xMin: SmallInt;
yMin: SmallInt;
xMax: SmallInt;
yMax: SmallInt;
macStyle: word;
lowestRec: word;
fontDirection: SmallInt;
indexToLocFormat: SmallInt;
glyphDataFormat: SmallInt
end;
/// header for the 'cmap' Format 4 table
// - this is a two-byte encoding format
TCmapFmt4 = packed record
format: word;
length: word;
language: word;
segCountX2: word;
searchRange: word;
entrySelector: word;
rangeShift: word;
end;
type
/// the PDF library use internaly AnsiString text encoding
// - the corresponding charset is the current system charset, or the one
// supplied as a parameter to TPdfDocument.Create
PDFString = AnsiString;
/// a PDF date, encoded as 'D:20100414113241'
TPdfDate = PDFString;
/// the internal pdf file format
TPdfFileFormat = (pdf13, pdf14, pdf15, pdf16);
/// PDF exception, raised when an invalid value is given to a constructor
EPdfInvalidValue = class(Exception);
/// PDF exception, raised when an invalid operation is triggered
EPdfInvalidOperation = class(Exception);
/// Page mode determines how the document should appear when opened
TPdfPageMode = (
pmUseNone, pmUseOutlines, pmUseThumbs, pmFullScreen);
/// 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 border style of an annotation
TPdfAnnotationBorder = (
abSolid, abDashed, abBeveled, abInset, abUnderline);
/// Destination Type determines default user space coordinate system of
// Explicit destinations
TPdfDestinationType = (
dtXYZ, dtFit, dtFitH, dtFitV, dtFitR, dtFitB, dtFitBH, dtFitBV);
/// The page layout to be used when the document is opened
TPdfPageLayout = (
plSinglePage, plOneColumn, plTwoColumnLeft, plTwoColumnRight);
/// Viewer preferences specifying how the reader User Interface must start
// - vpEnforcePrintScaling will set the file version to be PDF 1.6
TPdfViewerPreference = (
vpHideToolbar, vpHideMenubar, vpHideWindowUI, vpFitWindow, vpCenterWindow,
vpEnforcePrintScaling);
/// set of Viewer preferences
TPdfViewerPreferences = set of TPdfViewerPreference;
/// available known paper size (psA4 is the default on TPdfDocument creation)
TPDFPaperSize = (
psA4, psA5, psA3, psA2, psA1, psA0, psLetter, psLegal, psUserDefined);
/// define if streams must be compressed
TPdfCompressionMethod = (
cmNone, cmFlateDecode);
/// the available PDF color range
TPdfColor = -$7FFFFFFF-1..$7FFFFFFF;
/// the PDF color, as expressed in RGB terms
// - maps COLORREF / TColorRef as used e.g. under windows
TPdfColorRGB = cardinal;
/// the recognized families of the Standard 14 Fonts
TPdfFontStandard = (pfsTimes, pfsHelvetica, pfsCourier);
/// numerical ID for every XObject
TXObjectID = integer;
const
/// used for an used xref entry
PDF_IN_USE_ENTRY = 'n';
/// used for an unused (free) xref entry, e.g. the root entry
PDF_FREE_ENTRY = 'f';
/// used e.g. for the root xref entry
PDF_MAX_GENERATION_NUM = 65535;
PDF_ENTRY_CLOSED = 0;
PDF_ENTRY_OPENED = 1;
/// the Carriage Return and Line Feed values used in the PDF file generation
// - expect #13 and #10 under Windows, but #10 (e.g. only Line Feed) is enough
// for the PDF standard, and will create somewhat smaller PDF files
CRLF = #10;
/// the Line Feed value
LF = #10;
PDF_MIN_HORIZONTALSCALING = 10;
PDF_MAX_HORIZONTALSCALING = 300;
PDF_MAX_WORDSPACE = 300;
PDF_MIN_CHARSPACE = -30;
PDF_MAX_CHARSPACE = 300;
PDF_MAX_FONTSIZE = 2000;
PDF_MAX_ZOOMSIZE = 10;
PDF_MAX_LEADING = 300;
/// list of common fonts available by default since Windows 2000
// - to not embedd these fonts in the PDF document, and save some KB,
// just use the EmbeddedTTFIgnore property of TPdfDocument/TPdfDocumentGDI:
// ! PdfDocument.EmbeddedTTFIgnore.Text := MSWINDOWS_DEFAULT_FONTS;
// - note that this is useful only if the EmbeddedTTF property was set to TRUE
MSWINDOWS_DEFAULT_FONTS: RawUTF8 =
'Arial'#13#10'Courier New'#13#10'Georgia'#13#10+
'Impact'#13#10'Lucida Console'#13#10'Roman'#13#10'Symbol'#13#10+
'Tahoma'#13#10'Times New Roman'#13#10'Trebuchet'#13#10+
'Verdana'#13#10'WingDings';
type
/// PDF text paragraph alignment
TPdfAlignment = (paLeftJustify, paRightJustify, paCenter);
/// PDF gradient direction
TGradientDirection = (gdHorizontal, gdVertical);
/// a PDF coordinates rectangle
TPdfRect = record
Left, Top, Right, Bottom: Single;
end;
PPdfRect = ^TPdfRect;
/// a PDF coordinates box
TPdfBox = record
Left, Top, Width, Height: Single;
end;
PPdfBox = ^TPdfBox;
/// allowed types for PDF objects (i.e. TPdfObject)
TPdfObjectType = (otDirectObject, otIndirectObject, otVirtualObject);
TPdfObject = class;
TPdfCanvas = class;
TPdfFont = class;
TPdfFontTrueType = class;
TPdfDocument = class;
{$ifdef USE_PDFSECURITY}
/// the available encryption levels
// - in current version only RC4 40-bit and RC4 128-bit are available, which
// correspond respectively to PDF 1.3 and PDF 1.4 formats
// - for RC4 40-bit and RC4 128-bit, associated password are restricted to a
// maximum length of 32 characters and could contain only characters from the
// Latin-1 encoding (i.e. no accent)
TPdfEncryptionLevel = (elNone, elRC4_40, elRC4_128);
/// PDF can encode various restrictions on document operations which can be
// granted or denied individually (some settings depend on others, though):
// - Printing: If printing is not allowed, the print button in Acrobat will be
// disabled. Acrobat supports a distinction between high-resolution and
// low-resolution printing. Low-resolution printing generates a bitmapped
// image of the page which is suitable only for personal use, but prevents
// high-quality reproduction and re-distilling. Note that bitmap printing
// not only results in low output quality, but will also considerably slow
// down the printing process.
// - General Editing: If this is disabled, any document modification is
// prohibited. Content extraction and printing are allowed.
// - Content Copying and Extraction: If this is disabled, selecting document
// contents and copying it to the clipboard for repurposing the contents is
// prohibited. The accessibility interface also is disabled. If you need to
// search such documents with Acrobat you must select the Certified Plugins
// Only preference in Acrobat.
// - Authoring Comments and Form Fields: If this is disabled, adding,
// modifying, or deleting comments and form fields is prohibited. Form field
// filling is allowed.
// - Form Field Fill-in or Signing: If this is enabled, users can sign and
// fill in forms, but not create form fields.
// - Document Assembly: If this is disabled, inserting, deleting or rotating
// pages, or creating bookmarks and thumbnails is prohibited.
TPdfEncryptionPermission = (epPrinting, epGeneralEditing, epContentCopy,
epAuthoringComment, epFillingForms, epContentExtraction,
epDocumentAssembly, epPrintingHighResolution);
/// set of restrictions on PDF document operations
TPdfEncryptionPermissions = set of TPdfEncryptionPermission;
/// abstract class to handle PDF security
TPdfEncryption = class
protected
fLevel: TPdfEncryptionLevel;
fFlags: integer;
fInternalKey: TByteDynArray;
fPermissions: TPdfEncryptionPermissions;
fUserPassword: string;
fOwnerPassword: string;
fDoc: TPdfDocument;
procedure EncodeBuffer(const BufIn; var BufOut; Count: cardinal); virtual; abstract;
public
/// initialize the internal structures with the proper classes
// - do not call this method directly, but class function TPdfEncryption.New()
constructor Create(aLevel: TPdfEncryptionLevel; aPermissions: TPdfEncryptionPermissions;
const aUserPassword, aOwnerPassword: string); virtual;
/// prepare a specific document to be encrypted
// - internally used by TPdfDocument.NewDoc method
procedure AttachDocument(aDoc: TPdfDocument); virtual;
/// will create the expected TPdfEncryption instance, depending on aLevel
// - to be called as parameter of TPdfDocument/TPdfDocumentGDI.Create()
// - currently, only elRC4_40 and elRC4_128 levels are implemented
// - both passwords are expected to be ASCII-7 characters only
// - aUserPassword will be asked at file opening: to be set to '' for not
// blocking display, but optional permission
// - aOwnerPassword shall not be '', and will be used internally to cypher
// the pdf file content
// - aPermissions can be either one of the PDF_PERMISSION_ALL /
// PDF_PERMISSION_NOMODIF / PDF_PERSMISSION_NOPRINT / PDF_PERMISSION_NOCOPY /
// PDF_PERMISSION_NOCOPYNORPRINT set of options
// - typical use may be:
// ! Doc := TPdfDocument.Create(false,0,false,
// ! TPdfEncryption.New(elRC4_40,'','toto',PDF_PERMISSION_NOMODIF));
// ! Doc := TPdfDocument.Create(false,0,false,
// ! TPdfEncryption.New(elRC4_128,'','toto',PDF_PERMISSION_NOCOPYNORPRINT));
class function New(aLevel: TPdfEncryptionLevel;
const aUserPassword, aOwnerPassword: string;
aPermissions: TPdfEncryptionPermissions): TPdfEncryption;
end;
/// internal 32 bytes buffer, used during encryption process
TPdfBuffer32 = array[0..31] of byte;
/// handle PDF security with RC4+MD5 scheme in 40-bit and 128-bit
// - allowed aLevel parameters for Create() are only elRC4_40 and elRC4_128
TPdfEncryptionRC4MD5 = class(TPdfEncryption)
protected
fLastObjectNumber: integer;
fLastGenerationNumber: Integer;
fUserPass, fOwnerPass: TPdfBuffer32;
fLastRC4Key: TRC4;
procedure EncodeBuffer(const BufIn; var BufOut; Count: cardinal); override;
public
/// prepare a specific document to be encrypted
// - will compute the internal keys
procedure AttachDocument(aDoc: TPdfDocument); override;
end;
{$endif USE_PDFSECURITY}
/// buffered writer class, specialized for PDF encoding
TPdfWrite = class
protected
B, BEnd, BEnd4: PAnsiChar;
fDestStream: TStream;
fDestStreamPosition: integer;
fCodePage: integer;
fAddGlyphFont: (fNone, fMain, fFallBack);
fDoc: TPdfDocument;
Tmp: array[0..511] of AnsiChar;
/// internal Ansi->Unicode conversion, using the CodePage used in Create()
// - caller must release the returned memory via FreeMem()
function ToWideChar(const Ansi: PDFString; out DLen: Integer): PWideChar;
{$ifdef USE_UNISCRIBE}
/// internal method using the Windows Uniscribe API
// - return FALSE if PW was not appened to the PDF content, TRUE if OK
function AddUnicodeHexTextUniScribe(PW: PWideChar; WinAnsiTTF: TPdfFontTrueType;
NextLine: boolean; Canvas: TPdfCanvas): boolean;
{$endif}
/// internal method NOT using the Windows Uniscribe API
procedure AddUnicodeHexTextNoUniScribe(PW: PWideChar; TTF: TPdfFontTrueType;
NextLine: boolean; Canvas: TPdfCanvas);
/// internal methods handling font fall-back
procedure AddGlyphFromChar(Char: WideChar; Canvas: TPdfCanvas;
TTF: TPdfFontTrueType; NextLine: PBoolean);
procedure AddGlyphFlush(Canvas: TPdfCanvas; TTF: TPdfFontTrueType; NextLine: PBoolean);
public
/// create the buffered writer, for a specified destination stream
constructor Create(Destination: TPdfDocument; DestStream: TStream);
/// add a character to the buffer
function Add(c: AnsiChar): TPdfWrite; overload; {$ifdef HASINLINE}inline;{$endif}
/// add an integer numerical value to the buffer
function Add(Value: Integer): TPdfWrite; overload;
/// add an integer numerical value to the buffer
// - and append a trailing space
function AddWithSpace(Value: Integer): TPdfWrite; overload;
/// add an integer numerical value to the buffer
// - with a specified fixed number of digits (left filled by '0')
function Add(Value, DigitCount: Integer): TPdfWrite; overload;
/// add a floating point numerical value to the buffer
// - up to 2 decimals are written
function Add(Value: TSynExtended): TPdfWrite; overload;
/// add a floating point numerical value to the buffer
// - up to 2 decimals are written, together with a trailing space
function AddWithSpace(Value: TSynExtended): TPdfWrite; overload;
/// add a floating point numerical value to the buffer
// - this version handles a variable number of decimals, together with
// a trailing space - this is used by ConcatToCTM e.g. or enhanced precision
function AddWithSpace(Value: TSynExtended; Decimals: cardinal): TPdfWrite; overload;
/// direct raw write of some data
// - no conversion is made
function Add(Text: PAnsiChar; Len: integer): TPdfWrite; overload;
/// direct raw write of some data
// - no conversion is made
function Add(const Text: RawByteString): TPdfWrite; overload;
/// hexadecimal write of some row data
// - row data is written as hexadecimal byte values, one by one
function AddHex(const Bin: PDFString): TPdfWrite;
/// add a word value, as Big-Endian 4 hexadecimal characters
function AddHex4(aWordValue: cardinal): TPdfWrite;
/// convert some text into unicode characters, then write it as as Big-Endian
// 4 hexadecimal characters
// - Ansi to Unicode conversion uses the CodePage set by Create() constructor
function AddToUnicodeHex(const Text: PDFString): TPdfWrite;
/// write some unicode text as as Big-Endian 4 hexadecimal characters
function AddUnicodeHex(PW: PWideChar; WideCharCount: integer): TPdfWrite;
/// convert some text into unicode characters, then write it as PDF Text
// - Ansi to Unicode conversion uses the CodePage set by Create() constructor
// - use (...) for all WinAnsi characters, or <..hexa..> for Unicode characters
// - if NextLine is TRUE, the first written PDF Text command is not Tj but '
// - during the text process, corresponding TPdfTrueTypeFont properties are
// updated (Unicode version created if necessary, indicate used glyphs for
// further Font properties writting to the PDF file content...)
// - if the current font is not True Type, all Unicode characters are
// drawn as '?'
function AddToUnicodeHexText(const Text: PDFString; NextLine: boolean;
Canvas: TPdfCanvas): TPdfWrite;
/// write some Unicode text, as PDF text
// - incoming unicode text must end with a #0
// - use (...) for all WinAnsi characters, or <..hexa..> for Unicode characters
// - if NextLine is TRUE, the first written PDF Text command is not Tj but '
// - during the text process, corresponding TPdfTrueTypeFont properties are
// updated (Unicode version created if necessary, indicate used glyphs for
// further Font properties writting to the PDF file content...)
// - if the current font is not True Type, all Unicode characters are
// drawn as '?'
function AddUnicodeHexText(PW: PWideChar; NextLine: boolean;
Canvas: TPdfCanvas): TPdfWrite;
/// write some Unicode text, encoded as Glyphs indexes, corresponding
// to the current font
function AddGlyphs(Glyphs: PWord; GlyphsCount: integer; Canvas: TPdfCanvas;
AVisAttrsPtr: Pointer=nil): TPdfWrite;
/// add some WinAnsi text as PDF text
// - used by TPdfText object
// - will optionally encrypt the content
function AddEscapeContent(const Text: RawByteString): TPdfWrite;
/// add some WinAnsi text as PDF text
// - used by TPdfText object
function AddEscape(Text: PAnsiChar; TextLen: integer): TPdfWrite;
/// add some WinAnsi text as PDF text
// - used by TPdfCanvas.ShowText method for WinAnsi text
function AddEscapeText(Text: PAnsiChar; Font: TPdfFont): TPdfWrite;
/// add some PDF /property value
function AddEscapeName(Text: PAnsiChar): TPdfWrite;
{$ifdef MSWINDOWS}
/// add a PDF color, from its TPdfColorRGB RGB value
function AddColorStr(Color: TPdfColorRGB): TPdfWrite;
{$endif}
/// add a TBitmap.Scanline[] content into the stream
procedure AddRGB(P: PAnsiChar; PInc, Count: integer);
/// add an ISO 8601 encoded date time (e.g. '2010-06-16T15:06:59-07:00')
function AddIso8601(DateTime: TDateTime): TPdfWrite;
/// add an integer value as binary, specifying a storage size in bytes
function AddIntegerBin(value: integer; bytesize: cardinal): TPdfWrite;
public
/// flush the internal buffer to the destination stream
procedure Save; {$ifdef HASINLINE}inline;{$endif}
/// return the current position
// - add the current internal buffer stream position to the destination
// stream position
function Position: Integer; {$ifdef HASINLINE}inline;{$endif}
/// get the data written to the Writer as a PDFString
// - this method could not use Save to flush the data, if all input was
// inside the internal buffer (save some CPU and memory): so don't intend
// the destination stream to be flushed after having called this method
function ToPDFString: PDFString;
end;
/// object manager is a virtual class to manage instance of indirect PDF objects
TPdfObjectMgr = class(TObject)
public
procedure AddObject(AObject: TPdfObject); virtual; abstract;
function GetObject(ObjectID: integer): TPdfObject; virtual; abstract;
end;
/// master class for most PDF objects declaration
TPdfObject = class(TObject)
private
FObjectType: TPdfObjectType;
FObjectNumber: integer;
FGenerationNumber: integer;
FSaveAtTheEnd: boolean;
protected
procedure InternalWriteTo(W: TPdfWrite); virtual;
procedure SetObjectNumber(Value: integer);
function SpaceNotNeeded: boolean; virtual;
public
/// create the PDF object instance
constructor Create; virtual;
/// Write object to specified stream
// - If object is indirect object then write references to stream
procedure WriteTo(var W: TPdfWrite);
/// write indirect object to specified stream
// - this method called by parent object
procedure WriteValueTo(var W: TPdfWrite);
/// low-level force the object to be saved now
// - you should not use this low-level method, unless you want to force
// the FSaveAtTheEnd internal flag to be set to force, so that
// TPdfDocument.SaveToStreamDirectPageFlush would flush the object content
procedure ForceSaveNow;
/// the associated PDF Object Number
// - If you set an object number higher than zero, the object is considered
// as indirect. Otherwise, the object is considered as direct object.
property ObjectNumber: integer read FObjectNumber write SetObjectNumber;
/// the associated PDF Generation Number
property GenerationNumber: integer read FGenerationNumber;
/// the corresponding type of this PDF object
property ObjectType: TPdfObjectType read FObjectType;
end;
/// a virtual PDF object, with an associated PDF Object Number
TPdfVirtualObject = class(TPdfObject)
public
constructor Create(AObjectId: integer); reintroduce;
end;
/// a PDF object, storing a boolean value
TPdfBoolean = class(TPdfObject)
private
FValue: boolean;
protected
procedure InternalWriteTo(W: TPdfWrite); override;
public
constructor Create(AValue: Boolean); reintroduce;
property Value: boolean read FValue write FValue;
end;
/// a PDF object, storing a NULL value
TPdfNull = class(TPdfObject)
protected
procedure InternalWriteTo(W: TPdfWrite); override;
end;
/// a PDF object, storing a numerical (integer) value
TPdfNumber = class(TPdfObject)
private
FValue: integer;
protected
procedure InternalWriteTo(W: TPdfWrite); override;
public
constructor Create(AValue: Integer); reintroduce;
property Value: integer read FValue write FValue;
end;
/// a PDF object, storing a numerical (floating point) value
TPdfReal = class(TPdfObject)
private
FValue: double;
protected
procedure InternalWriteTo(W: TPdfWrite); override;
public
constructor Create(AValue: double); reintroduce;
property Value: double read FValue write FValue;
end;
/// a PDF object, storing a textual value
// - the value is specified as a PDFString
// - this object is stored as '(escapedValue)'
// - in case of MBCS, conversion is made into Unicode before writing, and
// stored as '<FEFFHexUnicodeEncodedValue>'
TPdfText = class(TPdfObject)
private
FValue: RawByteString;
protected
procedure InternalWriteTo(W: TPdfWrite); override;
function SpaceNotNeeded: boolean; override;
public
constructor Create(const AValue: RawByteString); reintroduce;
property Value: RawByteString read FValue write FValue;
end;
/// a PDF object, storing a textual value
// - the value is specified as an UTF-8 encoded string
// - this object is stored as '(escapedValue)'
// - in case characters with ANSI code higher than 8 Bits, conversion is made
// into Unicode before writing, and '<FEFFHexUnicodeEncodedValue>'
TPdfTextUTF8 = class(TPdfObject)
private
FValue: RawUTF8;
protected
procedure InternalWriteTo(W: TPdfWrite); override;
function SpaceNotNeeded: boolean; override;
public
constructor Create(const AValue: RawUTF8); reintroduce;
property Value: RawUTF8 read FValue write FValue;
end;
/// a PDF object, storing a textual value
// - the value is specified as a generic VCL string
// - this object is stored as '(escapedValue)'
// - in case characters with ANSI code higher than 8 Bits, conversion is made
// into Unicode before writing, and '<FEFFHexUnicodeEncodedValue>'
TPdfTextString = class(TPdfTextUTF8)
private
function GetValue: string;
procedure SetValue(const Value: string);
public
constructor Create(const AValue: string); reintroduce;
property Value: string read GetValue write SetValue;
end;
/// a PDF object, storing a raw PDF content
// - this object is stored into the PDF stream as the defined Value
TPdfRawText = class(TPdfText)
protected
function SpaceNotNeeded: boolean; override;
procedure InternalWriteTo(W: TPdfWrite); override;
end;
/// a PDF object, storing a textual value with no encryption
// - the value is specified as a memory buffer
// - this object is stored as '(escapedValue)'
TPdfClearText = class(TPdfText)
protected
procedure InternalWriteTo(W: TPdfWrite); override;
public
constructor Create(Buffer: pointer; Len: integer); reintroduce;
end;
/// a PDF object, storing a PDF name
// - this object is stored as '/Value'
TPdfName = class(TPdfText)
protected
procedure InternalWriteTo(W: TPdfWrite); override;
end;
/// used to store an array of PDF objects
TPdfArray = class(TPdfObject)
private
FArray: TList;
FObjectMgr: TPdfObjectMgr;
function GetItems(Index: integer): TPdfObject; {$ifdef HASINLINE}inline;{$endif}
function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
protected
procedure InternalWriteTo(W: TPdfWrite); override;
function SpaceNotNeeded: boolean; override;
public
/// create an array of PDF objects
constructor Create(AObjectMgr: TPdfObjectMgr); reintroduce; overload;
/// create an array of PDF objects, with some specified TPdfNumber values
constructor Create(AObjectMgr: TPdfObjectMgr;
const AArray: array of Integer); reintroduce; overload;
/// create an array of PDF objects, with some specified TPdfNumber values
constructor Create(AObjectMgr: TPdfObjectMgr;
AArray: PWordArray; AArrayCount: integer); reintroduce; overload;
/// create an array of PDF objects, with some specified TPdfName values
constructor CreateNames(AObjectMgr: TPdfObjectMgr;
const AArray: array of PDFString); reintroduce; overload;
/// create an array of PDF objects, with some specified TPdfReal values
constructor CreateReals(AObjectMgr: TPdfObjectMgr;
const AArray: array of double); reintroduce; overload;
/// release the instance memory, and all embedded objects instances
destructor Destroy; override;
/// Add a PDF object to the array
// - if AItem already exists, do nothing
function AddItem(AItem: TPdfObject): integer;
/// insert a PDF object to the array
// - if AItem already exists, do nothing
procedure InsertItem(Index: Integer; AItem: TPdfObject);
/// retrieve a TPDFName object stored in the array
function FindName(const AName: PDFString): TPdfName;
/// remove a specified TPDFName object stored in the array
function RemoveName(const AName: PDFString): boolean;
/// retrieve an object instance, stored in the array
property Items[Index: integer]: TPdfObject read GetItems; default;
/// retrieve the array size
property ItemCount: integer read GetItemCount;
/// the associated PDF Object Manager
property ObjectMgr: TPdfObjectMgr read FObjectMgr;
/// direct access to the internal TList instance
// - not to be used normally
property List: TList read FArray;
end;
/// PDF dictionary element definition
TPdfDictionaryElement = class(TObject)
private
FKey: TPdfName;
FValue: TPdfObject;
FIsInternal: boolean;
function GetKey: PDFString;
public
/// create the corresponding Key / Value pair
constructor Create(const AKey: PDFString; AValue: TPdfObject; AInternal: Boolean=false);
/// release the element instance, and both associated Key and Value
destructor Destroy; override;
/// the associated Key Name
property Key: PDFString read GetKey;
/// the associated Value stored in this element
property Value: TPdfObject read FValue;
/// if this element was created as internal, i.e. not to be saved to the PDF content
property IsInternal: boolean read FIsInternal;
end;
/// a PDF Dictionary is used to manage Key / Value pairs
TPdfDictionary = class(TPdfObject)
private
FArray: TList;
FObjectMgr: TPdfObjectMgr;
function GetItems(Index: integer): TPdfDictionaryElement; {$ifdef HASINLINE}inline;{$endif}
function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
protected
function getTypeOf: PDFString;
function SpaceNotNeeded: boolean; override;
procedure DirectWriteto(W: TPdfWrite; Secondary: TPdfDictionary);
procedure InternalWriteTo(W: TPdfWrite); override;
public
/// create the PDF dictionary
constructor Create(AObjectMgr: TPdfObjectMgr); reintroduce;
/// release the dictionay instance, and all associated elements
destructor Destroy; override;
/// fast find a value by its name
function ValueByName(const AKey: PDFString): TPdfObject;
/// fast find a boolean value by its name
function PdfBooleanByName(const AKey: PDFString): TPdfBoolean; {$ifdef HASINLINE}inline;{$endif}
/// fast find a numerical (integer) value by its name
function PdfNumberByName(const AKey: PDFString): TPdfNumber; {$ifdef HASINLINE}inline;{$endif}
/// fast find a textual value by its name
function PdfTextByName(const AKey: PDFString): TPdfText; {$ifdef HASINLINE}inline;{$endif}
/// fast find a textual value by its name
// - return '' if not found, the TPdfText.Value otherwise
function PdfTextValueByName(const AKey: PDFString): PDFString; {$ifdef HASINLINE}inline;{$endif}
/// fast find a textual value by its name
// - return '' if not found, the TPdfTextUTF8.Value otherwise
function PdfTextUTF8ValueByName(const AKey: PDFString): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
/// fast find a textual value by its name
// - return '' if not found, the TPdfTextString.Value otherwise
function PdfTextStringValueByName(const AKey: PDFString): string; {$ifdef HASINLINE}inline;{$endif}
/// fast find a numerical (floating-point) value by its name
function PdfRealByName(const AKey: PDFString): TPdfReal; {$ifdef HASINLINE}inline;{$endif}
/// fast find a name value by its name
function PdfNameByName(const AKey: PDFString): TPdfName; {$ifdef HASINLINE}inline;{$endif}
/// fast find a dictionary value by its name
function PdfDictionaryByName(const AKey: PDFString): TPdfDictionary; {$ifdef HASINLINE}inline;{$endif}
/// fast find an array value by its name
function PdfArrayByName(const AKey: PDFString): TPdfArray; {$ifdef HASINLINE}inline;{$endif}
/// add a specified Key / Value pair to the dictionary
// - create PdfDictionaryElement with given key and value, and add it to list
// - if the element exists, replace value of element by given value
// - internal items are local to the framework, and not to be saved to the PDF content
procedure AddItem(const AKey: PDFString; AValue: TPdfObject; AInternal: Boolean=false); overload;
/// add a specified Key / Value pair (of type TPdfName) to the dictionary
procedure AddItem(const AKey, AValue: PDFString); overload; {$ifdef HASINLINE}inline;{$endif}
/// add a specified Key / Value pair (of type TPdfNumber) to the dictionary
procedure AddItem(const AKey: PDFString; AValue: integer); overload; {$ifdef HASINLINE}inline;{$endif}
/// add a specified Key / Value pair (of type TPdfText) to the dictionary
procedure AddItemText(const AKey, AValue: PDFString); overload; {$ifdef HASINLINE}inline;{$endif}
/// add a specified Key / Value pair (of type TPdfTextUTF8) to the dictionary
// - the value can be any UTF-8 encoded text: it will be written as
// Unicode hexadecimal to the PDF stream, if necessary
procedure AddItemTextUTF8(const AKey: PDFString; const AValue: RawUTF8); overload;
{$ifdef HASINLINE}inline;{$endif}
/// add a specified Key / Value pair (of type TPdfTextUTF8) to the dictionary
// - the value is a generic VCL string: it will be written as
// Unicode hexadecimal to the PDF stream, if necessary
procedure AddItemTextString(const AKey: PDFString; const AValue: string); overload;
{$ifdef HASINLINE}inline;{$endif}
/// remove the element specified by its Key from the dictionary
// - if the element does not exist, do nothing
procedure RemoveItem(const AKey: PDFString);
/// retrieve any dictionary element
property Items[Index: integer]: TPdfDictionaryElement read GetItems; default;
/// retrieve the dictionary element count
property ItemCount: integer read GetItemCount;
/// retrieve the associated Object Manager
property ObjectMgr: TPdfObjectMgr read FObjectMgr;
/// retrieve the type of the pdfdictionary object, i.e. the 'Type' property name
property TypeOf: PDFString read getTypeOf;
/// direct access to the internal TList instance
// - not to be used normally
property List: TList read FArray;
end;
/// a temporary memory stream, to be stored into the PDF content
// - typicaly used for the page content
// - can be compressed, if the FlateDecode filter is set
TPdfStream = class(TPdfObject)
protected
FAttributes: TPdfDictionary;
FSecondaryAttributes: TPdfDictionary;
{$ifdef USE_PDFSECURITY}
FDoNotEncrypt: boolean;
{$endif}
FFilter: PDFString;
FWriter: TPdfWrite;
procedure InternalWriteTo(W: TPdfWrite); override;
public
/// create the temporary memory stream
// - an optional DontAddToFXref is available, if you don't want to add
// this object to the main XRef list of the PDF file
constructor Create(ADoc: TPdfDocument; DontAddToFXref: boolean=false); reintroduce;
/// release the memory stream
destructor Destroy; override;
/// retrieve the associated attributes, e.g. the stream Length
property Attributes: TPdfDictionary read FAttributes;
/// retrieve the associated buffered writer
// - use this TPdfWrite instance to write some data into the stream
property Writer: TPdfWrite read FWriter;
/// retrieve the associated filter name
property Filter: PDFString read FFilter write FFilter;
end;
/// used to handle object which are not defined in this library
TPdfBinary = class(TPdfObject)
protected
FStream: TMemoryStream;
procedure InternalWriteTo(W: TPdfWrite); override;
public
/// create the instance, i.e. its associated stream
constructor Create; override;
/// release the instance
destructor Destroy; override;
/// the associated memory stream, used to store the corresponding data
// - the content of this stream will be written to the resulting
property Stream: TMemoryStream read FStream;
end;
TPdfXref = class;
TPdfObjectStream = class;
/// the Trailer of the PDF File
TPdfTrailer = class(TObject)
private
FAttributes: TPdfDictionary;
FXrefAddress: integer;
FCrossReference: TPdfStream;
FObjectStream: TPdfObjectStream;
FXRef: TPdfXref;
protected
procedure WriteTo(var W: TPdfWrite);
public
constructor Create(AObjectMgr: TPdfObjectMgr);
destructor Destroy; override;
procedure ToCrossReference(Doc: TPdfDocument);
property XrefAddress: integer read FXrefAddress write FXrefAddress;
property Attributes: TPdfDictionary read FAttributes;
end;
/// store one entry in the XRef list of the PDF file
TPdfXrefEntry = class(TObject)
private
FEntryType: PDFString;
FByteOffset: integer;
FGenerationNumber: integer;
FObjectStreamIndex: integer;
FValue: TPdfObject;
public
/// create the entry, with the specified value
// - if the value is nil (e.g. root entry), the type is 'f' (PDF_FREE_ENTRY),
// otherwise the entry type is 'n' (PDF_IN_USE_ENTRY)
constructor Create(AValue: TPdfObject);
/// release the memory, and the associated value, if any
destructor Destroy; override;
/// write the XRef list entry
procedure SaveToPdfWrite(var W: TPdfWrite);
/// return either 'f' (PDF_FREE_ENTRY), either 'n' (PDF_IN_USE_ENTRY)
property EntryType: PDFString read FEntryType write FEntryType;
/// the position (in bytes) in the PDF file content stream
// - to be ignored if ObjectStreamIndex>=0
property ByteOffset: integer read FByteOffSet;
/// the index of this object in the global compressed /ObjStm object stream
// - equals -1 by default, i.e. if stored within the main file content stream
property ObjectStreamIndex: Integer read FObjectStreamIndex;
/// the associated Generation Number
// - mostly 0, or 65535 (PDF_MAX_GENERATION_NUM) for the root 'f' entry
property GenerationNumber: integer read FGenerationNumber write FGenerationNumber;
/// the associated PDF object
property Value: TPdfObject read FValue;
end;
/// store the XRef list of the PDF file
TPdfXref = class(TPdfObjectMgr)
private
FXrefEntries: TList;
function GetItem(ObjectID: integer): TPdfXrefEntry; {$ifdef HASINLINE}inline;{$endif}
function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
protected
procedure WriteTo(var W: TPdfWrite);
public
/// initialize the XRef object list
// - create first a void 'f' (PDF_FREE_ENTRY) as root
constructor Create;
/// release instance memory and all associated XRef objects
destructor Destroy; override;
/// register object to the xref table, and set corresponding object ID
procedure AddObject(AObject: TPdfObject); override;
/// retrieve an object from its object ID
function GetObject(ObjectID: integer): TPdfObject; override;
/// retrieve a XRef object instance, from its object ID
property Items[ObjectID: integer]: TPdfXrefEntry read GetItem; default;
/// retrieve the XRef object count
property ItemCount: integer read GetItemCount;
end;
/// any object stored to the PDF file
// - these objects are the main unit of the PDF file content
// - these objects are written in the PDF file, followed by a "xref" table
TPdfXObject = class(TPdfStream);
/// generic PDF Outlines entries, stored as a PDF dictionary
TPdfOutlines = class(TPdfDictionary);
/// generic PDF Optional Content entry
TPdfOptionalContentGroup = class(TPdfDictionary);
TPdfInfo = class;
TPdfCatalog = class;
TPdfDestination = class;
TPdfOutlineEntry = class;
TPdfOutlineRoot = class;
TPdfPage = class;
TPdfPageClass = class of TPdfPage;
/// potential font styles
TPdfFontStyle = (pfsBold, pfsItalic, pfsUnderline, pfsStrikeOut);
/// set of font styles
TPdfFontStyles = set of TPdfFontStyle;
/// the main class of the PDF engine, processing the whole PDF document
TPdfDocument = class(TObject)
protected
FRoot: TPdfCatalog;
FCurrentPages: TPdfDictionary;
FOutputIntents: TPdfArray;
FMetaData: TPdfStream;
FCanvas: TPdfCanvas;
FTrailer: TPdfTrailer;
FXref: TPdfXref;
FInfo: TPdfInfo;
FFontList: TList;
FObjectList: TList;
FOutlineRoot: TPdfOutlineRoot;
FStructTree: TPdfDictionary;
FXObjectList: TPdfArray;
FDefaultPageWidth: cardinal;
FDefaultPageHeight: Cardinal;
FDefaultPaperSize: TPDFPaperSize;
FCompressionMethod: TPdfCompressionMethod;
FUseOutlines: boolean;
FUseOptionalContent: boolean;
FCharSet: integer;
FCodePage: cardinal;
FTrueTypeFonts: TRawUTF8DynArray;
FTrueTypeFontLastName: RawUTF8;
FTrueTypeFontLastIndex: integer;
FDC: HDC;
FScreenLogPixels: Integer;
FPrinterPxPerInch: TPoint;
FStandardFontsReplace: boolean;
fEmbeddedTTF: boolean;
fEmbeddedWholeTTF: boolean;
fEmbeddedTTFIgnore: TRawUTF8List;
fRawPages: TList;
{$ifdef USE_UNISCRIBE}
fUseUniscribe: boolean;
{$endif}
fSelectedDCFontOld: HDC;
fForceJPEGCompression: Integer;
fForceNoBitmapReuse: boolean;
fUseFontFallBack: boolean;
fFontFallBackIndex: integer;
/// a list of Bookmark text keys, associated to a TPdfDest object
fBookMarks: TRawUTF8List;
fMissingBookmarks: TRawUTF8List;
/// internal temporary variable - used by CreateOutline
fLastOutline: TPdfOutlineEntry;
fFileFormat: TPdfFileFormat;
fPDFA1: boolean;
fSaveToStreamWriter: TPdfWrite;
{$ifdef USE_PDFSECURITY}
fEncryption: TPdfEncryption;
fFileID: TMD5Digest;
fEncryptionObject: TPdfDictionary;
fCurrentObjectNumber: integer;
fCurrentGenerationNumber: integer;
{$endif USE_PDFSECURITY}
function GetGeneratePDF15File: boolean;
procedure SetGeneratePDF15File(const Value: boolean);
function GetInfo: TPdfInfo; {$ifdef HASINLINE}inline;{$endif}
function GetOutlineRoot: TPdfOutlineRoot; {$ifdef HASINLINE}inline;{$endif}
procedure SetStandardFontsReplace(const Value: boolean); {$ifdef HASINLINE}inline;{$endif}
function GetEmbeddedTTFIgnore: TRawUTF8List;
procedure SetDefaultPaperSize(const Value: TPDFPaperSize);
procedure SetDefaultPageHeight(const Value: cardinal);
procedure SetDefaultPageWidth(const Value: cardinal);
procedure SetUseOptionalContent(const Value: boolean);
procedure SetPDFA1(const Value: boolean);
function GetDefaultPageLandscape: boolean;
procedure SetDefaultPageLandscape(const Value: boolean);
procedure SetFontFallBackName(const Value: string);
function GetFontFallBackName: string;
protected
/// can be useful in descendant objects in other units
fTPdfPageClass: TPdfPageClass;
procedure RaiseInvalidOperation;
procedure CreateInfo;
/// get the PostScript Name of a TrueType Font
// - use the Naming Table ('name') of the TTF content if not 7 bit ascii
function TTFFontPostcriptName(aFontIndex: integer; AStyle: TPdfFontStyles;
AFont: TPdfFontTrueType): PDFString;
/// register the font in the font list
procedure RegisterFont(aFont: TPdfFont);
/// get the PDF font, from its internal PDF name (e.g. 'Helvetica-Bold')
// - if the specified font exists in the font list, returns the corresponding object
// - if the font doesn't exist yet, returns NIL
function GetRegisteredNotTrueTypeFont(const APDFFontName: PDFString): TPdfFont;
/// get the supplied TrueType Font from the internal font list
// - warning: the font index is FTrueTypeFonts.IndexOf(AName)+1, since
// font index 0 is reserved for all not True Type fonts
// - if the true type font doesn't exist yet, returns NIL
// - always return the WinAnsi version of the font: the caller has to
// use the UnicodeFont property to get the corresponding Unicode aware
// version, if it was used
function GetRegisteredTrueTypeFont(AFontIndex: integer;
AStyle: TPdfFontStyles; ACharSet: byte): TPdfFont; overload;
/// get the supplied TrueType Font from the internal font list
// - if the true type font doesn't exist yet, returns NIL
function GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont; overload;
/// find an index of in FTrueTypeFonts[]
function GetTrueTypeFontIndex(const AName: RawUTF8): integer;
// select the specified font object, then return the fDC value
function GetDCWithFont(TTF: TPdfFontTrueType): HDC;
/// release the current document content
procedure FreeDoc;
public
/// create the PDF document instance, with a Canvas and a default A4 paper size
// - the current charset and code page are retrieved from the SysLocale
// value, so the PDF engine is MBCS ready
// - note that only Win-Ansi encoding allows use of embedded standard fonts
// - you can specify a Code Page to be used for the PDFString encoding;
// by default (ACodePage left to 0), the current system code page is used
// - you can create a PDF/A-1 compliant document by setting APDFA1 to true
// - you can set an encryption instance, by using TPdfEncryption.New()
constructor Create(AUseOutlines: Boolean=false; ACodePage: integer=0;
APDFA1: boolean=false
{$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption=nil{$endif}); reintroduce;
/// release the PDF document instance
destructor Destroy; override;
/// create a new document
// - this method is called first, by the Create constructor
// - you can call it multiple time if you want to reset the whole document content
procedure NewDoc;
/// add a Page to the current PDF document
function AddPage: TPdfPage; virtual;
/// create a Pages object
// - Pages objects can be nested, to save memory used by the Viewer
// - only necessary if you have more than 8000 pages (this method is called
// by TPdfDocument.NewDoc, so you shouldn't have to use it)
function CreatePages(Parent: TPdfDictionary): TPdfDictionary;
/// register an object (typicaly a TPdfImage) to the PDF document
// - returns the internal index as added in FXObjectList[]
function RegisterXObject(AObject: TPdfXObject; const AName: PDFString): integer;
/// add then register an object (typicaly a TPdfImage) to the PDF document
// - returns the internal index as added in FXObjectList[]
function AddXObject(const AName: PDFString; AXObject: TPdfXObject): integer;
/// save the PDF file content into a specified Stream
procedure SaveToStream(AStream: TStream; ForceModDate: TDateTime=0); virtual;
/// prepare to save the PDF file content into a specified Stream
// - is called by SaveToStream() method
// - you can then append other individual pages with SaveToStreamCurrentPage
// to avoid most resource usage (e.g. for report creation)
// - shall be finished by a SaveToStreamDirectEnd call
procedure SaveToStreamDirectBegin(AStream: TStream; ForceModDate: TDateTime=0);
/// save the current page content to the PDF file
// - shall be made one or several times after a SaveToStreamDirectBegin() call
// and before a final SaveToStreamDirectEnd call
// - see TPdfDocumentGDI.SaveToStream() in this unit, and
// TGDIPages.ExportPDFStream() in mORMotReport.pas for real use cases
// - you can set FlushCurrentPageNow=true to force the current page to be
// part of the flushed content
procedure SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean=false); virtual;
/// prepare to save the PDF file content into a specified Stream
// - shall be made once after a SaveToStreamDirectBegin() call
// - is called by SaveToStream() method
procedure SaveToStreamDirectEnd;
/// save the PDF file content into a specified file
// - return FALSE on any writing error (e.g. if the file is opened in the
// Acrobar Reader)
function SaveToFile(const aFileName: TFileName): boolean;
/// retrieve a XObject from its name
// - this method will handle also the Virtual Objects
function GetXObject(const AName: PDFString): TPdfXObject;
/// retrieve a XObject index from its name
// - this method won't handle the Virtual Objects
function GetXObjectIndex(const AName: PDFString): integer;
{$ifdef USE_BITMAP}
/// retrieve a XObject TPdfImage index from its picture attributes
// - returns '' if this image is not already there
// - uses 4 hash codes, created with 4 diverse seeds, in order to avoid
// false positives
function GetXObjectImageName(const Hash: THash128Rec; Width, Height: Integer): PDFString;
{$endif USE_BITMAP}
/// wrapper to create an annotation
// - the annotation is set to a specified position of the current page
function CreateAnnotation(AType: TPdfAnnotationSubType; const ARect: TPdfRect;
BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=1): TPdfDictionary;
/// wrapper to create a Link annotation, specified by a bookmark
// - the link is set to a specified rectangular position of the current page
// - if the bookmark name is not existing (i.e. if it no such name has been
// defined yet via the CreateBookMark method), it's added to the internal
// fMissingBookmarks list, and will be linked at CreateBookMark method call
function CreateLink(const ARect: TPdfRect; const aBookmarkName: RawUTF8;
BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=1): TPdfDictionary;
/// wrapper to create a hyper-link, with a specific URL value
function CreateHyperLink(const ARect: TPdfRect; const url: RawUTF8;
BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=0): TPdfDictionary;
/// create an Outline entry at a specified position of the current page
// - the outline tree is created from the specified numerical level (0=root),
// just after the item added via the previous CreateOutline call
// - the title is a generic VCL string, to handle fully Unicode support
function CreateOutline(const Title: string; Level: integer; TopPosition: Single): TPdfOutlineEntry;
/// create a Destination
// - the current PDF Canvas page is associated with this destination object
function CreateDestination: TPdfDestination;
/// create an internal bookmark entry at a specified position of the current page
// - the current PDF Canvas page is associated with the destination object
// - a dtXYZ destination with the corresponding TopPosition Y value is defined
// - the associated bookmark name must be unique, otherwise an exception is raised
procedure CreateBookMark(TopPosition: Single; const aBookmarkName: RawUTF8);
{$ifdef USE_BITMAP}
/// create an image from a supplied bitmap
// - returns the internal XObject name of the resulting TPDFImage
// - if you specify a PPdfBox to draw the image at the given position/size
// - if the same bitmap content is sent more than once, the TPDFImage will
// be reused (it will therefore spare resulting pdf file space) - if the
// ForceNoBitmapReuse is FALSE
// - if ForceCompression property is set, the picture will be stored as a JPEG
// - you can specify a clipping rectangle region as ClipRc parameter
function CreateOrGetImage(B: TBitmap; DrawAt: PPdfBox=nil; ClipRc: PPdfBox=nil): PDFString;
{$endif USE_BITMAP}
// create a new optional content group (layer)
// - returns a TPdfOptionalContentGroup needed for TPDFCanvas.BeginMarkedContent
// - if ParentContentGroup is not nil, the new content group is a subgroup to ParentContentGroup
// - Title is the string shown in the PDF Viewer
// - Visible controls the initial state of the content group
function CreateOptionalContentGroup(ParentContentGroup: TPdfOptionalContentGroup;
const Title: string; Visible: Boolean=true): TPdfOptionalContentGroup;
// create a Radio Optional ContentGroup
// - ContentGroups is a array of TPdfOptionalContentGroups which should behave like
// radiobuttons, i.e. only one active at a time
// - visibility must be set with CreateOptionalContentGroup, only one group should be visible
procedure CreateOptionalContentRadioGroup(const ContentGroups: array of TPdfOptionalContentGroup);
/// retrieve the current PDF Canvas, associated to the current page
property Canvas: TPdfCanvas read fCanvas;
/// retrieve the PDF information, associated to the PDF document
property Info: TPdfInfo read GetInfo;
// retrieve the PDF Document Catalog, as root of the document's object hierarchy
property Root: TPdfCatalog read fRoot;
/// retrieve the PDF Outline, associated to the PDF document
// - UseOutlines must be set to TRUE before any use of the OutlineRoot property
property OutlineRoot: TPdfOutlineRoot read GetOutlineRoot;
/// the default page width, used for new every page creation (i.e. AddPage method call)
property DefaultPageWidth: cardinal read FDefaultPageWidth write SetDefaultPageWidth;
/// the default page height, used for new every page creation (i.e. AddPage method call)
property DefaultPageHeight: cardinal read FDefaultPageHeight write SetDefaultPageHeight;
/// the default page orientation
// - a call to this property will swap default page width and height if the
// orientation is not correct
property DefaultPageLandscape: boolean read GetDefaultPageLandscape write SetDefaultPageLandscape;
/// the default page size, used for every new page creation (i.e. AddPage method call)
// - a write to this property this will reset the default paper orientation
// to Portrait: you must explicitely set DefaultPageLandscape to true, if needed
property DefaultPaperSize: TPDFPaperSize read FDefaultPaperSize write SetDefaultPaperSize;
/// the compression method used for page content storage
// - is set by default to cmFlateDecode when the class instance is created
property CompressionMethod: TPdfCompressionMethod read FCompressionMethod write FCompressionMethod;
/// if set to TRUE, the used True Type fonts will be embedded to the PDF content
// - not set by default, to save disk space and produce tiny PDF
property EmbeddedTTF: boolean read fEmbeddedTTF write fEmbeddedTTF;
/// you can add some font names to this list, if you want these fonts
// NEVER to be embedded to the PDF file, even if the EmbeddedTTF property is set
// - if you want to ignore all standard windows fonts, use:
// ! EmbeddedTTFIgnore.Text := MSWINDOWS_DEFAULT_FONTS;
property EmbeddedTTFIgnore: TRawUTF8List read GetEmbeddedTTFIgnore;
/// if set to TRUE, the embedded True Type fonts will be totaly Embeddeded
// - by default, is set to FALSE, meaning that a subset of the TTF font is
// stored into the PDF file, i.e. only the used glyphs are stored
// - this option is only available if running on Windows XP or later
property EmbeddedWholeTTF: boolean read fEmbeddedWholeTTF write fEmbeddedWholeTTF;
/// used to define if the PDF document will use outlines
// - must be set to TRUE before any use of the OutlineRoot property
property UseOutlines: boolean read FUseoutlines write FUseoutlines;
// used to define if the PDF document will use optional content (layers)
// - will also force PDF 1.5 as minimal file format
// - must be set to TRUE before calling NewDoc
// - warning: setting a value to this propery after creation will call the
// NewDoc method, therefore will erase all previous content and pages
// (including Info properties)
property UseOptionalContent: boolean read FUseOptionalContent write SetUseOptionalContent;
/// the current Code Page encoding used for this PDF Document
property CodePage: cardinal read FCodePage;
/// the current CharSet used for this PDF Document
property CharSet: integer read FCharSet;
/// set if the PDF engine must use standard fonts substitution
// - if TRUE, 'Arial', 'Times New Roman' and 'Courier New' will be
// replaced by the corresponding internal Type 1 fonts, defined in the Reader
// - only works with current ANSI_CHARSET, i.e. if you want to display
// some other unicode characters, don't enable this property: all non WinAnsi
// glyphs would be replaced by a '?' sign
// - default value is false (i.e. not embedded standard font)
property StandardFontsReplace: boolean read FStandardFontsReplace write SetStandardFontsReplace;
{$ifdef USE_UNISCRIBE}
/// set if the PDF engine must use the Windows Uniscribe API to
// render Ordering and/or Shaping of the text
// - useful for Hebrew, Arabic and some Asiatic languages handling
// - set to FALSE by default, for faster content generation
// - you can set this property temporary to TRUE, when using the Canvas
// property, but this property must be set appropriately before the content
// generation if you use any TPdfDocumentGdi.VCLCanvas text output with
// such scripting (since the PDF rendering is done once just before the
// saving, e.g. before SaveToFile() or SaveToStream() methods calls)
// - the PDF engine don't handle Font Fallback yet: the font you use
// must contain ALL glyphs necessary for the supplied unicode text - squares
// or blanks will be drawn for any missing glyph/character
property UseUniscribe: boolean read fUseUniscribe write fUseUniscribe;
{$endif}
/// used to define if the PDF document will handle "font fallback" for
// characters not existing in the current font: it will avoid rendering
// block/square symbols instead of the correct characters (e.g. for Chinese text)
// - will use the font specified by FontFallBackName property to add any
// Unicode glyph not existing in the currently selected font
// - default value is TRUE
property UseFontFallBack: boolean read fUseFontFallBack write fUseFontFallBack;
/// set the font name to be used for missing characters
// - used only if UseFontFallBack is TRUE
// - default value is 'Arial Unicode MS', if existing
property FontFallBackName: string read GetFontFallBackName write SetFontFallBackName;
/// this property can force saving all canvas bitmaps images as JPEG
// - handle bitmaps added by VCLCanvas/TMetaFile and bitmaps added as TPdfImage
// - by default, this property is set to 0 by the constructor of this class,
// meaning that the JPEG compression is not forced, and the engine will use
// the native resolution of the bitmap - in this case, the resulting
// PDF file content will be bigger in size (e.g. use this for printing)
// - 60 is the prefered way e.g. for publishing PDF over the internet
// - 80/90 is a good ratio if you want to have a nice PDF to see on screen
// - of course, this doesn't affect vectorial (i.e. emf) pictures
property ForceJPEGCompression: integer read fForceJPEGCompression write fForceJPEGCompression;
/// this property can force all canvas bitmaps to be stored directly
// - by default, the library will try to match an existing same bitmap
// content, and reuse the existing pdf object - you can set this property
// for a faster process, if you do not want to use this feature
property ForceNoBitmapReuse: boolean read fForceNoBitmapReuse write fForceNoBitmapReuse;
/// direct read-only access to all corresponding TPdfPage
// - can be useful in inherited classe
property RawPages: TList read fRawPages;
/// the resolution used for pixel to PDF coordinates conversion
// - by default, contains the Number of pixels per logical inch
// along the screen width
// - you can override this value if you really need additional resolution
// for your bitmaps and such - this is useful only with TPdfDocumentGDI and
// its associated TCanvas: all TPdfDocument native TPdfCanvas methods use
// the native resolution of the PDF, i.e. more than 7200 DPI (since we
// write coordinates with 2 decimals per point - which is 1/72 inch)
property ScreenLogPixels: Integer read FScreenLogPixels write FScreenLogPixels;
/// is TRUE if the file was created in order to be PDF/A-1 compliant
// - set APDFA1 parameter to true for Create constructor in order to use it
// - warning: setting a value to this propery after creation will call the
// NewDoc method, therefore will erase all previous content and pages
// (including Info properties)
property PDFA1: boolean read fPDFA1 write SetPDFA1;
/// set to TRUE to force PDF 1.5 format, which may produce smaller files
property GeneratePDF15File: boolean read GetGeneratePDF15File write SetGeneratePDF15File;
end;
/// a PDF page
TPdfPage = class(TPdfDictionary)
private
function GetPageLandscape: Boolean;
procedure SetPageLandscape(const Value: Boolean);
protected
fDoc: TPdfDocument;
FMediaBox: TPdfArray;
FWordSpace: Single;
FCharSpace: Single;
FFontSize: Single;
FFont: TPdfFont;
FLeading: Single;
FHorizontalScaling: Single;
procedure SetWordSpace(Value: Single);
procedure SetCharSpace(Value: Single);
procedure SetFontSize(Value: Single);
procedure SetHorizontalScaling(Value: Single);
procedure SetLeading(Value: Single);
procedure SetPageWidth(AValue: integer); virtual;
procedure SetPageHeight(AValue: integer); virtual;
function GetPageWidth: Integer;
function GetPageHeight: Integer;
function GetResources(const AName: PDFString): TPdfDictionary; {$ifdef HASINLINE}inline;{$endif}
public
/// create the page with its internal VCL Canvas
constructor Create(ADoc: TPdfDocument); reintroduce; virtual;
/// calculate width of specified text according to current attributes
// - this function is compatible with MBCS strings
function TextWidth(const Text: PDFString): Single;
/// calculate the number of chars which can be displayed in the specified
// width, according to current attributes
// - this function is compatible with MBCS strings, and returns
// the index in Text, not the glyphs index
function MeasureText(const Text: PDFString; Width: Single): integer;
public
/// retrieve or set the word Space attribute, in PDF coordinates of 1/72 inch
property WordSpace: Single read FWordSpace write SetWordSpace;
/// retrieve or set the Char Space attribute, in PDF coordinates of 1/72 inch
property CharSpace: Single read FCharSpace write SetCharSpace;
/// retrieve or set the Horizontal Scaling attribute, in PDF coordinates of 1/72 inch
property HorizontalScaling: Single read FHorizontalScaling write SetHorizontalScaling;
/// retrieve or set the text Leading attribute, in PDF coordinates of 1/72 inch
property Leading: Single read FLeading write SetLeading;
/// retrieve or set the font Size attribute, in system TFont.Size units
property FontSize: Single read FFontSize write SetFontSize;
/// retrieve the current used font
// - for TPdfFontTrueType, this points not always to the WinAnsi version of
// the Font, but can also point to the Unicode Version, if the last
// drawn character by ShowText() was unicode - see TPdfWrite.AddUnicodeHexText
property Font: TPdfFont read FFont write FFont;
/// retrieve or set the current page width, in PDF coordinates of 1/72 inch
property PageWidth: integer read GetPageWidth write SetPageWidth;
/// retrieve or set the current page height, in PDF coordinates of 1/72 inch
property PageHeight: integer read GetPageHeight write SetPageHeight;
/// retrieve or set the paper orientation
property PageLandscape: Boolean read GetPageLandscape write SetPageLandscape;
end;
/// is used to define how TMetaFile text positioning is rendered
// - tpSetTextJustification will handle efficiently the fact that TMetaFileCanvas
// used SetTextJustification() API calls to justify text: it will converted
// to SetWordSpace() pdf rendering
// - tpExactTextCharacterPositining will use the individual glyph positioning
// information as specified within the TMetaFile content: resulting pdf size
// will be bigger, but font kerning will be rendered as expected
// - tpKerningFromAveragePosition will use global font kerning via
// SetHorizontalScaling() pdf rendering
TPdfCanvasRenderMetaFileTextPositioning = (
tpKerningFromAveragePosition, tpSetTextJustification, tpExactTextCharacterPositining);
/// is used to define how TMetaFile text is clipped
// - by default, text will be clipped with the specified TEMRText.ptlReference
// - you could set tcClipExplicit to clip following the specified rclBounds
// - or tcAlwaysClip to use the current clipping region (if any)
// - finally, tcNeverClip would disable whole text clipping process, which
// has been reported to be preferred e.g. on Wine
TPdfCanvasRenderMetaFileTextClipping = (
tcClipReference, tcClipExplicit, tcAlwaysClip, tcNeverClip);
{$ifdef USE_ARC}
/// is used to define the TMetaFile kind of arc to be drawn
TPdfCanvasArcType =(
acArc, acArcTo, acArcAngle, acPie, acChoord);
{$endif USE_ARC}
/// access to the PDF Canvas, used to draw on the page
TPdfCanvas = class(TObject)
protected
FContents: TPdfStream;
FPage: TPdfPage;
FPageFontList: TPdfDictionary;
FDoc: TPdfDocument;
// = 72/FDoc.FScreenLogPixels
FFactor: single;
// = ViewSize.cx/WinSize.cx*FFactor
FFactorX: single;
// = ViewSize.cy/WinSize.cy*FFactor
FFactorY: single;
// = (MulDiv(ViewOrg.x, WinSize.cx, ViewSize.cx) - WinOrg.x)*FFactor
FOffsetX: single;
// = FHeight - (MulDiv(ViewOrg.y, WinSize.cy, ViewSize.cy) - WinOrg.y)*FFactor
FOffsetY: single;
// = XOff,YOff parameters specified in RenderMetaFile()
FOffsetXDef, FOffsetYDef: Single;
// WorldTransform factor and offs
FWorldFactorX, FWorldFactorY, FWorldOffsetX, FWorldOffsetY, FAngle,
FWorldCos, FWorldSin: single;
FDevScaleX, FDevScaleY: single;
FWinSize, FViewSize: TSize;
FWinOrg, FViewOrg: TPoint;
FMappingMode: Integer;
FEmfBounds: TRect;
FPrinterPxPerInch: TPoint;
FNewPath: Boolean;
{$ifdef USE_UNISCRIBE}
/// if Uniscribe-related methods must handle the text from right to left
fRightToLeftText: Boolean;
{$endif}
/// parameters taken from RenderMetaFile() call
fUseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning;
fUseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping;
fKerningHScaleBottom: Single;
fKerningHScaleTop: Single;
// some cache
FPreviousRasterFontName: RawUTF8;
FPreviousRasterFontIndex: integer;
// result := FOffsetX + (X * fFactorX);
function I2X(X: Integer): Single; overload;
// result := FOffsetX + (X * fFactorX);
function I2X(X: Single): Single; overload;
// result := FOffsetY - Y * fFactorY;
function I2Y(Y: Integer): Single; overload;
// result := FOffsetY - Y * fFactorY;
function I2Y(Y: Single): Single; overload;
// wrapper call I2X() and I2Y() for conversion
procedure LineToI(x, y: Integer); overload;
procedure LineToI(x, y: Single); overload;
// wrapper call I2X() and I2Y() for conversion
procedure MoveToI(x, y: Integer); overload;
procedure MoveToI(x, y: Single); overload;
// wrapper call I2X() and I2Y() for conversion
procedure CurveToCI(x1, y1, x2, y2, x3, y3: integer);
// wrapper call I2X() and I2Y() for conversion
procedure RoundRectI(x1,y1,x2,y2,cx,cy: integer);
{$ifdef USE_ARC}
procedure ARCI(centerx, centery, W, H, Sx, Sy, Ex, Ey: integer;
clockwise: boolean; arctype: TPdfCanvasArcType; var position: TPoint);
{$endif USE_ARC}
// wrapper call I2X() and I2Y() for conversion (points to origin+size)
function BoxI(Box: TRect; Normalize: boolean): TPdfBox; {$ifdef HASINLINE}inline;{$endif}
// wrapper call I2X() and I2Y() for conversion
procedure PointI(x, y: Single); {$ifdef HASINLINE}inline;{$endif}
function RectI(Rect: TRect; Normalize: boolean): TPdfRect;
procedure DrawXObjectPrepare(const AXObjectName: PDFString);
// wrappers about offset calculation
function ViewOffsetX(X: Single): Single;
function ViewOffsetY(Y: Single): Single;
function GetWorldFactorX: Single;
function GetWorldFactorY: Single;
property WorldFactorX: Single read GetWorldFactorX write FWorldFactorX;
property WorldFactorY: Single read GetWorldFactorY write FWorldFactorY;
// property getters
function GetDoc: TPdfDocument; {$ifdef HASINLINE}inline;{$endif}
function GetPage: TPdfPage; {$ifdef HASINLINE}inline;{$endif}
public
/// create the PDF canvas instance
constructor Create(APdfDoc: TPdfDocument);
/// pushes a copy of the entire graphics state onto the stack
procedure GSave; { q }
/// restores the entire graphics state to its former value by popping
// it from the stack
procedure GRestore; { Q }
/// Modify the CTM by concatenating the specified matrix
// - The current transformation matrix (CTM) maps positions from user
// coordinates to device coordinates
// - This matrix is modified by each application of the ConcatToCTM method
// - CTM Initial value is a matrix that transforms default user coordinates
// to device coordinates
// - since floating-point precision does make sense for a transformation
// matrix, we added a custom decimal number parameter here
procedure ConcatToCTM(a, b, c, d, e, f: Single; Decimals: Cardinal=6); { cm }
/// Set the flatness tolerance in the graphics state
// - see Section 6.5.1, "Flatness Tolerance" of the PDF 1.3 reference:
// The flatness tolerance controls the maximum permitted distance in
// device pixels between the mathematically correct path and an
// approximation constructed from straight line segments
// - Flatness is a number in the range 0 to 100; a value of 0 specifies
// the output device's default flatness tolerance
procedure SetFlat(flatness: Byte); { i }
/// Set the line cap style in the graphics state
// - The line cap style specifies the shape to be used at the
// ends of open subpaths (and dashes, if any) when they are stroked
procedure SetLineCap(linecap: TLineCapStyle); { J }
/// Set the line dash pattern in the graphics state
// - The line dash pattern controls the pattern of dashes and gaps
// used to stroke paths. It is specified by a dash array and a dash phase.
// The dash array's elements are numbers that specify the lengths of
// alternating dashes and gaps; the dash phase specifies the distance into
// the dash pattern at which to start the dash. The elements of both the
// dash array and the dash phase are expressed in user space units.
// Before beginning to stroke a path, the dash array is cycled through,
// adding up the lengths of dashes and gaps. When the accumulated length
// equals the value specified by the dash phase, stroking of the path begins,
// using the dash array cyclically from that point onward.
procedure SetDash(const aarray: array of integer; phase: integer=0); { d }
/// Set the line join style in the graphics state
// - The line join style specifies the shape to be used at the
// corners of paths that are stroked
procedure SetLineJoin(linejoin: TLineJoinStyle); { j }
/// Set the line width in the graphics state
// - The line width parameter specifies the thickness of the line used
// to stroke a path. It is a nonnegative number expressed in user space
// units; stroking a path entails painting all points whose perpendicular
// distance from the path in user space is less than or equal to half the
// line width. The effect produced in device space depends on the current
// transformation matrix (CTM) in effect at the time the path is stroked.
// If the CTM specifies scaling by different factors in the x and y
// dimensions, the thickness of stroked lines in device space will vary
// according to their orientation. The actual line width achieved can differ
// from the requested width by as much as 2 device pixels, depending on
// the positions of lines with respect to the pixel grid.
procedure SetLineWidth(linewidth: Single); { w }
/// Set the miter limit in the graphics state
// - When two line segments meet at a sharp angle and mitered joins have been
// specified as the line join style, it is possible for the miter to extend
// far beyond the thickness of the line stroking the path. The miter limit
// imposes a maximum on the ratio of the miter length to the line width.
// When the limit is exceeded, the join is converted from a miter to a bevel
procedure SetMiterLimit(miterlimit: Single); { M }
/// change the current coordinates position
// - Begin a new subpath by moving the current point to coordinates
// (x, y), omitting any connecting line segment. If the previous path
// construction operator in the current path was also MoveTo(), the new MoveTo()
// overrides it; no vestige of the previous MoveTo() call remains in the path.
procedure MoveTo(x, y: Single); { m }
/// Append a straight line segment from the current point to the point (x, y).
// - The new current point is (x, y)
procedure LineTo(x, y: Single); { l }
/// Append a cubic Bezier curve to the current path
// - The curve extends from the current point to the point (x3, y3),
// using (x1, y1) and (x2, y2) as the Bezier control points
// - The new current point is (x3, y3)
procedure CurveToC(x1, y1, x2, y2, x3, y3: Single); { c }
/// Append a cubic Bezier curve to the current path
// - The curve extends from the current point to the point (x3, y3),
// using the current point and (x2, y2) as the Bezier control points
// - The new current point is (x3, y3)
procedure CurveToV(x2, y2, x3, y3: Single); { v }
/// Append a cubic Bezier curve to the current path
// - The curve extends from the current point to the point (x3, y3),
// using (x1, y1) and (x3, y3) as the Bezier control points
// - The new current point is (x3, y3)
procedure CurveToY(x1, y1, x3, y3: Single); { y }
/// Append a rectangle to the current path as a complete subpath, with
// lower-left corner (x, y) and dimensions width and height in user space
procedure Rectangle(x, y, width, height: Single); { re }
/// Close the current subpath by appending a straight line segment
// from the current point to the starting point of the subpath
// - This operator terminates the current subpath; appending another
// segment to the current path will begin a new subpath, even if the new
// segment begins at the endpoint reached by the h operation
// - If the current subpath is already closed or the current path is empty,
// it does nothing
procedure Closepath; { h }
/// End the path object without filling or stroking it
// - This operator is a "path-painting no-op", used primarily for the
// side effect of changing the clipping path
procedure NewPath; { n }
/// Stroke the path
procedure Stroke; { S }
/// Close and stroke the path
// - This operator has the same effect as the sequence ClosePath; Stroke;
procedure ClosePathStroke; { s }
/// Fill the path, using the nonzero winding number rule to determine
// the region to fill
procedure Fill; { f }
/// Fill the path, using the even-odd rule to determine the region to fill
procedure EoFill; { f* }
/// Fill and then stroke the path, using the nonzero winding number rule
// to determine the region to fill
// - This produces the same result as constructing two identical path
// objects, painting the first with Fill and the second with Stroke. Note,
// however, that the filling and stroking portions of the operation consult
// different values of several graphics state parameters, such as the color
procedure FillStroke; { B }
/// Close, fill, and then stroke the path, using the nonzero winding number
// rule to determine the region to fill
// - This operator has the same effect as the sequence ClosePath; FillStroke;
procedure ClosepathFillStroke; { b }
/// Fill and then stroke the path, using the even-odd rule to determine
// the region to fill
// - This operator produces the same result as FillStroke, except that
// the path is filled as if with Eofill instead of Fill
procedure EofillStroke; { B* }
/// Close, fill, and then stroke the path, using the even-odd rule to
// determine the region to fill
// - This operator has the same effect as the sequence Closepath; EofillStroke;
procedure ClosepathEofillStroke; { b* }
/// Nonzero winding clipping path set
// - Modify the current clipping path by intersecting it with the current path,
// using the nonzero winding number rule to determine which regions
// lie inside the clipping path
// - The graphics state contains a clipping path that limits the regions of
// the page affected by painting operators. The closed subpaths of this path
// define the area that can be painted. Marks falling inside this area will
// be applied to the page; those falling outside it will not. (Precisely what
// is considered to be inside a path is discussed under "Filling", above.)
// - The initial clipping path includes the entire page. Both clipping path
// methods (Clip and EoClip) may appear after the last path construction operator
// and before the path-painting operator that terminates a path object.
// Although the clipping path operator appears before the painting operator,
// it does not alter the clipping path at the point where it appears. Rather,
// it modifies the effect of the succeeding painting operator. After the path
// has been painted, the clipping path in the graphics state is set to the
// intersection of the current clipping path and the newly constructed path.
procedure Clip; { W }
/// Even-Odd winding clipping path set
// - Modify the current clipping path by intersecting it with the current path,
// using the even-odd rule to determine which regions lie inside the clipping path
procedure EoClip; { W* }
/// Set the character spacing
// - CharSpace is a number expressed in unscaled text space units.
// - Character spacing is used by the ShowText and ShowTextNextLine methods
// - Default value is 0
procedure SetCharSpace(charSpace: Single); { Tc }
/// Set the word spacing
// - WordSpace is a number expressed in unscaled text space units
// - word spacing is used by the ShowText and ShowTextNextLine methods
// - Default value is 0
procedure SetWordSpace(wordSpace: Single); { Tw }
/// Set the horizontal scaling to (scale/100)
// - hScaling is a number specifying the percentage of the normal width
// - Default value is 100 (e.g. normal width)
procedure SetHorizontalScaling(hScaling: Single); { Tz }
/// Set the text leading, Tl, to the specified leading value
// - leading which is a number expressed in unscaled text space units;
// it specifies the vertical distance between the baselines of adjacent
// lines of text
// - Text leading is used only by the MoveToNextLine and ShowTextNextLine methods
// - you can force the next line to be just below the current one by calling:
// ! SetLeading(Attributes.FontSize);
// - Default value is 0
procedure SetLeading(leading: Single); { TL }
/// Set the font, Tf, to font and the font size, Tfs , to size.
// - font is the name of a font resource in the Font subdictionary of the
// current resource dictionary (e.g. 'F0')
// - size is a number representing a scale factor
// - There is no default value for either font or size; they must be specified
// using this method before any text is shown
procedure SetFontAndSize(const fontshortcut: PDFString; size: Single); { Tf }
{$ifdef HASINLINE}inline;{$endif}
/// Set the text rendering mode
// - the text rendering mode determines whether text is stroked, filled,
// or used as a clipping path
procedure SetTextRenderingMode(mode: TTextRenderingMode); { Tr }
/// Set the text rise, Trise, to the specified value
// - rise is a number expressed in unscaled text space units, which
// specifies the distance, in unscaled text space units, to move the
// baseline up or down from its default location. Positive values of
// text rise move the baseline up. Adjustments to the baseline are
// useful for drawing superscripts or subscripts. The default location of
// the baseline can be restored by setting the text rise to 0.
// - Default value is 0
procedure SetTextRise(rise: word); { Ts }
/// Begin a text object
// - Text objects cannot be nested
procedure BeginText; {$ifdef HASINLINE}inline;{$endif} { BT }
/// End a text object, discarding the text matrix
procedure EndText; {$ifdef HASINLINE}inline;{$endif} { ET }
/// Move to the start of the next line, offset from the start of the current
// line by (tx ,ty)
// - tx and ty are numbers expressed in unscaled text space units
procedure MoveTextPoint(tx, ty: Single); {$ifdef HASINLINE}inline;{$endif} { Td }
/// set the Text Matrix to a,b,c,d and the text line Matrix x,y
procedure SetTextMatrix(a, b, c, d, x, y: Single); { Tm }
/// Move to the start of the next line
procedure MoveToNextLine; { T* }
{$ifdef HASVARUSTRING}
/// Show a text string
// - text is expected to be Unicode encoded
// - if NextLine is TRUE, moves to the next line and show a text string;
// in this case, method as the same effect as MoveToNextLine; ShowText(s);
procedure ShowText(const text: UnicodeString; NextLine: boolean=false); overload; inline; { Tj or ' }
{$endif}
/// Show a text string
// - text is expected to be Ansi-Encoded, in the current CharSet; if
// some Unicode or MBCS conversion is necessary, it will be notified to the
// corresponding
// - if NextLine is TRUE, moves to the next line and show a text string;
// in this case, method as the same effect as MoveToNextLine; ShowText(s);
procedure ShowText(const text: PDFString; NextLine: boolean=false); overload; { Tj or ' }
/// Show an Unicode Text string
// - if NextLine is TRUE, moves to the next line and show a text string;
// in this case, method as the same effect as MoveToNextLine; ShowText(s);
procedure ShowText(PW: PWideChar; NextLine: boolean=false); overload;
{$ifdef HASINLINE}inline;{$endif}
/// Show an Unicode Text string, encoded as Glyphs or the current font
// - PW must follow the ETO_GLYPH_INDEX layout, i.e. refers to an array as
// returned from the GetCharacterPlacement: all glyph indexes are 16-bit values
procedure ShowGlyph(PW: PWord; Count: integer); {$ifdef HASINLINE}inline;{$endif}
/// Paint the specified XObject
procedure ExecuteXObject(const xObject: PDFString); { Do }
/// Set the color space to a Device-dependent RGB value
// - this method set the color to use for nonstroking operations
procedure SetRGBFillColor(Value: TPdfColor); { rg }
/// Set the color space to a Device-dependent RGB value
// - this method set the color to use for stroking operations
procedure SetRGBStrokeColor(Value: TPdfColor); { RG }
/// Set the color space to a CMYK percent value
// - this method set the color to use for nonstroking operations
procedure SetCMYKFillColor(C, M, Y, K: integer); { k }
/// Set the color space to a CMYK value
// - this method set the color to use for stroking operations
procedure SetCMYKStrokeColor(C, M, Y, K: integer); { K }
/// assign the canvas to the specified page
procedure SetPage(APage: TPdfPage); virtual;
/// set the current font for the PDF Canvas
procedure SetPDFFont(AFont: TPdfFont; ASize: Single);
/// set the current font for the PDF Canvas
// - expect the font name to be either a standard embedded font
// ('Helvetica','Courier','Times') or its Windows equivalency (i.e.
// 'Arial','Courier New','Times New Roman'), either a UTF-8 encoded
// True Type font name available on the system
// - if no CharSet is specified (i.e. if it remains -1), the current document
// CharSet parameter is used
function SetFont(const AName: RawUTF8; ASize: Single; AStyle: TPdfFontStyles;
ACharSet: integer=-1; AForceTTF: integer=-1; AIsFixedWidth: boolean=false): TPdfFont; overload;
/// set the current font for the PDF Canvas
// - this method use the Win32 structure that defines the characteristics
// of the logical font
function SetFont(ADC: HDC; const ALogFont: TLogFontW; ASize: single): TPdfFont; overload;
/// show some text at a specified page position
procedure TextOut(X, Y: Single; const Text: PDFString);
/// show some unicode text at a specified page position
procedure TextOutW(X, Y: Single; PW: PWideChar);
/// show the text in the specified rectangle and alignment
// - optional clipping can be applied
procedure TextRect(ARect: TPdfRect; const Text: PDFString;
Alignment: TPdfAlignment; Clipping: boolean);
/// show the text in the specified rectangle and alignment
// - text can be multiline, separated by CR + LF (i.e. #13#10)
// - text can optionaly word wrap
// - note: this method only work with embedded fonts by now, not true type
// fonts (because it use text width measuring)
procedure MultilineTextRect(ARect: TPdfRect;
const Text: PDFString; WordWrap: boolean);
/// draw the specified object (typicaly an image) with stretching
procedure DrawXObject(X, Y, AWidth, AHeight: Single;
const AXObjectName: PDFString);
/// draw the specified object (typicaly an image) with stretching and clipping
procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
ClipX, ClipY, ClipWidth, ClipHeight: Single; const AXObjectName: PDFString);
/// draw an ellipse
// - use Bezier curves internaly to draw the ellipse
procedure Ellipse(x, y, width, height: Single);
/// draw a rounded rectangle
// - use Bezier curves internaly to draw the rounded rectangle
procedure RoundRect(x1,y1,x2,y2,cx,cy: Single);
/// calculate width of specified text according to current Canvas attributes
// - works with MBCS strings
function TextWidth(const Text: PDFString): Single;
/// calculate width of specified text according to current Canvas attributes
// - this function compute the raw width of the specified text, and won't
// use HorizontalScaling, CharSpace nor WordSpace in its calculation
function UnicodeTextWidth(PW: PWideChar): Single;
/// calculate the number of chars which can be displayed in the specified
// width, according to current attributes
// - this function is compatible with MBCS strings, and returns
// the index in Text, not the glyphs index
// - note: this method only work with embedded fonts by now, not true type
// fonts (because text width measuring is not yet implemented for them)
function MeasureText(const Text: PDFString; AWidth: Single): integer;
/// get the index of the next word in the supplied text
// - this function is compatible with MBCS strings, and returns
// the index in Text, not the glyphs index
function GetNextWord(const S: PDFString; var Index: integer): PDFString;
{$ifdef USE_METAFILE}
/// draw a metafile content into the PDF page
// - not 100% of content is handled yet, but most common are (even
// metafiles embedded inside metafiles)
// - UseSetTextJustification is to be set to true to ensure better rendering
// if the EMF content used SetTextJustification() API call to justify text
// - KerningHScaleBottom/KerningHScaleTop are limits below which and over
// which Font Kerning is transformed into PDF Horizontal Scaling commands
// - TextClipping can be set to fix some issues e.g. when using Wine
procedure RenderMetaFile(MF: TMetaFile; ScaleX: Single=1.0; ScaleY: Single=0.0;
XOff: single=0.0; YOff: single=0.0;
TextPositioning: TPdfCanvasRenderMetaFileTextPositioning=tpSetTextJustification;
KerningHScaleBottom: single=99.0; KerningHScaleTop: single=101.0;
TextClipping: TPdfCanvasRenderMetaFileTextClipping=tcAlwaysClip);
{$endif USE_METAFILE}
// starts optional content (layer)
// - Group must be registered with TPdfDocument.CreateOptionalContentGroup
// - each BeginMarkedContent must have a corresponding EndMarkedContent
// - nested BeginMarkedContent/EndMarkedContent are possible
procedure BeginMarkedContent(Group: TPdfOptionalContentGroup);
// ends optional content (layer)
procedure EndMarkedContent;
public
/// retrieve the current Canvas content stream, i.e. where the PDF
// commands are to be written to
property Contents: TPdfStream read FContents;
/// retrieve the current Canvas Page
property Page: TPdfPage read GetPage;
/// retrieve the associated PDF document instance which created this Canvas
property Doc: TPdfDocument read GetDoc;
{$ifdef USE_UNISCRIBE}
/// if Uniscribe-related methods must handle the text from right to left
property RightToLeftText: Boolean read fRightToLeftText write fRightToLeftText;
{$endif}
end;
/// common ancestor to all dictionary wrapper classes
TPdfDictionaryWrapper = class(TPersistent)
private
FData: TPdfDictionary;
function GetHasData: boolean;
protected
procedure SetData(AData: TPdfDictionary);
public
/// the associated dictionary, containing all data
property Data: TPdfDictionary read FData write SetData;
/// return TRUE if has any data stored within
property HasData: boolean read GetHasData;
end;
/// defines the data stored inside a EMR_GDICOMMENT message
// - pgcOutline can be used to add an outline at the current position (i.e.
// the last Y parameter of a Move): the text is the associated title, UTF-8 encoded
// and the outline tree is created from the number of leading spaces in the title
// - pgcBookmark will create a destination at the current position (i.e.
// the last Y parameter of a Move), with some text supplied as bookmark name
// - pgcLink/pgcLinkNoBorder will create a asLink annotation, expecting the data
// to be filled with TRect inclusive-inclusive bounding rectangle coordinates,
// followed by the corresponding bookmark name
// - use the GDIComment*() functions to append the corresponding
// EMR_GDICOMMENT message to a metafile content
TPdfGDIComment =
(pgcOutline, pgcBookmark, pgcLink, pgcLinkNoBorder);
/// a dictionary wrapper class for the PDF document information fields
// - all values use the generic VCL string type, and will be encoded
// as Unicode if necessary
TPdfInfo = class(TPdfDictionaryWrapper)
private
function GetAuthor: string;
procedure SetAuthor(const Value: string);
function GetCreationDate: TDateTime;
procedure SetCreationDate(Value: TDateTime);
function GetCreator: string;
procedure SetCreator(const Value: string);
function GetKeywords: string;
procedure SetKeywords(const Value: string);
function GetSubject: string;
procedure SetSubject(const Value: string);
function GetTitle: string;
procedure SetTitle(const Value: string);
function GetModDate: TDateTime;
procedure SetModDate(Value: TDateTime);
public
/// the PDF document Author
property Author: string read GetAuthor write SetAuthor;
/// the PDF document Creation Date
property CreationDate: TDateTime read GetCreationDate write SetCreationDate;
/// the Software or Library name which created this PDF document
property Creator: string read GetCreator write SetCreator;
/// the PDF document associated key words
property Keywords: string read GetKeywords write SetKeywords;
/// the PDF document modification date
property ModDate: TDateTime read GetModDate write SetModDate;
/// the PDF document subject
property Subject: string read GetSubject write SetSubject;
/// the PDF document title
property Title: string read GetTitle write SetTitle;
end;
/// a dictionary wrapper class for the PDF document catalog fields
// - It contains references to other objects defining the document's contents,
// outline, article threads (PDF 1.1), named destinations, and other attributes.
// In addition, it contains information about how the document should be displayed
// on the screen, such as whether its outline and thumbnail page images should be
// displayed automatically and whether some location other than the first page
// should be shown when the document is opened
TPdfCatalog = class(TPdfDictionaryWrapper)
private
FOpenAction: TPdfDestination;
FOwner: TPdfDocument;
procedure SetPageLayout(Value: TPdfPageLayout);
procedure SetPageMode(Value: TPdfPageMode);
procedure SetNonFullScreenPageMode(Value: TPdfPageMode);
procedure SetViewerPreference(Value: TPdfViewerPreferences);
procedure SetPages(APages: TPdfDictionary);
function GetPageLayout: TPdfPageLayout;
function GetPageMode: TPdfPageMode;
function GetNonFullScreenPageMode: TPdfPageMode;
function GetViewerPreference: TPdfViewerPreferences;
function GetPages: TPdfDictionary;
protected
procedure SaveOpenAction;
public
/// a Destination to be displayed when the document is opened
property OpenAction: TPdfDestination read FOpenAction write FOpenAction;
/// The page layout to be used when the document is opened
property PageLayout: TPdfPageLayout read GetPageLayout write SetPageLayout;
/// Page mode determines how the document should appear when opened
property NonFullScreenPageMode: TPdfPageMode read GetNonFullScreenPageMode write SetNonFullScreenPageMode;
/// Page mode determines how the document should appear when opened
property PageMode: TPdfPageMode read GetPageMode write SetPageMode;
/// A viewer preferences dictionary specifying the way the document is to be
// displayed on the screen
// - If this entry is absent, viewer applications should use their own current
// user preference settings
property ViewerPreference: TPdfViewerPreferences read GetViewerPreference write SetViewerPreference;
/// The page tree node that is the root of the document's page tree
// - Required, must be an indirect reference
// - you can set a value to it in order to add some nested pages
property Pages: TPdfDictionary read GetPages write SetPages;
end;
/// a generic PDF font object
TPdfFont = class(TPdfDictionaryWrapper)
protected
fName: PDFString;
fShortCut: PDFString;
fFirstChar, fLastChar: integer;
fDefaultWidth: word;
fAscent, fDescent: integer;
fUnicode: boolean;
/// index in TrueTypeFontsIndex[] + 1, 0 if not a TPdfFontTrueType
// - same TPdfFontTrueType index may appear multiple times in the font list,
// e.g. with normal, bold and/or italic attributes
// - this hidden property is used by TPdfDocument for faster font list handling
fTrueTypeFontsIndex: integer;
/// contains a bit for every WinAnsi encoded char
// - encoding in TPdfFont, even if used by TPdfFontWinAnsi descendent only
fWinAnsiUsed: set of AnsiChar;
public
/// create the PDF font object instance
constructor Create(AXref: TPdfXref; const AName: PDFString);
/// mark some WinAnsi char as used
procedure AddUsedWinAnsiChar(aChar: AnsiChar); {$ifdef HASINLINE}inline;{$endif}
/// retrieve the width of a specified character
// - implementation of this method is either WinAnsi (by TPdfFontWinAnsi),
// either compatible with MBCS strings (TPdfFontCIDFontType2)
// - return 0 by default (descendant must handle the Ansi charset)
function GetAnsiCharWidth(const AText: PDFString; APos: integer): integer; virtual;
/// the internal PDF font name (e.g. 'Helvetica-Bold')
// - postscript font names are inside the unit: these postscript names
// could not match the "official" True Type font name, stored as
// UTF-8 in FTrueTypeFonts
property Name: PDFString read FName;
/// the internal PDF shortcut (e.g. 'F3')
property ShortCut: PDFString read FShortCut;
/// is set to TRUE if the font is dedicated to Unicode Chars
property Unicode: boolean read fUnicode;
end;
PPdfWinAnsiWidth = ^TPdfWinAnsiWidth;
TPdfWinAnsiWidth = array[#32..#255] of word;
/// a generic PDF font object, handling at least WinAnsi encoding
// - TPdfFontTrueType descendent will handle also Unicode chars,
// for all WideChar which are outside the WinAnsi selection
TPdfFontWinAnsi = class(TPdfFont)
protected
/// contain the Width array of the corresponding WinAnsi encoded char
fWinAnsiWidth: PPdfWinAnsiWidth;
public
/// retrieve the width of a specified character
// - implementation of this method expect WinAnsi encoding
// - return the value contained in fWinAnsiWidth[] by default
function GetAnsiCharWidth(const AText: PDFString; APos: integer): integer; override;
/// release the used memory
destructor Destroy; override;
end;
/// an embedded WinAnsi-Encoded standard Type 1 font
// - handle Helvetica, Courier and Times font by now
TPdfFontType1 = class(TPdfFontWinAnsi)
protected
public
/// create a standard font instance, with a given name and char widths
// - if WidthArray is nil, it will create a fixed-width font of 600 units
// - WidthArray[0]=Ascent, WidthArray[1]=Descent, WidthArray[2..]=Width(#32..)
constructor Create(AXref: TPdfXref; const AName: PDFString;
WidthArray: PSmallIntArray); reintroduce;
end;
/// an embedded Composite CIDFontType2
// - i.e. a CIDFont whose glyph descriptions are based on TrueType font technology
// - typicaly handle Japan or Chinese standard fonts
// - used with MBCS encoding, not WinAnsi
TPdfFontCIDFontType2 = class(TPdfFont)
{ TODO: implement standard TPdfFontCIDFontType2 MBCS font }
end;
/// handle Unicode glyph description for a True Type Font
// - cf http://www.microsoft.com/typography/OTSPEC/otff.htm#otttables
// - handle Microsoft cmap format 4 encoding (i.e. most used
// true type fonts on Windows)
TPdfTTF = class
protected
// we use TWordDynArray for auto garbage collection and generic handling
// - since the TTF file is big endian, we swap all words at loading, to
// be used directly by the Intel x86 code; integer (longint) values
// must take care of this byte swapping
fcmap,
fhead,
fhhea,
fhmtx: TWordDynArray;
public
// these are pointers to the useful data of the True Type Font:
/// Font header
head: ^TCmapHEAD;
/// Horizontal header
hhea: ^TCmapHHEA;
/// Character to glyph mapping (cmap) table, in format 4
fmt4: ^TCmapFmt4;
/// Start character code for each cmap format 4 segment
startCode: PWordArray;
/// End characterCode for each cmap format 4 segment
endCode: PWordArray;
/// Delta for all character codes in each cmap format 4 segment
idDelta: PSmallIntArray;
/// Offsets into glyphIndexArray or 0
idRangeOffset: PWordArray;
/// Glyph index array (arbitrary length)
glyphIndexArray: PWordArray;
public
/// create Unicode glyph description for a supplied True Type Font
// - the HDC of its corresponding document must have selected the font first
// - this constructor will fill fUsedWide[] and fUsedWideChar of aUnicodeTTF
// with every available unicode value, and its corresponding glyph and width
constructor Create(aUnicodeTTF: TPdfFontTrueType); reintroduce;
end;
/// this dynamic array stores details about used unicode characters
// - every used unicode character has its own width and glyph index in the
// true type font content
TUsedWide = array of packed record
case byte of
0: (
Width: word;
Glyph: word; );
1: (
Int: integer; );
end;
/// handle TrueType Font
// - handle both WinAnsi text and Unicode characters in two separate
// TPdfFontTrueType instances (since PDF need two separate fonts with
// diverse encoding)
TPdfFontTrueType = class(TPdfFontWinAnsi)
private
function GetWideCharUsed: Boolean; {$ifdef HASINLINE}inline;{$endif}
protected
fStyle: TPdfFontStyles;
fDoc: TPdfDocument;
// note: fUsedWide[] and fUsedWideChar are used:
// - in WinAnsi Fonts for glyphs used by ShowText
// - in Unicode Fonts for all available glyphs from TPdfTTF values
fUsedWideChar: TSortedWordArray;
fUsedWide: TUsedWide;
fHGDI: HGDIOBJ;
fFixedWidth: boolean;
fFontDescriptor: TPdfDictionary;
fFontFile2: TPdfStream;
fUnicodeFont: TPdfFontTrueType;
fWinAnsiFont: TPdfFontTrueType;
fIsSymbolFont: Boolean;
// below are some bigger structures
fLogFont: TLogFontW;
fM: TTextMetric;
fOTM: TOutlineTextmetric;
procedure CreateAssociatedUnicodeFont;
// update font description from used chars
procedure PrepareForSaving;
// low level adding of a glyph (returns the real glyph index found, 0 if none)
function GetAndMarkGlyphAsUsed(aGlyph: word): word;
public
/// create the TrueType font object instance
constructor Create(ADoc: TPdfDocument; AFontIndex: integer;
AStyle: TPdfFontStyles; const ALogFont: TLogFontW; AWinAnsiFont: TPdfFontTrueType); reintroduce;
/// release the associated memory and handles
destructor Destroy; override;
/// mark some UTF-16 codepoint as used
// - return the index in fUsedWideChar[] and fUsedWide[]
// - this index is the one just added, or the existing one if the value
// was found to be already in the fUserWideChar[] array
function FindOrAddUsedWideChar(aWideChar: WideChar): integer;
/// retrieve the width of an UTF-16 codepoint
// - WinAnsi characters are taken from fWinAnsiWidth[], unicode chars from
// fUsedWide[].Width
function GetWideCharWidth(aWideChar: WideChar): Integer;
/// is set to TRUE if the PDF used any true type encoding
property WideCharUsed: Boolean read GetWideCharUsed;
/// the associated Font Styles
property Style: TPdfFontStyles read fStyle;
/// is set to TRUE if the font has a fixed width
property FixedWidth: boolean read fFixedWidth;
/// points to the corresponding Unicode font
// - returns NIL if the Unicode font has not yet been created by the
// CreateUnicodeFont method
// - may return SELF if the font is itself the Unicode version
property UnicodeFont: TPdfFontTrueType read fUnicodeFont;
/// points to the corresponding WinAnsi font
// - always return a value, whatever it is self
property WinAnsiFont: TPdfFontTrueType read fWinAnsiFont;
end;
/// A destination defines a particular view of a document, consisting of the following:
// - The page of the document to be displayed
// - The location of the display window on that page
// - The zoom factor to use when displaying the page
TPdfDestination = class(TObject)
private
FDoc: TPdfDocument;
FPage: TPdfPage;
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
/// create the PDF destination object
// - the current document page is associated with this destination
constructor Create(APdfDoc: TPdfDocument);
/// release the object
destructor Destroy; override;
/// retrieve the array containing the location of the display window
// - the properties values which are not used are ignored
function GetValue: TPdfArray;
/// Destination Type determines default user space coordinate system of
// Explicit destinations
property DestinationType: TPdfDestinationType read FType write FType;
/// the associated PDF document which created this Destination object
property Doc: TPdfDocument read FDoc;
/// the associated Page
property Page: TPdfPage read FPage;
/// retrieve the left coordinate of the location of the display window
property Left: Integer index 0 read GetElement write SetElement;
/// retrieve the top coordinate of the location of the display window
property Top: Integer index 1 read GetElement write SetElement;
/// retrieve the righ tcoordinate of the location of the display window
property Right: Integer index 2 read GetElement write SetElement;
/// retrieve the bottom coordinate of the location of the display window
property Bottom: Integer index 3 read GetElement write SetElement;
/// the page height of the current page
// - return the corresponding MediaBox value
property PageHeight: Integer read GetPageHeight;
/// the page width of the current page
// - return the corresponding MediaBox value
property PageWidth: Integer read GetPageWidth;
/// the associated Zoom factor
// - by default, the Zoom factor is 1
property Zoom: Single read FZoom write SetZoom;
/// an object associated to this destination, to be used for conveniance
property Reference: TObject read FReference write FReference;
end;
/// an Outline entry in the PDF document
TPdfOutlineEntry = class(TPdfDictionaryWrapper)
private
FParent: TPdfOutlineEntry;
FNext: TPdfOutlineEntry;
FPrev: TPdfOutlineEntry;
FFirst: TPdfOutlineEntry;
FLast: TPdfOutlineEntry;
FDest: TPdfDestination;
FDoc: TPdfDocument;
FTitle: string;
FOpened: boolean;
FCount: integer;
FReference: TObject;
FLevel: integer;
protected
procedure Save; virtual;
public
/// create the Outline entry instance
// - if TopPosition is set, a corresponding destination is created
// on the current PDF Canvas page, at this Y position
constructor Create(AParent: TPdfOutlineEntry;
TopPosition: integer=-1); reintroduce;
/// release the associated memory and reference object
destructor Destroy; override;
/// create a new entry in the outline tree
// - this is the main method to create a new entry
function AddChild(TopPosition: integer=-1): TPdfOutlineEntry;
/// the associated PDF document which created this Destination object
property Doc: TPdfDocument read FDoc;
/// the parent outline entry of this entry
property Parent: TPdfOutlineEntry read FParent;
/// the next outline entry of this entry
property Next: TPdfOutlineEntry read FNext;
/// the previous outline entry of this entry
property Prev: TPdfOutlineEntry read FPrev;
/// the first outline entry of this entry list
property First: TPdfOutlineEntry read FFirst;
/// the last outline entry of this entry list
property Last: TPdfOutlineEntry read FLast;
/// the associated destination
property Dest: TPdfDestination read FDest write FDest;
/// the associated title
// - is a generic VCL string, so is Unicode ready
property Title: string read FTitle write FTitle;
/// if the outline must be opened
property Opened: boolean read FOpened write FOpened;
/// an object associated to this destination, to be used for conveniance
property Reference: TObject read FReference write FReference;
/// an internal property (not exported to PDF content)
property Level: integer read FLevel write FLevel;
end;
/// Root entry for all Outlines of the PDF document
// - this is a "fake" entry which must be used as parent for all true
// TPdfOutlineEntry instances, but must not be used as a true outline entry
TPdfOutlineRoot = class(TPdfOutlineEntry)
public
/// create the Root entry for all Outlines of the PDF document
constructor Create(ADoc: TPdfDocument); reintroduce;
/// update internal parameters (like outline entries count) before saving
procedure Save; override;
end;
{$ifdef USE_METAFILE}
/// a PDF page, with its corresponding Meta File and Canvas
TPdfPageGDI = class(TPdfPage)
private
// don't use these fVCL* properties directly, but via TPdfDocumentGdi.VCLCanvas
fVCLMetaFileCompressed: RawByteString;
fVCLCanvasSize: TSize;
// it is in fact a TMetaFileCanvas instance from fVCLCurrentMetaFile
fVCLCurrentCanvas: TCanvas;
fVCLCurrentMetaFile: TMetaFile;
// allow to create the meta file and its canvas only if necessary, and
// compress the page content using SynLZ to reduce memory usage
procedure CreateVCLCanvas;
procedure SetVCLCurrentMetaFile;
procedure FlushVCLCanvas;
public
/// release associated memory
destructor Destroy; override;
end;
/// class handling PDF document creation using GDI commands
// - this class allows using a VCL standard Canvas class
// - handles also PDF creation directly from TMetaFile content
TPdfDocumentGDI = class(TPdfDocument)
private
fUseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning;
fUseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping;
fKerningHScaleTop: Single;
fKerningHScaleBottom: Single;
function GetVCLCanvas: TCanvas; {$ifdef HASINLINE}inline;{$endif}
function GetVCLCanvasSize: TSize; {$ifdef HASINLINE}inline;{$endif}
public
/// create the PDF document instance, with a VCL Canvas property
// - see TPdfDocument.Create connstructor for the arguments expectations
constructor Create(AUseOutlines: Boolean=false; ACodePage: integer=0;
APDFA1: boolean=false
{$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption=nil{$endif});
/// add a Page to the current PDF document
function AddPage: TPdfPage; override;
/// save the PDF file content into a specified Stream
// - this overridden method draw first the all VCLCanvas content into the PDF
procedure SaveToStream(AStream: TStream; ForceModDate: TDateTime=0); override;
/// save the current page content to the PDF file
// - this overridden method flush the content from the VCLCanvas into the PDF
// - it will reduce the used memory as much as possible, by-passing page
// content compression
// - typical use may be:
// ! with TPdfDocumentGDI.Create do
// ! try
// ! Stream := TFileStream.Create(FileName, fmCreate);
// ! try
// ! SaveToStreamDirectBegin(Stream);
// ! for i := 1 to 9 do
// ! begin
// ! AddPage;
// ! with VCLCanvas do
// ! begin
// ! Font.Name := 'Times new roman';
// ! Font.Size := 150;
// ! Font.Style := [fsBold, fsItalic];
// ! Font.Color := clNavy;
// ! TextOut(100, 100, 'Page ' + IntToStr(i));
// ! end;
// ! SaveToStreamDirectPageFlush; // direct writing
// ! end;
// ! SaveToStreamDirectEnd;
// ! finally
// ! Stream.Free;
// ! end;
// ! finally
// ! Free;
// ! end;
procedure SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean=false); override;
/// the VCL Canvas of the current page
property VCLCanvas: TCanvas read GetVCLCanvas;
/// the VCL Canvas size of the current page
// - useful to calculate coordinates for the current page
// - filled with (0,0) before first call to VCLCanvas property
property VCLCanvasSize: TSize read GetVCLCanvasSize;
/// defines how TMetaFile text positioning is rendered
// - default is tpSetTextJustification
// - tpSetTextJustification if content used SetTextJustification() API calls
// - tpExactTextCharacterPositining for exact font kerning, but resulting
// in bigger pdf size
// - tpKerningFromAveragePosition will compute average pdf Horizontal Scaling
// in association with KerningHScaleBottom/KerningHScaleTop properties
// - replace deprecated property UseSetTextJustification
property UseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning
read fUseMetaFileTextPositioning write fUseMetaFileTextPositioning;
/// defines how TMetaFile text clipping should be applied
// - tcNeverClip has been reported to work better e.g. when app is running
// on Wine
property UseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping
read fUseMetaFileTextClipping write fUseMetaFileTextClipping;
/// the % limit below which Font Kerning is transformed into PDF Horizontal
// Scaling commands (when text positioning is tpKerningFromAveragePosition)
// - set to 99.0 by default
property KerningHScaleBottom: Single read fKerningHScaleBottom write fKerningHScaleBottom;
/// the % limit over which Font Kerning is transformed into PDF Horizontal
// Scaling commands (when text positioning is tpKerningFromAveragePosition)
// - set to 101.0 by default
property KerningHScaleTop: Single read fKerningHScaleTop write fKerningHScaleTop;
end;
{$endif USE_METAFILE}
{$ifdef USE_BITMAP}
/// generic image object
// - is either bitmap encoded or jpeg encoded
TPdfImage = class(TPdfXObject)
private
fPixelHeight: Integer;
fPixelWidth: Integer;
fHash: THash128Rec;
public
/// create the image from a supplied VCL TGraphic instance
// - handle TBitmap and SynGdiPlus picture types, i.e. TJpegImage
// (stored as jpeg), and TGifImage/TPngImage (stored as bitmap)
// - use TPdfForm to handle TMetafile in vectorial format
// - an optional DontAddToFXref is available, if you don't want to add
// this object to the main XRef list of the PDF file
constructor Create(aDoc: TPdfDocument; aImage: TGraphic; DontAddToFXref: boolean); reintroduce;
/// create an image from a supplied JPEG file name
// - will raise an EFOpenError exception if the file doesn't exist
// - an optional DontAddToFXref is available, if you don't want to add
// this object to the main XRef list of the PDF file
constructor CreateJpegDirect(aDoc: TPdfDocument; const aJpegFileName: TFileName;
DontAddToFXref: boolean=true); reintroduce; overload;
/// create an image from a supplied JPEG content
// - an optional DontAddToFXref is available, if you don't want to add
// this object to the main XRef list of the PDF file
constructor CreateJpegDirect(aDoc: TPdfDocument; aJpegFile: TMemoryStream;
DontAddToFXref: boolean=true); reintroduce; overload;
/// width of the image, in pixels units
property PixelWidth: Integer read fPixelWidth;
/// height of the image, in pixels units
property PixelHeight: Integer read fPixelHeight;
end;
{$endif USE_BITMAP}
{$ifdef USE_METAFILE}
/// handle any form XObject
// - A form XObject (see Section 4.9, of PDF reference 1.3) is a self-contained
// description of an arbitrary sequence of graphics objects, defined as a
// PDF content stream
TPdfForm = class(TPdfXObject)
private
FFontList: TPdfDictionary;
public
/// create a form XObject from a supplied TMetaFile
constructor Create(aDoc: TPdfDocumentGDI; aMetaFile: TMetafile); reintroduce;
end;
{$endif USE_METAFILE}
/// a form XObject with a Canvas for drawing
// - once created, you can create this XObject, then draw it anywhere on
// any page - see sample
TPdfFormWithCanvas = class(TPdfXObject)
private
FFontList: TPdfDictionary;
FPage: TPdfPage;
FCanvas: TPdfCanvas;
public
/// create a form XObject with TPDFCanvas
constructor Create(aDoc: TPdfDocument; W, H: Integer); reintroduce;
/// release used memory
destructor Destroy; override;
/// close the internal canvas
procedure CloseCanvas;
/// access to the private canvas associated with the PDF form XObject
property Canvas: TPdfCanvas read FCanvas;
end;
/// used to handle compressed object stream (in PDF 1.5 format)
TPdfObjectStream = class(TPdfXObject)
protected
fObjectCount: integer;
fAddingStream: TPdfWrite;
fObject: array of record
Number: integer;
Position: integer;
end;
procedure InternalWriteTo(W: TPdfWrite); override;
public
/// create the instance, i.e. its associated stream
constructor Create(aDoc: TPdfDocument); reintroduce;
/// release internal memory structures
destructor Destroy; override;
/// add an object to this compressed object stream
// - returns the object index in this object stream
function AddObject(Value: TPdfObject): integer;
/// the number of compressed objects within this object stream
property ObjectCount: integer read fObjectCount;
end;
/// this function returns TRUE if the supplied text contain any MBCS character
// - typical call must check first if MBCS is currently enabled
// ! if SysLocale.FarEast and _HasMultiByteString(pointer(Text)) then ...
function _HasMultiByteString(Value: PAnsiChar): boolean;
/// convert a specified UTF-8 content into a PDFString value
function RawUTF8ToPDFString(const Value: RawUTF8): PDFString;
/// convert an unsigned integer into a PDFString text
function UInt32ToPDFString(Value: Cardinal): PDFString;
/// convert a date, into PDF string format, i.e. as 'D:20100414113241Z'
function _DateTimeToPdfDate(ADate: TDateTime): TPdfDate;
/// decode PDF date, encoded as 'D:20100414113241'
function _PdfDateToDateTime(const AText: TPdfDate): TDateTime;
/// wrapper to create a temporary PDF coordinates rectangle
function PdfRect(Left, Top, Right, Bottom: Single): TPdfRect; overload; {$ifdef HASINLINE}inline;{$endif}
/// wrapper to create a temporary PDF coordinates rectangle
function PdfRect(const Box: TPdfBox): TPdfRect; overload; {$ifdef HASINLINE}inline;{$endif}
/// wrapper to create a temporary PDF box
function PdfBox(Left, Top, Width, Height: Single): TPdfBox; {$ifdef HASINLINE}inline;{$endif}
/// reverse char orders for every hebrew and arabic words
// - just reverse all the UTF-16 codepoints in the supplied buffer
procedure L2R(W: PWideChar; L: integer);
/// convert some milli meters dimension to internal PDF twips value
function PdfCoord(MM: single): integer;
{$ifdef HASINLINE}inline;{$endif}
/// retrieve the paper size used by the current selected printer
function CurrentPrinterPaperSize: TPDFPaperSize;
/// retrieve the current printer resolution
function CurrentPrinterRes: TPoint;
/// append a EMR_GDICOMMENT message for handling PDF bookmarks
// - will create a PDF destination at the current position (i.e. the last Y
// parameter of a Move), with some text supplied as bookmark name
procedure GDICommentBookmark(MetaHandle: HDC; const aBookmarkName: RawUTF8);
/// append a EMR_GDICOMMENT message for handling PDF outline
// - used to add an outline at the current position (i.e. the last Y parameter of
// a Move): the text is the associated title, UTF-8 encoded and the outline tree
// is created from the specified numerical level (0=root)
procedure GDICommentOutline(MetaHandle: HDC; const aTitle: RawUTF8; aLevel: Integer);
/// append a EMR_GDICOMMENT message for creating a Link into a specified bookmark
procedure GDICommentLink(MetaHandle: HDC; const aBookmarkName: RawUTF8; const aRect: TRect;
NoBorder: boolean);
{$ifdef USE_PDFSECURITY}
const
/// allow all actions for a pdf encrypted file
// - to be used as parameter for TPdfEncryption.New() class method
PDF_PERMISSION_ALL: TPdfEncryptionPermissions =
[Low(TPdfEncryptionPermission)..high(TPdfEncryptionPermission)];
/// disable modification and annotation of a pdf encrypted file
// - to be used as parameter for TPdfEncryption.New() class method
PDF_PERMISSION_NOMODIF: TPdfEncryptionPermissions = [epPrinting,
epContentCopy, epPrintingHighResolution, epFillingForms,
epContentExtraction, epDocumentAssembly];
/// disable printing for a pdf encrypted file
// - to be used as parameter for TPdfEncryption.New() class method
PDF_PERSMISSION_NOPRINT: TPdfEncryptionPermissions = [epGeneralEditing,
epContentCopy, epAuthoringComment, epContentExtraction, epDocumentAssembly];
/// disable content extraction or copy for a pdf encrypted file
// - to be used as parameter for TPdfEncryption.New() class method
PDF_PERMISSION_NOCOPY: TPdfEncryptionPermissions = [epPrinting,
epAuthoringComment, epPrintingHighResolution, epFillingForms];
/// disable printing and content extraction or copy for a pdf encrypted file
// - to be used as parameter for TPdfEncryption.New() class method
PDF_PERMISSION_NOCOPYNORPRINT: TPdfEncryptionPermissions = [];
{$endif USE_PDFSECURITY}
(*
Windows Uniscribe APIs
Uniscribe is a set of APIs that allow a high degree of control for fine
typography and for processing complex scripts
- see http://msdn.microsoft.com/en-us/library/dd374091(v=VS.85).aspx
- used by both SynPDF.pas and mORMotReport.pas (for TGDIPages)
- NO_USE_UNISCRIBE conditional can be set globaly for an application
which doesn't need the UniScribe features
*)
{$ifdef USE_UNISCRIBE}
const
Usp10 = 'usp10.dll';
/// error returned by Uniscribe when the current selected font
// does not contain sufficient glyphs or shaping tables
USP_E_SCRIPT_NOT_IN_FONT = HRESULT((SEVERITY_ERROR shl 31) or (FACILITY_ITF shl 16)) or $200;
type
/// UniScribe script state flag elements
// - r0,r1,r2,r3,r4: map TScriptState.uBidiLevel
// - fOverrideDirection: Set when in LRO/RLO embedding
// - fInhibitSymSwap: Set by U+206A (ISS), cleared by U+206B (ASS)
// - fCharShape: Set by U+206D (AAFS), cleared by U+206C (IAFS)
// - fDigitSubstitute: Set by U+206E (NADS), cleared by U+206F (NODS)
// - fInhibitLigate: Equiv !GCP_Ligate, no Unicode control chars yet
// - fDisplayZWG: Equiv GCP_DisplayZWG, no Unicode control characters yet
// - fArabicNumContext: For EN->AN Unicode rule
// - fGcpClusters: For Generating Backward Compatible GCP Clusters (legacy Apps)
TScriptState_enum = (
r0,r1,r2,r3,r4,
fOverrideDirection, fInhibitSymSwap, fCharShape, fDigitSubstitute,
fInhibitLigate, fDisplayZWG, fArabicNumContext, fGcpClusters);
/// a set of UniScribe script state flags
TScriptState_set = set of TScriptState_enum;
PScriptState = ^TScriptState;
/// an UniScribe script state
// - uBidiLevel: Unicode Bidi algorithm embedding level (0..16)
// - fFlags: Script state flags
TScriptState = packed record
case Byte of
0: (uBidiLevel: Byte) {:5};
1: (fFlags: TScriptState_set)
end;
/// Uniscribe script analysis flag elements
// - s0,s1,s2,s3,s4,s5,s6,s7,s8,s9: map TScriptAnalysis.eScript
// - fRTL: Rendering direction
// - fLayoutRTL: Set for GCP classes ARABIC/HEBREW and LOCALNUMBER
// - fLinkBefore: Implies there was a ZWJ before this item
// - fLinkAfter: Implies there is a ZWJ following this item.
// - fLogicalOrder: Set by client as input to ScriptShape/Place
// - fNoGlyphIndex: Generated by ScriptShape/Place - this item does not use
// glyph indices
TScriptAnalysis_enum = (
s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,
fRTL, fLayoutRTL, fLinkBefore, fLinkAfter, fLogicalOrder, fNoGlyphIndex);
/// a set of Uniscribe script analysis flags
TScriptAnalysis_set = set of TScriptAnalysis_enum;
PScriptAnalysis = ^TScriptAnalysis;
/// an Uniscribe script analysis
// - eScript: Shaping engine
// - fFlags: Script analysis flags
// - s: Script state
TScriptAnalysis = packed record
case Byte of
0: (eScript: Word);
1: (fFlags: TScriptAnalysis_set;
s: TScriptState);
end;
PScriptItem = ^TScriptItem;
/// a Uniscribe script item, after analysis of a unicode text
TScriptItem = packed record
/// Logical offset to first character in this item
iCharPos: Integer;
/// corresponding Uniscribe script analysis
a: TScriptAnalysis;
end;
/// all possible Uniscribe processing properties of a given language
// - fNumeric: if a script contains only digits
// - fComplex: Script requires special shaping or layout
// - fNeedsWordBreaking: Requires ScriptBreak for word breaking information
// - fNeedsCaretInfo: Requires caret restriction to cluster boundaries
// - bCharSet0 .. bCharSet7: Charset to use when creating font
// - fControl: Contains only control characters
// - fPrivateUseArea: This item is from the Unicode range U+E000 through U+F8FF
// - fNeedsCharacterJustify: Requires inter-character justification
// - fInvalidGlyph: Invalid combinations generate glyph wgInvalid in the glyph buffer
// - fInvalidLogAttr: Invalid combinations are marked by fInvalid in the logical attributes
// - fCDM: Contains Combining Diacritical Marks
// - fAmbiguousCharSet: Script does not correspond 1// :1 with a charset
// - fClusterSizeVaries: Measured cluster width depends on adjacent clusters
// - fRejectInvalid: Invalid combinations should be rejected
TScriptProperties_enum = (
fNumeric, fComplex, fNeedsWordBreaking, fNeedsCaretInfo,
bCharSet0, bCharSet1, bCharSet2, bCharSet3, bCharSet4, bCharSet5,
bCharSet6, bCharSet7,
fControl, fPrivateUseArea, fNeedsCharacterJustify, fInvalidGlyph,
fInvalidLogAttr, fCDM, fAmbiguousCharSet, fClusterSizeVaries, fRejectInvalid);
/// set of possible Uniscribe processing properties of a given language
TScriptProperties_set = set of TScriptProperties_enum;
PScriptProperties = ^TScriptProperties;
/// Contains information about Uniscribe special processing for each script
TScriptProperties = packed record
/// Primary and sublanguage associated with script
langid: Word;
/// set of possible Uniscribe processing properties for a given language
fFlags: TScriptProperties_set;
end;
PScriptPropertiesArray = ^TPScriptPropertiesArray;
/// an array of Uniscribe processing information
TPScriptPropertiesArray = array[byte] of PScriptProperties;
/// Uniscribe visual (glyph) attributes
// - a0 .. a3: map the Justification class number
// - fClusterStart: First glyph of representation of cluster
// - fDiacritic: Diacritic
// - fZeroWidth: Blank, ZWJ, ZWNJ etc, with no width
// - fReserved: General reserved bit
TScriptVisAttr_enum = (
a0,a1,a2,a3,
fClusterStart, {:1} // First glyph of representation of cluster
fDiacritic, {:1} // Diacritic
fZeroWidth, {:1} // Blank, ZWJ, ZWNJ etc, with no width
fReserved {:1} // General reserved
);
/// set of Uniscribe visual (glyph) attributes
TScriptVisAttr_set = set of TScriptVisAttr_enum;
PScriptVisAttr = ^TScriptVisAttr;
/// Contains the visual (glyph) attributes that identify clusters and
// justification points, as generated by ScriptShape
// - uJustification: Justification class
// - fFlags: Uniscribe visual (glyph) attributes
// - fShapeReserved: Reserved for use by shaping engines
TScriptVisAttr = packed record
case Byte of
0: (uJustification: Byte) {:4};
1: (fFlags: TScriptVisAttr_set;
fShapeReserved: Byte) {:8};
end;
TScriptControlAttr_enum = (
fContextDigits,
fInvertPreBoundDir,
fInvertPostBoundDir,
fLinkStringBefore,
fLinkStringAfter,
fNeutralOverride,
fNumericOverride,
fLegacyBidiClass,
fScr0, fScr1, fScr2, fScr3, fScr4, fScr5, fScr6, fScr7);
TScriptControlAttr_set = set of TScriptControlAttr_enum;
TScriptControl = packed record
uDefaultLanguage: Word;
fFlags: TScriptControlAttr_set;
end;
PScriptControl = ^TScriptControl;
/// Uniscribe function to break a Unicode string into individually shapeable items
// - pwcInChars: Pointer to a Unicode string to itemize.
// - cInChars: Number of characters in pwcInChars to itemize.
// - cMaxItems: Maximum number of SCRIPT_ITEM structures defining items to process.
// - psControl: Optional. Pointer to a SCRIPT_CONTROL structure indicating the
// type of itemization to perform. Alternatively, the application can set this
// parameter to NULL if no SCRIPT_CONTROL properties are needed.
// - psState: Optional. Pointer to a SCRIPT_STATE structure indicating
// the initial bidirectional algorithm state. Alternatively, the application
// can set this parameter to NULL if the script state is not needed.
// - pItems: Pointer to a buffer in which the function retrieves SCRIPT_ITEM
// structures representing the items that have been processed. The buffer
// should be cMaxItems*sizeof(SCRIPT_ITEM) + 1 bytes in length. It is invalid
// to call this function with a buffer to hold less than two SCRIPT_ITEM
// structures. The function always adds a terminal item to the item analysis
// array so that the length of the item with zero-based index "i" is
// always available as:
// ! pItems[i+1].iCharPos - pItems[i].iCharPos;
// - pcItems: Pointer to the number of SCRIPT_ITEM structures processed
function ScriptItemize(
const pwcInChars: PWideChar; cInChars: Integer; cMaxItems: Integer;
const psControl: pointer; const psState: pointer;
pItems: PScriptItem; var pcItems: Integer): HRESULT; stdcall; external Usp10;
/// Uniscribe function to retrieve information about the current scripts
// - ppSp: Pointer to an array of pointers to SCRIPT_PROPERTIES structures
// indexed by script.
// - piNumScripts: Pointer to the number of scripts. The valid range for this
// value is 0 through piNumScripts-1.
function ScriptGetProperties(out ppSp: PScriptPropertiesArray;
out piNumScripts: Integer): HRESULT; stdcall; external Usp10;
/// Uniscribe function to convert an array of run embedding levels to a map
// of visual-to-logical position and/or logical-to-visual position
// - cRuns: Number of runs to process
// - pbLevel: Array of run embedding levels
// - piVisualToLogical: List of run indices in visual order
// - piLogicalToVisual: List of visual run positions
function ScriptLayout(cRuns: Integer; const pbLevel: PByte;
piVisualToLogical: PInteger; piLogicalToVisual: PInteger): HRESULT; stdcall; external Usp10;
/// Uniscribe function to generate glyphs and visual attributes for an Unicode run
// - hdc: Optional (see under caching)
// - psc: Uniscribe font metric cache handle
// - pwcChars: Logical unicode run
// - cChars: Length of unicode run
// - cMaxGlyphs: Max glyphs to generate
// - psa: Result of ScriptItemize (may have fNoGlyphIndex set)
// - pwOutGlyphs: Output glyph buffer
// - pwLogClust: Logical clusters
// - psva: Visual glyph attributes
// - pcGlyphs: Count of glyphs generated
function ScriptShape(hdc: HDC; var psc: pointer; const pwcChars: PWideChar;
cChars: Integer; cMaxGlyphs: Integer; psa: PScriptAnalysis;
pwOutGlyphs: PWord; pwLogClust: PWord; psva: PScriptVisAttr;
var pcGlyphs: Integer): HRESULT; stdcall; external Usp10;
/// Uniscribe function to apply the specified digit substitution settings
// to the specified script control and script state structures
function ScriptApplyDigitSubstitution(
const psds: Pointer; const psControl: pointer;
const psState: pointer): HRESULT; stdcall; external Usp10;
// C++Builder code should #include <usp10.h> directly instead of using these
{$NODEFINE TScriptState }
{$NODEFINE PScriptState }
{$NODEFINE TScriptAnalysis }
{$NODEFINE PScriptAnalysis }
{$NODEFINE TScriptVisAttr }
{$NODEFINE PScriptVisAttr }
{$NODEFINE TScriptItem }
{$NODEFINE PScriptItem }
{$NODEFINE ScriptItemize }
{$NODEFINE ScriptGetProperties }
{$NODEFINE ScriptLayout }
{$NODEFINE ScriptShape }
{$NODEFINE ScriptApplyDigitSubstitution }
{$endif USE_UNISCRIBE}
implementation
const
// those constants are not defined in earlier Delphi revisions
cPI: single = 3.141592654;
cPIdiv180: single = 0.017453292;
c180divPI: single = 57.29577951;
c2PI: double = 6.283185307;
cPIdiv2: double = 1.570796326;
function RGBA(r, g, b, a: cardinal): COLORREF; {$ifdef HASINLINE}inline;{$endif}
begin
Result := ((r shr 8) or ((g shr 8) shl 8) or ((b shr 8) shl 16) or ((a shr 8) shl 24));
end;
procedure SwapBuffer(P: PWordArray; PLen: Integer);
var i: integer;
begin
for i := 0 to PLen-1 do
P^[i] := swap(P^[i]);
end;
function GetTTFData(aDC: HDC; aTableName: PAnsiChar; var Ref: TWordDynArray): pointer;
var L: cardinal;
begin
result := nil;
L := GetFontData(aDC,PCardinal(aTableName)^,0,nil,0);
if L=GDI_ERROR then
exit;
SetLength(ref,L shr 1+1);
if GetFontData(aDC,PCardinal(aTableName)^,0,pointer(ref),L)=GDI_ERROR then
exit;
result := pointer(ref);
SwapBuffer(Result,L shr 1);
end;
function PrinterDriverExists: boolean;
var Flags, Count, NumInfo: dword;
Level: Byte;
begin
// avoid using fPrinter.printers.count as this will raise an
// exception if no printer driver is installed...
Count := 0;
Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
Level := 4;
EnumPrinters(Flags, nil, Level, nil, 0, Count, NumInfo);
result := (count > 0);
end;
function ParseFetchedPrinterStr(Str: PChar): PChar;
var
P: PChar;
begin
Result := Str;
if Str=nil then Exit;
P := Str;
while P^=' ' do Inc(P);
Result := P;
while (P^<>#0) and (P^<>',') do Inc(P);
if P^=',' then
P^ := #0;
end;
function CurrentPrinterPaperSize: TPDFPaperSize;
var PtrHdl: THandle;
PtrPPI: TPoint;
size: TSize;
tmp: integer;
PtrDestSize: TSize;
DefaultPrinter: array[0..1023] of Char;
PC: PChar;
begin
result := psUserDefined;
if not PrinterDriverExists then
exit;
GetProfileString('windows','device',nil,DefaultPrinter,SizeOf(DefaultPrinter)-1);
PC := ParseFetchedPrinterStr(DefaultPrinter);
if (PC=nil) or (PC^=#0) then
exit;
try
PtrHdl := CreateDC(nil,PC,nil,nil);
try
PtrPPI.x := GetDeviceCaps(PtrHdl, LOGPIXELSX);
PtrPPI.y := GetDeviceCaps(PtrHdl, LOGPIXELSY);
PtrDestSize.cx := GetDeviceCaps(PtrHdl, PHYSICALWIDTH);
PtrDestSize.cy := GetDeviceCaps(PtrHdl, PHYSICALHEIGHT);
size.cx := mulDiv(PtrDestSize.cx, 254,PtrPPI.x *10);
size.cy := mulDiv(PtrDestSize.cy, 254,PtrPPI.y *10);
finally
DeleteDC(PtrHdl);
end;
except
On Exception do // raised e.g. if no Printer is existing
exit;
end;
with size do begin
if cx < cy then begin // handle landscape or portrait at once
tmp := cx;
cx := cy;
cy := tmp;
end;
case cy of
148: result := psA5;
210: result := psA4; // A4 (297 x 210mm)
216: if cx=279 then
result := psLetter else
if cx=356 then
result := psLegal;
297: if cx=420 then
result := psA3;
end;
end;
end;
function CurrentPrinterRes: TPoint;
var DefaultPrinter: array[0..1023] of Char;
PC: PChar;
PtrHdl: THandle;
begin
result.X := 300;
result.Y := 300; // default standard printer resolution
if not PrinterDriverExists then
exit;
GetProfileString('windows','device',nil,DefaultPrinter,SizeOf(DefaultPrinter)-1);
PC := ParseFetchedPrinterStr(DefaultPrinter);
if (PC=nil) or (PC^=#0) then
exit;
try
PtrHdl := CreateDC(nil,PC,nil,nil);
try
result.x := GetDeviceCaps(PtrHdl, LOGPIXELSX);
result.y := GetDeviceCaps(PtrHdl, LOGPIXELSY);
finally
DeleteDC(PtrHdl);
end;
except
On Exception do // raised e.g. if no Printer is existing
exit;
end;
end;
procedure GDICommentBookmark(MetaHandle: HDC; const aBookmarkName: RawUTF8);
var Data: RawByteString;
D: PAnsiChar;
L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
L := length(aBookmarkName);
SetLength(Data,L+1);
D := pointer(Data);
D^ := AnsiChar(pgcBookmark);
MoveFast(pointer(aBookmarkName)^,D[1],L);
Windows.GdiComment(MetaHandle,L+1,D);
end;
procedure GDICommentOutline(MetaHandle: HDC; const aTitle: RawUTF8; aLevel: Integer);
var Data: RawByteString;
D: PAnsiChar;
L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
L := length(aTitle);
SetLength(Data,L+2);
D := pointer(Data);
D[0] := AnsiChar(pgcOutline);
D[1] := AnsiChar(aLevel);
MoveFast(pointer(aTitle)^,D[2],L);
Windows.GdiComment(MetaHandle,L+2,D);
end;
procedure GDICommentLink(MetaHandle: HDC; const aBookmarkName: RawUTF8; const aRect: TRect;
NoBorder: boolean);
var Data: RawByteString;
D: PAnsiChar;
L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
L := length(aBookmarkName);
SetLength(Data,L+(1+sizeof(TRect)));
D := pointer(Data);
if NoBorder then
D^ := AnsiChar(pgcLinkNoBorder) else
D^ := AnsiChar(pgcLink);
PRect(D+1)^ := aRect;
MoveFast(pointer(aBookmarkName)^,D[1+sizeof(TRect)],L);
Windows.GdiComment(MetaHandle,L+(1+sizeof(TRect)),D);
end;
{$ifndef DELPHI5OROLDER}
// used by TPdfFontTrueType.PrepareForSaving()
function GetTTCIndex(const FontName: RawUTF8; var ttcIndex: Word;
const FontCount: LongWord): Boolean;
// Looks up ttcIndex from list of font names in known ttc font collections.
// For some locales, the lookup may fail
// Result must not be greater than FontCount-1
const
// Font names for Simp/Trad Chinese, Japanese, Korean locales.
BATANG_KO = #48148#53461;
BATANGCHE_KO = BATANG_KO + #52404;
GUNGSUH_KO = #44417#49436;
GUNGSUHCHE_KO = GUNGSUH_KO + #52404;
GULIM_KO = #44404#47548;
GULIMCHE_KO = GULIM_KO + #52404;
DOTUM_KO = #46027#50880;
DOTUMCHE_KO = DOTUM_KO + #52404;
MINGLIU_CH = #32048#26126#39636;
PMINGLIU_CH = #26032 + MINGLIU_CH;
MINGLIU_HK_CH = MINGLIU_CH + '_hkscs';
MINGLIU_XB_CH = MINGLIU_CH + '-extb';
PMINGLIU_XB_CH = PMINGLIU_CH + '-extb';
MINGLIU_XBHK_CH = MINGLIU_CH + '-extb_hkscs';
MSGOTHIC_JA = #65325#65331#32#12468#12471#12483#12463;
MSPGOTHIC_JA = #65325#65331#32#65328#12468#12471#12483#12463;
MSMINCHO_JA = #65325#65331#32#26126#26397;
MSPMINCHO_JA = #65325#65331#32#65328#26126#26397;
SIMSUN_CHS = #23435#20307;
NSIMSUN_CHS = #26032#23435#20307;
var
lcfn: SynUnicode;
begin
result := True;
UTF8ToSynUnicode(fontName,lcfn);
lcfn := {$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(lcfn);
// batang.ttc (Korean)
if (lcfn='batang') or (lcfn=BATANG_KO) then
ttcIndex := 0 else
if (lcfn='batangche') or (lcfn=BATANGCHE_KO) then
ttcIndex := 1 else
if (lcfn='gungsuh') or (lcfn=GUNGSUH_KO) then
ttcIndex := 2 else
if (lcfn='gungsuhche') or (lcfn=GUNGSUHCHE_KO) then
ttcIndex := 3 else
// cambria.ttc
if lcfn='cambria' then
ttcIndex := 0 else
if lcfn='cambria math' then
ttcIndex := 1 else
// gulim.ttc (Korean)
if (lcfn='gulim') or (lcfn=GULIM_KO) then
ttcIndex := 0 else
if (lcfn='gulimche') or (lcfn=GULIMCHE_KO) then
ttcIndex := 1 else
if (lcfn='dotum') or (lcfn=DOTUM_KO) then
ttcIndex := 2 else
if (lcfn='dotumche') or (lcfn=DOTUMCHE_KO) then
ttcIndex := 3 else
// mingliu.ttc (Traditional Chinese)
if (lcfn='mingliu') or (lcfn=MINGLIU_CH) then
ttcIndex := 0 else
if (lcfn='pmingliu') or (lcfn=PMINGLIU_CH) then
ttcIndex := 1 else
if (lcfn='mingliu_hkscs') or (lcfn=MINGLIU_HK_CH) then
ttcIndex := 2 else
// mingliub.ttc (Traditional Chinese)
if (lcfn='mingliu-extb') or (lcfn=MINGLIU_XB_CH) then
ttcIndex := 0 else
if (lcfn='pmingliu-extb') or (lcfn=PMINGLIU_XB_CH) then
ttcIndex := 1 else
if (lcfn='mingliu_hkscs-extb') or (lcfn=MINGLIU_XBHK_CH) then
ttcIndex := 2 else
// msgothic.ttc (Japanese)
if (lcfn='ms gothic') or
(lcfn={$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(MSGOTHIC_JA)) then
ttcIndex := 0 // MSGOTHIC_JA contains full-width uppercase chars
else if (lcfn='ms pgothic') or
(lcfn={$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(MSPGOTHIC_JA)) then
ttcIndex := 1 else
if lcfn='ms ui gothic' then
ttcIndex := 2 else
// msmincho.ttc (Japanese)
if (lcfn='ms mincho') or
(lcfn={$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(MSMINCHO_JA)) then
ttcIndex := 0 else
if (lcfn='ms pmincho') or
(lcfn={$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(MSPMINCHO_JA)) then
ttcIndex := 1 else
// simsun.ttc (Simplified Chinese)
if (lcfn='simsun') or (lcfn=SIMSUN_CHS) then
ttcIndex := 0 else
if (lcfn='nsimsun') or (lcfn=NSIMSUN_CHS) then
ttcIndex := 1 else
result := False;
if result and (ttcIndex>(FontCount-1)) then
result := False;
end;
{$endif DELPHI5OROLDER}
{$ifdef USE_ARC}
type
tcaRes = (caMoveto, caLine, caCurve, caPosition);
teaDrawtype = record
res: tcaRes;
pts: array[0..2] of record x, y: single;
end;
end;
teaDrawArray = array of teaDrawtype;
function CalcCurveArcData(centerx, centery, W, H, Sx, Sy, Ex, Ey: integer;
aClockWise: boolean; arctype: TPdfCanvasArcType; out res: teaDrawArray): boolean;
type
TCoeff = array[0..3] of double;
TCoeffArray = array[0..1, 0..3] of TCoeff;
const
// coefficients for error estimation
// while using cubic Bezier curves for approximation
// 0 < b/a < 1/4
coeffsLow: TCoeffArray = (
((3.85268, -21.229, -0.330434, 0.0127842),
(-1.61486, 0.706564, 0.225945, 0.263682),
(-0.910164, 0.388383, 0.00551445, 0.00671814),
(-0.630184, 0.192402, 0.0098871, 0.0102527)),
((-0.162211, 9.94329, 0.13723, 0.0124084),
(-0.253135, 0.00187735, 0.0230286, 0.01264),
(-0.0695069, -0.0437594, 0.0120636, 0.0163087),
(-0.0328856, -0.00926032, -0.00173573, 0.00527385)));
// coefficients for error estimation
// while using cubic Bezier curves for approximation
// 1/4 <= b/a <= 1
coeffsHigh: TCoeffArray = (
((0.0899116, -19.2349, -4.11711, 0.183362),
(0.138148, -1.45804, 1.32044, 1.38474),
(0.230903, -0.450262, 0.219963, 0.414038),
(0.0590565, -0.101062, 0.0430592, 0.0204699)),
((0.0164649, 9.89394, 0.0919496, 0.00760802),
(0.0191603, -0.0322058, 0.0134667, -0.0825018),
(0.0156192, -0.017535, 0.00326508, -0.228157),
(-0.0236752, 0.0405821, -0.0173086, 0.176187)));
// safety factor to convert the "best" error approximation
// into a "max bound" error
safety: TCoeff = (0.001, 4.98, 0.207, 0.0067);
var fcx, fcy: double; // center of the ellipse
faRad, fbRad: double; // Semi-major axis
feta1, feta2: double; // Start End angle of the arc
fx1, fy1, fx2, fy2: double; //start and and endpoint
fxLeft, fyUp: double; // leftmost point of the arc
fwidth, fheight: double; // Horizontal width of the arc Vertical height of the arc
fArctype: TPdfCanvasArcType; //Indicator for center to endpoints line inclusion
fClockWise : boolean;
procedure InitFuncData;
var lambda1, lambda2 : double;
begin
fcx := centerx;
fcy := centery;
faRad := (W-1) / 2;
fbRad := (H-1) / 2;
fArctype := arctype;
// Calculate Rotation at Start and EndPoint
fClockWise := aClockWise;
if aclockwise then begin
lambda1 := ArcTan2(Sy - fcy, Sx - fcx);
lambda2 := ArcTan2(Ey - fcy, Ex - fcx);
end else begin
lambda2 := ArcTan2(Sy - fcy, Sx - fcx);
lambda1 := ArcTan2(Ey - fcy, Ex - fcx);
end;
feta1 := ArcTan2(sin(lambda1) / fbRad, cos(lambda1) / faRad);
feta2 := ArcTan2(sin(lambda2) / fbRad, cos(lambda2) / faRad);
// make sure we have eta1 <= eta2 <= eta1 + 2 PI
feta2 := feta2 - (c2PI * floor((feta2 - feta1) / c2PI));
// the preceding correction fails if we have exactly et2 - eta1 = 2 PI
// it reduces the interval to zero length
if SameValue(feta1, feta2) then
feta2 := feta2 + c2PI;
// start point
fx1 := fcx + (faRad * cos(feta1));
fy1 := fcy + (fbRad * sin(feta1));
// end point
fx2 := fcx + (faRad * cos(feta2));
fy2 := fcy + (fbRad * sin(feta2));
// Dimensions
fxLeft := min(fx1, fx2);
fyUp := min(fy1, fy2);
fwidth := max(fx1, fx2) - fxLeft;
fheight := max(fy1, fy2) - fyUp;
end;
function estimateError(etaA, etaB: double): double;
var coeffs: ^TCoeffArray;
c0, c1, cos2, cos4, cos6, dEta, eta, x: double;
function rationalFunction(x: double; const c: TCoeff): double;
begin
result := (x * (x * c[0] + c[1]) + c[2]) / (x + c[3]);
end;
begin
eta := 0.5 * (etaA + etaB);
x := fbRad / faRad;
dEta := etaB - etaA;
cos2 := cos(2 * eta);
cos4 := cos(4 * eta);
cos6 := cos(6 * eta);
// select the right coeficients set according to degree and b/a
if x < 0.25 then
coeffs := @coeffsLow else
coeffs := @coeffsHigh;
c0 := rationalFunction(x, coeffs[0][0]) +
cos2 * rationalFunction(x, coeffs[0][1]) +
cos4 * rationalFunction(x, coeffs[0][2]) +
cos6 * rationalFunction(x, coeffs[0][3]);
c1 := rationalFunction(x, coeffs[1][0]) +
cos2 * rationalFunction(x, coeffs[1][1]) +
cos4 * rationalFunction(x, coeffs[1][2]) +
cos6 * rationalFunction(x, coeffs[1][3]);
result := rationalFunction(x, safety) * faRad * exp(c0 + c1 * dEta);
end;
procedure BuildPathIterator;
var alpha: double;
found: Boolean;
n: integer;
dEta, etaB, etaA: double;
cosEtaB, sinEtaB, aCosEtaB, bSinEtaB, aSinEtaB, bCosEtaB, xB, yB, xBDot, yBDot: double;
i: integer;
t, xA, xADot, yA, yADot: double;
ressize: integer; // Index var for result Array
r: ^teaDrawtype;
lstartx, lstarty : double; // Start from
const
defaultFlatness = 0.5; // half a pixel
begin
// find the number of Bezier curves needed
found := false;
n := 1;
while (not found) and (n < 1024) do begin
dEta := (feta2 - feta1) / n;
if dEta <= cPIdiv2 then begin
etaB := feta1;
found := true;
for i := 0 to n - 1 do begin
etaA := etaB;
etaB := etaB + dEta;
found := (estimateError(etaA, etaB) <= defaultFlatness);
if not found then
break;
end;
end;
// if not found then
n := n shl 1;
end;
dEta := (feta2 - feta1) / n;
etaB := feta1;
cosEtaB := cos(etaB);
sinEtaB := sin(etaB);
aCosEtaB := faRad * cosEtaB;
bSinEtaB := fbRad * sinEtaB;
aSinEtaB := faRad * sinEtaB;
bCosEtaB := fbRad * cosEtaB;
xB := fcx + aCosEtaB;
yB := fcy + bSinEtaB;
xBDot := -aSinEtaB;
yBDot := +bCosEtaB;
lstartx := xB;
lstarty := yB;
// calculate and reserve Space for the result
ressize := n;
case fArctype of
acArc : inc(ressize,1); // first move
acArcTo: inc(ressize,3); // first line and move
acArcAngle: inc(ressize,1); // first move
acPie: inc(ressize,3); // first and last Line
acChoord: inc(ressize,2);
end;
SetLength(res, ressize);
r := pointer(res);
case fArctype of
acArc: begin // start with move
r^.res := caMoveto;
r^.pts[0].x := xB;
r^.pts[0].y := yB;
inc(r);
end;
acArcTo : begin // start with line and move
r^.res := caLine;
if fClockwise then begin
r^.pts[0].x := fx1;
r^.pts[0].y := fy1;
end else begin
r^.pts[0].x := fx2;
r^.pts[0].y := fy2;
end;
inc(r);
r^.res := caMoveto;
r^.pts[0].x := fx1;
r^.pts[0].y := fy1;
inc(r);
end;
acArcAngle: ;
acPie : begin
r^.res := caMoveto;
r^.pts[0].x := fcx;
r^.pts[0].y := fcy;
inc(r);
r^.res := caLine;
r^.pts[0].x := xB;
r^.pts[0].y := yB;
inc(r);
end;
acChoord : begin
r^.res := caMoveto;
r^.pts[0].x := xB;
r^.pts[0].y := yB;
inc(r);
end;
end;
t := tan(0.5 * dEta);
alpha := sin(dEta) * (sqrt(4 + 3 * t * t) - 1) / 3;
for i := 0 to n - 1 do begin
xA := xB;
yA := yB;
xADot := xBDot;
yADot := yBDot;
etaB := etaB + dEta;
cosEtaB := cos(etaB);
sinEtaB := sin(etaB);
aCosEtaB := faRad * cosEtaB;
bSinEtaB := fbRad * sinEtaB;
aSinEtaB := faRad * sinEtaB;
bCosEtaB := fbRad * cosEtaB;
xB := fcx + aCosEtaB;
yB := fcy + bSinEtaB;
xBDot := -aSinEtaB;
yBDot := bCosEtaB;
r^.res := caCurve;
r^.pts[0].x := xA + alpha * xADot;
r^.pts[0].y := yA + alpha * yADot;
r^.pts[1].x := xB - alpha * xBDot;
r^.pts[1].y := yB - alpha * yBDot;
r^.pts[2].x := xB;
r^.pts[2].y := yB;
inc(r);
end; // Loop
case fArctype of
acArcTo: begin
r^.res := caPosition;
if fClockWise then begin
r^.pts[0].x := fx2;
r^.pts[0].y := fy2;
end else begin
r^.pts[0].x := fx1;
r^.pts[0].y := fy1;
end
end;
acPie: begin
r^.res := caLine;
r^.pts[0].x := fcx;
r^.pts[0].y := fcy;
end;
acChoord: begin
r^.res := caLine;
r^.pts[0].x := lstartx;
r^.pts[0].y := lstarty;
end;
end;
end;
begin
res := nil;
InitFuncData; // Initialize Data