Permalink
Cannot retrieve contributors at this time
/// 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 | |