3968 lines
120 KiB
ObjectPascal
3968 lines
120 KiB
ObjectPascal
{******************************************}
|
|
{ }
|
|
{ FastReport FMX v2.0 }
|
|
{ PDF export filter }
|
|
{ }
|
|
{ Copyright (c) 1998-2013 }
|
|
{ by Alexander Fediachov, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxExportPDF;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
{$I fmx.inc}
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}
|
|
Winapi.Windows,
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
Macapi.CocoaTypes, Macapi.CoreText, Macapi.Mach, Macapi.CoreServices, Macapi.CoreFoundation, Macapi.CoreGraphics, Macapi.Foundation,
|
|
{$ENDIF}
|
|
System.SysUtils, System.Classes, FMX.Controls, FMX.Dialogs, FMX.Edit, FMX.frxFMX,
|
|
FMX.Types, FMX.TabControl, System.UITypes, System.Types, FMX.frxImageConverter,
|
|
FMX.Printer, FMX.frxClass, FMX.frxRC4, FMX.Forms, System.UIConsts, FMX.frxChBox,
|
|
FMX.frxBaseModalForm
|
|
{$IFDEF MSWINDOWS}
|
|
, Winapi.ShellAPI
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
, Posix.Stdlib, Macapi.AppKit
|
|
{$ENDIF}
|
|
, System.WideStrings, System.AnsiStrings, FMX.frxTrueTypeFont,
|
|
FMX.frxTrueTypeCollection, FMX.frxNameTableClass, System.Variants
|
|
{$IFDEF DELPHI18}
|
|
, FMX.StdCtrls
|
|
, FMX.Surfaces
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
|
{$ENDIF};
|
|
|
|
type
|
|
SCRIPT_CACHE = Pointer;
|
|
PScriptCache = ^SCRIPT_CACHE;
|
|
|
|
SCRIPT_ANALYSIS = record
|
|
fFlags: Word;
|
|
s: Word
|
|
end;
|
|
PScriptAnalysis = ^SCRIPT_ANALYSIS;
|
|
|
|
SCRIPT_ITEM = record
|
|
iCharPos: Integer;
|
|
a: SCRIPT_ANALYSIS;
|
|
end;
|
|
PScriptItem = ^SCRIPT_ITEM;
|
|
|
|
GOFFSET = record
|
|
du: Longint;
|
|
dv: Longint;
|
|
end;
|
|
PGOffset = ^GOFFSET;
|
|
|
|
TRGBTriple = packed record
|
|
rgbtBlue: Byte;
|
|
rgbtGreen: Byte;
|
|
rgbtRed: Byte;
|
|
end;
|
|
|
|
TRGBAWord = packed record
|
|
Blue: Byte;
|
|
Green: Byte;
|
|
Red: Byte;
|
|
Alpha: Byte;
|
|
end;
|
|
|
|
// PRGBAWord = ^TRGBAWord;
|
|
|
|
PRGBAWord = ^TRGBAWordArray;
|
|
TRGBAWordArray = array[0..4095] of TRGBAWord;
|
|
|
|
type
|
|
TfrxPDFEncBit = (ePrint, eModify, eCopy, eAnnot);
|
|
TfrxPDFEncBits = set of TfrxPDFEncBit;
|
|
|
|
TfrxPDFExportDialog = class(TfrxForm)
|
|
PageControl1: TTabControl;
|
|
ExportPage: TTabItem;
|
|
InfoPage: TTabItem;
|
|
SecurityPage: TTabItem;
|
|
ViewerPage: TTabItem;
|
|
OkB: TButton;
|
|
CancelB: TButton;
|
|
SaveDialog1: TSaveDialog;
|
|
OpenCB: TCheckBox;
|
|
GroupQuality: TGroupBox;
|
|
CompressedCB: TCheckBox;
|
|
EmbeddedCB: TCheckBox;
|
|
PrintOptCB: TCheckBox;
|
|
OutlineCB: TCheckBox;
|
|
BackgrCB: TCheckBox;
|
|
GroupPageRange: TGroupBox;
|
|
DescrL: TLabel;
|
|
AllRB: TRadioButton;
|
|
CurPageRB: TRadioButton;
|
|
PageNumbersRB: TRadioButton;
|
|
PageNumbersE: TEdit;
|
|
SecGB: TGroupBox;
|
|
OwnPassL: TLabel;
|
|
UserPassL: TLabel;
|
|
OwnPassE: TEdit;
|
|
UserPassE: TEdit;
|
|
PermGB: TGroupBox;
|
|
PrintCB: TCheckBox;
|
|
ModCB: TCheckBox;
|
|
CopyCB: TCheckBox;
|
|
AnnotCB: TCheckBox;
|
|
DocInfoGB: TGroupBox;
|
|
TitleL: TLabel;
|
|
TitleE: TEdit;
|
|
AuthorE: TEdit;
|
|
AuthorL: TLabel;
|
|
SubjectL: TLabel;
|
|
SubjectE: TEdit;
|
|
KeywordsL: TLabel;
|
|
KeywordsE: TEdit;
|
|
CreatorE: TEdit;
|
|
CreatorL: TLabel;
|
|
ProducerL: TLabel;
|
|
ProducerE: TEdit;
|
|
ViewerGB: TGroupBox;
|
|
HideToolbarCB: TCheckBox;
|
|
HideMenubarCB: TCheckBox;
|
|
HideWindowUICB: TCheckBox;
|
|
FitWindowCB: TCheckBox;
|
|
CenterWindowCB: TCheckBox;
|
|
PrintScalingCB: TCheckBox;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure PageNumbersEChange(Sender: TObject);
|
|
procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
procedure OkBClick(Sender: TObject);
|
|
end;
|
|
|
|
type
|
|
TfrxPDFRun = class
|
|
public
|
|
analysis: SCRIPT_ANALYSIS;
|
|
text: WideString;
|
|
constructor Create(t: WideString; a: SCRIPT_ANALYSIS);
|
|
end;
|
|
|
|
TfrxPDFXObjectHash = array[0..15] of Byte; // MD5
|
|
TfrxPDFXObject = record
|
|
ObjId: Integer; // id that appears in 'id 0 R'
|
|
Hash: TfrxPDFXObjectHash;
|
|
end;
|
|
|
|
|
|
TfrxPDFFont = class
|
|
private
|
|
tempBitmap: TBitmap;
|
|
//FUSCache: PScriptCache;
|
|
TrueTypeTables: TrueTypeCollection;
|
|
FSubstituteName: String;
|
|
FCurrentFont: TrueTypeFont;
|
|
function GetGlyphIndices(text: WideString; glyphs: System.PWord; widths: System.PInteger; rtl: boolean): integer;
|
|
public
|
|
Index: Integer;
|
|
Widths: TList;
|
|
UsedAlphabet: TList;
|
|
UsedAlphabetUnicode: TList;
|
|
FComposedList: TList;
|
|
TextMetric: OutlineTextMetric;
|
|
Name: AnsiString;
|
|
SourceFont: TFont;
|
|
Reference: Longint;
|
|
Saved: Boolean;
|
|
PackFont: Boolean;
|
|
FontData: TMemoryStream;
|
|
FontDataSize: Longint;
|
|
PDFdpi_divider: double;
|
|
FDpiFX: double;
|
|
LastRemappedStrWidth: Integer;
|
|
LastRemappedStrSpacesCount: Integer;
|
|
constructor Create(Font: TFont);
|
|
destructor Destroy; override;
|
|
procedure Cleanup;
|
|
procedure FillOutlineTextMetrix;
|
|
procedure GetFontFile;
|
|
procedure PackFontFile;
|
|
function RemapString(str: WideString; rtl: Boolean): WideString;
|
|
function GetFontName: AnsiString;
|
|
end;
|
|
|
|
TfrxPDFOutlineNode = class
|
|
public
|
|
Number: Integer;
|
|
Dest: Integer; // Index to a page referred to by this outline node
|
|
Top: Integer; // Position on the referred to page
|
|
CountTree: Integer; // Number of all descendant nodes
|
|
Count: Integer; // Number of all first-level descendants
|
|
Title: string;
|
|
|
|
First: TfrxPDFOutlineNode; // The first first-level descendant
|
|
Last: TfrxPDFOutlineNode; // The last first-level descendant
|
|
Next: TfrxPDFOutlineNode; // The next neighbouring node
|
|
Prev: TfrxPDFOutlineNode; // The previous neighbouring node
|
|
Parent: TfrxPDFOutlineNode; // The parent node of this node
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TfrxPDFPage = class
|
|
public
|
|
Height: Double;
|
|
end;
|
|
|
|
TfrxPDFAnnot = class
|
|
public
|
|
Number: Integer;
|
|
Rect: String;
|
|
Hyperlink: String;
|
|
DestPage: Integer;
|
|
DestY: Integer;
|
|
end;
|
|
|
|
{$I frxFMX_PlatformsAttribute.inc}
|
|
TfrxPDFExport = class(TfrxCustomExportFilter)
|
|
private
|
|
FCompressed: Boolean;
|
|
FEmbedded: Boolean;
|
|
FEmbedProt: Boolean;
|
|
FOpenAfterExport: Boolean;
|
|
FPrintOpt: Boolean;
|
|
FPages: TList;
|
|
FOutline: Boolean;
|
|
FQuality: Integer;
|
|
FPreviewOutline: TfrxCustomOutline;
|
|
FSubject: WideString;
|
|
FAuthor: WideString;
|
|
FBackground: Boolean;
|
|
FCreator: WideString;
|
|
FTags: Boolean;
|
|
FProtection: Boolean;
|
|
FUserPassword: AnsiString;
|
|
FOwnerPassword: AnsiString;
|
|
FProtectionFlags: TfrxPDFEncBits;
|
|
FKeywords: WideString;
|
|
FTitle: WideString;
|
|
FProducer: WideString;
|
|
FPrintScaling: Boolean;
|
|
FFitWindow: Boolean;
|
|
FHideMenubar: Boolean;
|
|
FCenterWindow: Boolean;
|
|
FHideWindowUI: Boolean;
|
|
FHideToolbar: Boolean;
|
|
|
|
pdf: TStream;
|
|
|
|
FRootNumber: longint;
|
|
FPagesNumber: longint;
|
|
FInfoNumber: longint;
|
|
FStartXRef: longint;
|
|
|
|
FFonts: TList;
|
|
FPageFonts: TList;
|
|
FXRef: TStringList;
|
|
FPagesRef: TStringList;
|
|
|
|
FWidth: Extended;
|
|
FHeight: Extended;
|
|
FMarginLeft: Extended;
|
|
FMarginWoBottom: Extended;
|
|
FMarginTop: Extended;
|
|
|
|
FEncKey: AnsiString;
|
|
FOPass: AnsiString;
|
|
FUPass: AnsiString;
|
|
|
|
FEncBits: Cardinal;
|
|
FFileID: AnsiString;
|
|
|
|
FDivider: Extended;
|
|
FLastColor: TAlphaColor;
|
|
FLastColorResult: String;
|
|
|
|
OutStream: TMemoryStream;
|
|
|
|
FXObjects: array of TfrxPDFXObject;
|
|
FUsedXObjects: array of Integer; // XObjects' ids used within the current page
|
|
FPicTotalSize: Cardinal; // size occupied by all pictures
|
|
|
|
{ When an anchor is being added, two changes are made:
|
|
|
|
- a link object is written to the document
|
|
- a reference to the link object is added to /Annots field of the page
|
|
|
|
FPageAnnots contains text of /Annots field.
|
|
This stream is updated by WriteLink and its auxiliary routines. }
|
|
|
|
FPageAnnots: TMemoryStream;
|
|
FAnnots: TList;
|
|
FBmpCanvas: TBitmap;
|
|
|
|
function PrepXrefPos(pos: Longint): String;
|
|
procedure Write(Stream: TStream; const S: AnsiString);{$IFDEF Delphi12} overload;
|
|
procedure Write(Stream: TStream; const S: String); overload;
|
|
{$ENDIF}
|
|
procedure WriteLn(Stream: TStream; const S: AnsiString);{$IFDEF Delphi12} overload;
|
|
procedure WriteLn(Stream: TStream; const S: String); overload;
|
|
{$ENDIF}
|
|
function GetID: AnsiString;
|
|
function CryptStr(Source: AnsiString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
|
|
function CryptStream(Source: TStream; Target: TStream; Key: AnsiString; id: Integer): AnsiString;
|
|
function PrepareString(const Text: WideString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
|
|
function EscapeSpecialChar(TextStr: AnsiString): AnsiString;
|
|
function StrToUTF16(const Value: WideString): AnsiString;
|
|
function StrToUTF16H(const Value: WideString): AnsiString;
|
|
function PMD52Str(p: Pointer): AnsiString;
|
|
function PadPassword(Password: AnsiString): AnsiString;
|
|
procedure PrepareKeys;
|
|
procedure SetProtectionFlags(const Value: TfrxPDFEncBits);
|
|
procedure Clear;
|
|
procedure WriteFont(pdfFont: TfrxPDFFont);
|
|
procedure AddObject(const Obj: TfrxView);
|
|
function StrToHex(const Value: WideString): AnsiString;
|
|
function StrToHexSp(const SourceStr, Value: WideString; SpaceAdjustment: Extended): AnsiString;
|
|
function AddPage(Page: TfrxReportPage): TfrxPDFPage;
|
|
function ObjNumber(FNumber: longint): String;
|
|
function ObjNumberRef(FNumber: longint): String;
|
|
function UpdateXRef: longint;
|
|
function GetPDFColor(const Color: TAlphaColor): String;
|
|
|
|
function FindXObject(const Hash: TfrxPDFXObjectHash): Integer;
|
|
function AddXObject(Id: Integer; const Hash: TfrxPDFXObjectHash): Integer;
|
|
procedure ClearXObject;
|
|
procedure GetStreamHash(out Hash: TfrxPDFXObjectHash; S: TStream);
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
class function GetDescription: String; override;
|
|
function ShowModal: TModalResult; override;
|
|
function Start: Boolean; override;
|
|
procedure ExportObject(Obj: TfrxComponent); override;
|
|
procedure Finish; override;
|
|
procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
|
|
procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
|
|
published
|
|
property Compressed: Boolean read FCompressed write FCompressed default True;
|
|
property EmbeddedFonts: Boolean read FEmbedded write FEmbedded default False;
|
|
property EmbedFontsIfProtected: Boolean read FEmbedProt write FEmbedProt default True;
|
|
property OpenAfterExport: Boolean read FOpenAfterExport
|
|
write FOpenAfterExport default False;
|
|
property PrintOptimized: Boolean read FPrintOpt write FPrintOpt;
|
|
property Outline: Boolean read FOutline write FOutline;
|
|
property Background: Boolean read FBackground write FBackground;
|
|
property HTMLTags: Boolean read FTags write FTags;
|
|
property OverwritePrompt;
|
|
property Quality: Integer read FQuality write FQuality;
|
|
|
|
property Title: WideString read FTitle write FTitle;
|
|
property Author: WideString read FAuthor write FAuthor;
|
|
property Subject: WideString read FSubject write FSubject;
|
|
property Keywords: WideString read FKeywords write FKeywords;
|
|
property Creator: WideString read FCreator write FCreator;
|
|
property Producer: WideString read FProducer write FProducer;
|
|
|
|
property UserPassword: AnsiString read FUserPassword write FUserPassword;
|
|
property OwnerPassword: AnsiString read FOwnerPassword write FOwnerPassword;
|
|
property ProtectionFlags: TfrxPDFEncBits read FProtectionFlags write SetProtectionFlags;
|
|
|
|
property HideToolbar: Boolean read FHideToolbar write FHideToolbar;
|
|
property HideMenubar: Boolean read FHideMenubar write FHideMenubar;
|
|
property HideWindowUI: Boolean read FHideWindowUI write FHideWindowUI;
|
|
property FitWindow: Boolean read FFitWindow write FFitWindow;
|
|
property CenterWindow: Boolean read FCenterWindow write FCenterWindow;
|
|
property PrintScaling: Boolean read FPrintScaling write FPrintScaling;
|
|
end;
|
|
|
|
{ Returns a color in PDF form. }
|
|
|
|
function PdfColor(Color: TAlphaColor): AnsiString;
|
|
|
|
{ Returns a pair of coordinates in PDF form. }
|
|
|
|
function PdfPoint(x, y: Double): AnsiString;
|
|
|
|
{ Moves the pen to the specified point. }
|
|
|
|
function PdfMove(x, y: Double): AnsiString;
|
|
|
|
{ Draws a line to the specified point. }
|
|
|
|
function PdfLine(x, y: Double): AnsiString;
|
|
|
|
{ Changes the current color. }
|
|
|
|
function PdfSetColor(Color: TAlphaColor): AnsiString;
|
|
|
|
{ Changes width of the line drawed by the pen.
|
|
The width is measured in points (1/72 of an inch). }
|
|
|
|
function PdfSetLineWidth(Width: Double): AnsiString;
|
|
|
|
{ Changes the color of the pen. }
|
|
|
|
function PdfSetLineColor(Color: TAlphaColor): AnsiString;
|
|
|
|
{ Fills the latest contoured area. }
|
|
|
|
function PdfFill: AnsiString;
|
|
|
|
{ Fills a rectangle area. }
|
|
|
|
function PdfFillRect(Left, Bottom, Right, Top: Double; Color: TAlphaColor): AnsiString;
|
|
|
|
{ Returns either (...) or <...> sequence. }
|
|
|
|
function PdfString(const Str: WideString): AnsiString;
|
|
|
|
// list of fonts that do not have bold-italic versions and needs to be simulated
|
|
var
|
|
frxPDFFontsNeedStyleSimulation: TStringList;
|
|
|
|
implementation
|
|
|
|
uses FMX.frxUtils, FMX.frxUnicodeUtils, {FMX.frxFileUtils,} FMX.frxRes, FMX.frxrcExports, FMX.frxPreviewPages,
|
|
FMX.frxGraphicUtils, FMX.frxGzip, FMX.frxMD5, System.Math, FMX.frxXML,
|
|
FMX.frxCrypto
|
|
{$IFDEF LINUX}
|
|
, FMX.frxLinuxFonts
|
|
, FMUX.Api
|
|
{$ENDIF};
|
|
|
|
{$IFDEF MACOS}
|
|
const
|
|
libCore = '/System/Library/Frameworks/ApplicationServices.framework/Frameworks/ATS.framework/ATS';
|
|
frxCoreFoundationLib = '/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation';
|
|
{$IFDEF UNDERSCOREIMPORTNAME}
|
|
_PFX = '_';
|
|
{$ELSE}
|
|
_PFX = '';
|
|
{$ENDIF}
|
|
function ATSFontGetFileReference( iFont: ATSFontRef; var oFile: FSRef ): OSStatus; cdecl; external libCore name _PFX + 'ATSFontGetFileReference';
|
|
{$ENDIF}
|
|
const
|
|
PDF_VER = '1.5';
|
|
PDF_DIVIDER = 0.75;
|
|
PDF_MARG_DIVIDER = 0.05;
|
|
PDF_PRINTOPT = 3;
|
|
PDF_PK: array [ 1..32 ] of Byte =
|
|
( $28, $BF, $4E, $5E, $4E, $75, $8A, $41, $64, $00, $4E, $56, $FF, $FA, $01, $08,
|
|
$2E, $2E, $00, $B6, $D0, $68, $3E, $80, $2F, $0C, $A9, $FE, $64, $53, $69, $7A );
|
|
KAPPA1 = 1.5522847498;
|
|
KAPPA2 = 2 - KAPPA1;
|
|
tpPt = 0.00357; //typography pt
|
|
|
|
|
|
{$R *.fmx}
|
|
|
|
{ PDF commands }
|
|
|
|
{$IFDEF MACOS}
|
|
type
|
|
TfrxCFURLStartAccessingSecurityScopedResource = function (url: CFURLRef): Boolean; cdecl;
|
|
TfrxCFURLStopAccessingSecurityScopedResource = procedure (url: CFURLRef); cdecl;
|
|
|
|
var
|
|
kCTFontURLAttribute_ : Pointer;
|
|
_frxCFURLStartAccessingSecurityScopedResource: TfrxCFURLStartAccessingSecurityScopedResource;
|
|
_frxCFURLStopAccessingSecurityScopedResource: TfrxCFURLStopAccessingSecurityScopedResource;
|
|
|
|
function ConvCFString(const Value: CFStringRef): String;
|
|
begin
|
|
if Assigned(Value) then
|
|
Result := string(TNSString.Wrap(Value).UTF8String)
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function kCTFontURLAttribute: Pointer;
|
|
var
|
|
CTLib: HMODULE;
|
|
begin
|
|
CTLib := LoadLibrary(libCoreText);
|
|
if kCTFontURLAttribute_ = nil then
|
|
kCTFontURLAttribute_ := Pointer(GetProcAddress(CTLib, PWideChar('kCTFontURLAttribute'))^);
|
|
FreeLibrary(CTLib);
|
|
Result := kCTFontURLAttribute_;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function PdfSetLineColor(Color: TAlphaColor): AnsiString;
|
|
begin
|
|
Result := PdfColor(Color) + ' RG'#13#10;
|
|
end;
|
|
|
|
function PdfSetLineWidth(Width: Double): AnsiString;
|
|
begin
|
|
Result := AnsiString(frFloat2Str(Width, 2) + ' w'#13#10);
|
|
end;
|
|
|
|
function PdfFillRect(Left, Bottom, Right, Top: Double; Color: TAlphaColor): AnsiString;
|
|
begin
|
|
Result := PdfSetLineWidth(0) + PdfSetLineColor(Color) + PdfSetColor(Color) +
|
|
PdfMove(Left, Bottom) + PdfLine(Right, Bottom) + PdfLine(Right, Top) +
|
|
PdfLine(Left, Top) + PdfFill;
|
|
end;
|
|
|
|
function PdfSetColor(Color: TAlphaColor): AnsiString;
|
|
begin
|
|
Result := PdfColor(Color) + ' rg'#13#10;
|
|
end;
|
|
|
|
function PdfFill: AnsiString;
|
|
begin
|
|
Result := 'B'#13#10;
|
|
end;
|
|
|
|
function PdfPoint(x, y: Double): AnsiString;
|
|
begin
|
|
Result := AnsiString(frFloat2Str(x, 2) + ' ' + frFloat2Str(y, 2));
|
|
end;
|
|
|
|
function PdfLine(x, y: Double): AnsiString;
|
|
begin
|
|
Result := PdfPoint(x, y) + ' l'#13#10;
|
|
end;
|
|
|
|
function PdfMove(x, y: Double): AnsiString;
|
|
begin
|
|
Result := PdfPoint(x, y) + ' m'#13#10;
|
|
end;
|
|
|
|
function PdfColor(Color: TAlphaColor): AnsiString;
|
|
|
|
function c(x: Integer): AnsiString;
|
|
begin
|
|
if x < 1 then
|
|
Result := '0'
|
|
else if x > 254 then
|
|
Result := '1'
|
|
else
|
|
Result := AnsiString('0.' + IntToStr(x * 100 shr 8));
|
|
|
|
{ Actually, Result = x * 100 div 255, but
|
|
division by 255 works much slower then
|
|
division by 256. }
|
|
end;
|
|
|
|
var
|
|
r, g, b: Integer;
|
|
begin
|
|
|
|
b := Color and $ff;
|
|
g := Color shr 8 and $ff;
|
|
r := Color shr 16 and $ff;
|
|
|
|
Result := c(r) + ' ' + c(g) + ' ' + c(b);
|
|
end;
|
|
|
|
function PdfString(const Str: WideString): AnsiString;
|
|
|
|
{ A string is literal if parentheses in it are balanced and all characters
|
|
are within the printable ASCII characters set. }
|
|
|
|
function IsLiteralString(const s: WideString): Boolean;
|
|
var
|
|
i: Integer;
|
|
nop: Integer; // number of opened parentheses
|
|
begin
|
|
Result := False;
|
|
nop := 0;
|
|
|
|
for i := 1 to Length(s) do
|
|
if s[i] = '(' then
|
|
Inc(nop)
|
|
else if s[i] = ')' then
|
|
if nop > 0 then
|
|
Dec(nop)
|
|
else
|
|
Exit
|
|
// printable ASCII characters are those with codes 32..126
|
|
else if (Word(s[i]) < 32) or (Word(s[i]) > 126) then
|
|
Exit;
|
|
|
|
Result := nop = 0;
|
|
end;
|
|
|
|
function GetLiteralString(const s: WideString): AnsiString;
|
|
begin
|
|
Result := '(' + AnsiString(s) + ')'
|
|
end;
|
|
|
|
function GetHexString(const s: WideString): AnsiString;
|
|
var
|
|
i: Integer;
|
|
hs: AnsiString;
|
|
begin
|
|
SetLength(Result, 2 + Length(s) * 4);
|
|
Result[1] := '<';
|
|
Result[Length(Result)] := '>';
|
|
|
|
for i := 1 to Length(s) do
|
|
begin
|
|
hs := AnsiString(IntToHex(Word(s[i]), 4));
|
|
|
|
Result[i*4 - 3 + 1] := hs[1];
|
|
Result[i*4 - 3 + 2] := hs[2];
|
|
Result[i*4 - 3 + 3] := hs[3];
|
|
Result[i*4 - 3 + 4] := hs[4];
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if IsLiteralString(Str) then
|
|
Result := GetLiteralString(Str)
|
|
else
|
|
Result := GetHexString(Str)
|
|
end;
|
|
|
|
function PdfSubstituteName(const aName: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := aName;
|
|
i := 1;
|
|
while i <= ((High(Substitutes) - Low(Substitutes))) do
|
|
begin
|
|
if UTF8Decode(Substitutes[i]) = aName then
|
|
begin
|
|
Result := UTF8Decode(Substitutes[i + 1]);
|
|
break;
|
|
end;
|
|
i := i + 2;
|
|
end;
|
|
end;
|
|
|
|
{ TfrxPDFOutlineNode }
|
|
|
|
constructor TfrxPDFOutlineNode.Create;
|
|
begin
|
|
inherited;
|
|
Dest := -1;
|
|
end;
|
|
|
|
destructor TfrxPDFOutlineNode.Destroy;
|
|
begin
|
|
if Next <> nil then
|
|
Next.Free;
|
|
|
|
if First <> nil then
|
|
First.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
{ TfrxPDFExport }
|
|
|
|
constructor TfrxPDFExport.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FPageAnnots := TMemoryStream.Create;
|
|
FAnnots := TList.Create;
|
|
FCompressed := True;
|
|
FEmbedProt := True;
|
|
FPrintOpt := False;
|
|
FAuthor := 'FastReport';
|
|
FSubject := 'FastReport PDF export';
|
|
FBackground := False;
|
|
FCreator := 'FastReport';
|
|
FTags := True;
|
|
FProtection := False;
|
|
FUserPassword := '';
|
|
FOwnerPassword := '';
|
|
FProducer := '';
|
|
FKeywords := '';
|
|
FProtectionFlags := [ePrint, eModify, eCopy, eAnnot];
|
|
FilterDesc := frxGet(8707);
|
|
DefaultExt := frxGet(8708);
|
|
FCreator := Application.Name;
|
|
FPrintScaling := False;
|
|
FFitWindow := False;
|
|
FHideMenubar := False;
|
|
FCenterWindow := False;
|
|
FHideWindowUI := False;
|
|
FHideToolbar := False;
|
|
|
|
FRootNumber := 0;
|
|
FPagesNumber := 0;
|
|
FInfoNumber := 0;
|
|
FStartXRef := 0;
|
|
|
|
FPages := TList.Create;
|
|
FFonts := TList.Create;
|
|
FPageFonts := TList.Create;
|
|
FXRef := TStringList.Create;
|
|
FPagesRef := TStringList.Create;
|
|
|
|
FMarginLeft := 0;
|
|
FMarginWoBottom := 0;
|
|
|
|
FEncKey := '';
|
|
FOPass := '';
|
|
FUPass := '';
|
|
|
|
FEncBits := 0;
|
|
|
|
FDivider := 96;//frxDrawText.DefPPI / frxDrawText.ScrPPI;
|
|
FLastColor := claBlack;
|
|
FLastColorResult := '0 0 0';
|
|
|
|
FQuality := 95;
|
|
FBmpCanvas := TBitmap.Create(1, 1);
|
|
end;
|
|
|
|
destructor TfrxPDFExport.Destroy;
|
|
begin
|
|
Clear;
|
|
FPageAnnots.Free;
|
|
FAnnots.Free;
|
|
FFonts.Free;
|
|
FPageFonts.Free;
|
|
FXRef.Free;
|
|
FPagesRef.Free;
|
|
FPages.Free;
|
|
FBmpCanvas.Free;
|
|
inherited;
|
|
end;
|
|
|
|
class function TfrxPDFExport.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('PDFexport');
|
|
end;
|
|
|
|
function TfrxPDFExport.ShowModal: TModalResult;
|
|
var
|
|
s: String;
|
|
begin
|
|
if (FTitle = '') and Assigned(Report) then
|
|
FTitle := Report.ReportOptions.Name;
|
|
if not Assigned(Stream) then
|
|
begin
|
|
if Assigned(Report) then
|
|
FOutline := Report.PreviewOptions.OutlineVisible
|
|
else
|
|
FOutline := True;
|
|
with TfrxPDFExportDialog.Create(nil) do
|
|
begin
|
|
OpenCB.Visible := not SlaveExport;
|
|
if OverwritePrompt then
|
|
SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
|
|
if SlaveExport then
|
|
FOpenAfterExport := False;
|
|
|
|
if (FileName = '') and (not SlaveExport) then
|
|
begin
|
|
s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt);
|
|
SaveDialog1.FileName := s;
|
|
end
|
|
else
|
|
SaveDialog1.FileName := FileName;
|
|
|
|
OpenCB.IsChecked := FOpenAfterExport;
|
|
CompressedCB.IsChecked := FCompressed;
|
|
EmbeddedCB.IsChecked := FEmbedded;
|
|
PrintOptCB.IsChecked := FPrintOpt;
|
|
OutlineCB.IsChecked := FOutline;
|
|
OutlineCB.Enabled := FOutline;
|
|
BackgrCB.IsChecked := FBackground;
|
|
|
|
if PageNumbers <> '' then
|
|
begin
|
|
PageNumbersE.Text := PageNumbers;
|
|
PageNumbersRB.IsChecked := True;
|
|
end;
|
|
|
|
OwnPassE.Text := String(FOwnerPassword);
|
|
UserPassE.Text := String(FUserPassword);
|
|
PrintCB.IsChecked := ePrint in FProtectionFlags;
|
|
CopyCB.IsChecked := eCopy in FProtectionFlags;
|
|
ModCB.IsChecked := eModify in FProtectionFlags;
|
|
AnnotCB.IsChecked := eAnnot in FProtectionFlags;
|
|
|
|
TitleE.Text := FTitle;
|
|
AuthorE.Text := FAuthor;
|
|
SubjectE.Text := FSubject;
|
|
KeywordsE.Text := FKeywords;
|
|
CreatorE.Text := FCreator;
|
|
ProducerE.Text := FProducer;
|
|
|
|
PrintScalingCB.IsChecked := FPrintScaling;
|
|
FitWindowCB.IsChecked := FFitWindow;
|
|
HideMenubarCB.IsChecked := FHideMenubar;
|
|
CenterWindowCB.IsChecked := FCenterWindow;
|
|
HideWindowUICB.IsChecked := FHideWindowUI;
|
|
HideToolbarCB.IsChecked := FHideToolbar;
|
|
|
|
Result := ShowModal;
|
|
PeekLastModalResult;
|
|
if Result = mrOk then
|
|
begin
|
|
FOwnerPassword := AnsiString(OwnPassE.Text);
|
|
FUserPassword := AnsiString(UserPassE.Text);
|
|
FProtectionFlags := [];
|
|
if PrintCB.IsChecked then
|
|
FProtectionFlags := FProtectionFlags + [ePrint];
|
|
if CopyCB.IsChecked then
|
|
FProtectionFlags := FProtectionFlags + [eCopy];
|
|
if ModCB.IsChecked then
|
|
FProtectionFlags := FProtectionFlags + [eModify];
|
|
if AnnotCB.IsChecked then
|
|
FProtectionFlags := FProtectionFlags + [eAnnot];
|
|
SetProtectionFlags(FProtectionFlags);
|
|
PageNumbers := '';
|
|
CurPage := False;
|
|
if CurPageRB.IsChecked then
|
|
CurPage := True
|
|
else if PageNumbersRB.IsChecked then
|
|
PageNumbers := PageNumbersE.Text;
|
|
|
|
FOpenAfterExport := OpenCB.IsChecked;
|
|
FCompressed := CompressedCB.IsChecked;
|
|
FEmbedded := EmbeddedCB.IsChecked;
|
|
FPrintOpt := PrintOptCB.IsChecked;
|
|
FOutline := OutlineCB.IsChecked;
|
|
FBackground := BackgrCB.IsChecked;
|
|
//FQuality := StrToInt(Quality.Text);
|
|
|
|
FTitle := TitleE.Text;
|
|
FAuthor := AuthorE.Text;
|
|
FSubject := SubjectE.Text;
|
|
FKeywords := KeywordsE.Text;
|
|
FCreator := CreatorE.Text;
|
|
FProducer := ProducerE.Text;
|
|
|
|
FPrintScaling := PrintScalingCB.IsChecked;
|
|
FFitWindow := FitWindowCB.IsChecked;
|
|
FHideMenubar := HideMenubarCB.IsChecked;
|
|
FCenterWindow := CenterWindowCB.IsChecked;
|
|
FHideWindowUI := HideWindowUICB.IsChecked;
|
|
FHideToolbar := HideToolbarCB.IsChecked;
|
|
|
|
if not SlaveExport then
|
|
begin
|
|
if DefaultPath <> '' then
|
|
SaveDialog1.InitialDir := DefaultPath;
|
|
if SaveDialog1.Execute then
|
|
FileName := SaveDialog1.FileName
|
|
else
|
|
Result := mrCancel;
|
|
PeekLastModalResult;
|
|
end;
|
|
end;
|
|
Free;
|
|
end;
|
|
end else
|
|
Result := mrOk;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FFonts.Count - 1 do
|
|
TfrxPDFFont(FFonts[i]).Free;
|
|
|
|
for i := 0 to FPages.Count - 1 do
|
|
TObject(FPages[i]).Free;
|
|
|
|
for i := 0 to FAnnots.Count - 1 do
|
|
TObject(FAnnots[i]).Free;
|
|
|
|
FPages.Clear;
|
|
FFonts.Clear;
|
|
FPageFonts.Clear;
|
|
FXRef.Clear;
|
|
FPageAnnots.Clear;
|
|
FAnnots.Clear;
|
|
FPagesRef.Clear;
|
|
end;
|
|
|
|
function TfrxPDFExport.GetID: AnsiString;
|
|
var
|
|
AGUID: TGUID;
|
|
AGUIDString: widestring;
|
|
begin
|
|
CreateGUID(AGUID);
|
|
SetLength(AGUIDString, 39);
|
|
AGUIDString := GUIDToString(AGUID);
|
|
//StringFromGUID2(AGUID, PWideChar(AGUIDString), 39);
|
|
Result := AnsiString(PWideChar(AGUIDString));
|
|
MD5String(AnsiString(PWideChar(AGUIDString)));
|
|
end;
|
|
|
|
function TfrxPDFExport.Start: Boolean;
|
|
begin
|
|
if SlaveExport then
|
|
begin
|
|
if Report.FileName <> '' then
|
|
FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8708))
|
|
else
|
|
FileName := ChangeFileExt(GetTempFile, frxGet(8708))
|
|
end;
|
|
|
|
if (FileName <> '') or Assigned(Stream) then
|
|
begin
|
|
if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
|
|
FileName := DefaultPath + PathDelim + FileName;
|
|
FProtection := (FOwnerPassword <> '') or (FUserPassword <> '');
|
|
if Assigned(Stream) then
|
|
pdf := Stream
|
|
else
|
|
pdf := TFileStream.Create(FileName, fmCreate);
|
|
Result := True;
|
|
// start here
|
|
Clear;
|
|
FFileID := MD5String(GetID);
|
|
if FProtection then
|
|
begin
|
|
PrepareKeys;
|
|
FEmbedded := FEmbedProt;
|
|
end;
|
|
|
|
if FOutline then
|
|
FPreviewOutline := Report.PreviewPages.Outline;
|
|
|
|
WriteLn(pdf, '%PDF-' + PDF_VER);
|
|
UpdateXRef;
|
|
end else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.StartPage(Page: TfrxReportPage; Index: Integer);
|
|
const
|
|
mm2p: Double = 1.0 / 25.4 * 72; // millimeters to points
|
|
begin
|
|
SetLength(FUsedXObjects, 0);
|
|
|
|
AddPage(Page);
|
|
FWidth := Page.Width * PDF_DIVIDER;
|
|
FHeight := Page.Height * PDF_DIVIDER;
|
|
FMarginLeft := Page.LeftMargin * PDF_MARG_DIVIDER;
|
|
FMarginTop := Page.TopMargin * PDF_MARG_DIVIDER;
|
|
OutStream := TMemoryStream.Create;
|
|
|
|
with Page do
|
|
if Color <> claNull then
|
|
Write(OutStream, PdfFillRect(LeftMargin * mm2p,
|
|
BottomMargin * mm2p, FWidth - RightMargin * mm2p,
|
|
FHeight - TopMargin * mm2p, Color));
|
|
end;
|
|
|
|
procedure TfrxPDFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
|
|
var
|
|
FContentsPos, FPagePos: Integer;
|
|
s: String;
|
|
i: Integer;
|
|
TmpPageStream: TMemoryStream;
|
|
TmpPageStream2: TMemoryStream;
|
|
begin
|
|
// finish page
|
|
FContentsPos := UpdateXRef();
|
|
WriteLn(pdf, ObjNumber(FContentsPos));
|
|
Write(pdf, '<< ');
|
|
TmpPageStream := TMemoryStream.Create;
|
|
TmpPageStream2 := TMemoryStream.Create;
|
|
try
|
|
OutStream.Position := 0;
|
|
TmpPageStream2.CopyFrom(OutStream, OutStream.Size);
|
|
if FCompressed then
|
|
begin
|
|
frxDeflateStream(TmpPageStream2, TmpPageStream, gzFastest);
|
|
s := '/Filter /FlateDecode /Length ' + IntToStr(TmpPageStream.Size) +
|
|
' /Length1 ' + IntToStr(TmpPageStream2.Size);
|
|
end
|
|
else
|
|
s := '/Length ' + IntToStr(TmpPageStream2.Size);
|
|
WriteLn(pdf, s + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
|
|
if FCompressed then
|
|
begin
|
|
if FProtection then
|
|
CryptStream(TmpPageStream, pdf, FEncKey, FContentsPos)
|
|
else
|
|
pdf.CopyFrom(TmpPageStream, 0);
|
|
WriteLn(pdf, '');
|
|
end else
|
|
if FProtection then
|
|
CryptStream(TmpPageStream2, pdf, FEncKey, FContentsPos)
|
|
else
|
|
pdf.CopyFrom(TmpPageStream2, 0);
|
|
finally
|
|
TmpPageStream2.Free;
|
|
TmpPageStream.Free;
|
|
end;
|
|
WriteLn(pdf, 'endstream');
|
|
WriteLn(pdf, 'endobj');
|
|
|
|
OutStream.Free;
|
|
|
|
if FPageFonts.Count > 0 then
|
|
for i := 0 to FPageFonts.Count - 1 do
|
|
if not TfrxPDFFont(FPageFonts[i]).Saved then
|
|
begin
|
|
TfrxPDFFont(FPageFonts[i]).Reference := UpdateXRef;
|
|
TfrxPDFFont(FPageFonts[i]).Saved := true;
|
|
end;
|
|
|
|
FPagePos := UpdateXRef();
|
|
FPagesRef.Add(IntToStr(FPagePos));
|
|
WriteLn(pdf, ObjNumber(FPagePos));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Page');
|
|
WriteLn(pdf, '/Parent 1 0 R');
|
|
WriteLn(pdf, '/MediaBox [0 0 ' + frFloat2Str(FWidth) +
|
|
' ' + frFloat2Str(FHeight) + ' ]');
|
|
|
|
{ Write the list of references
|
|
to anchor objects }
|
|
|
|
if FPageAnnots.Size > 0 then
|
|
begin
|
|
WriteLn(PDF, '/Annots [');
|
|
FPageAnnots.Seek(Int64(0), soFromBeginning);
|
|
PDF.CopyFrom(FPageAnnots, FPageAnnots.Size);
|
|
WriteLn(PDF, ']');
|
|
FPageAnnots.Clear;
|
|
end;
|
|
|
|
WriteLn(pdf, '/Resources <<');
|
|
Write(pdf, '/Font << ');
|
|
for i := 0 to FPageFonts.Count - 1 do
|
|
{$IFDEF Delphi12}
|
|
Write(pdf, TfrxPDFFont(FPageFonts[i]).Name + AnsiString(' ' + ObjNumberRef(TfrxPDFFont(FPageFonts[i]).Reference) + ' '));
|
|
{$ELSE}
|
|
Write(pdf, TfrxPDFFont(FPageFonts[i]).Name + ' ' + ObjNumberRef(TfrxPDFFont(FPageFonts[i]).Reference) + ' ');
|
|
{$ENDIF}
|
|
WriteLn(pdf, '>>');
|
|
if Length(FUsedXObjects) > 0 then
|
|
begin
|
|
Write(pdf, '/XObject << ');
|
|
|
|
for i := 0 to High(FUsedXObjects) do
|
|
begin
|
|
Write(pdf, '/Im' + IntToStr(FUsedXObjects[i]) + ' ');
|
|
Write(pdf, ObjNumberRef(FXObjects[FUsedXObjects[i]].ObjId) + ' ');
|
|
end;
|
|
|
|
Writeln(pdf, '>>');
|
|
end;
|
|
WriteLn(pdf, '/ProcSet [/PDF /Text /ImageC ]');
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, '/Contents ' + ObjNumberRef(FContentsPos));
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
{ Clear piture cache }
|
|
Self.ClearXObject;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.ExportObject(Obj: TfrxComponent);
|
|
begin
|
|
if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
|
|
AddObject(Obj as TfrxView);
|
|
end;
|
|
|
|
procedure TfrxPDFExport.Finish;
|
|
var
|
|
i: Integer;
|
|
s: string;
|
|
FInfoNumber, FRootNumber: Longint;
|
|
OutlineTree: TfrxPDFOutlineNode;
|
|
pgN: TStringList;
|
|
FOutlineObjId: Integer;
|
|
|
|
function IsPageInRange(const PageN: Integer): Boolean;
|
|
begin
|
|
Result := (pgN.Count = 0) or (pgN.IndexOf(IntToStr(PageN + 1)) >= 0);
|
|
end;
|
|
|
|
{ Converts TfrxCustomOutline to a tree of TfrxPDFOutlineNode nodes.
|
|
The last argument represents the number of already added objects
|
|
to FXRef. This value is needed to correctly assign object numbers
|
|
to TfrxPDFOutlineNode nodes. }
|
|
|
|
procedure PrepareOutline(Outline: TfrxCustomOutline; Node: TfrxPDFOutlineNode;
|
|
ObjNum: Integer);
|
|
var
|
|
i: Integer;
|
|
p: TfrxPDFOutlineNode;
|
|
Prev: TfrxPDFOutlineNode;
|
|
Text: string;
|
|
Page, Top: Integer;
|
|
begin
|
|
Prev := nil;
|
|
p := nil;
|
|
|
|
for i := 0 to Outline.Count - 1 do
|
|
begin
|
|
Outline.GetItem(i, Text, Page, Top);
|
|
if not IsPageInRange(Page) then
|
|
Continue;
|
|
|
|
p := TfrxPDFOutlineNode.Create;
|
|
p.Title := Text;
|
|
p.Dest := Page;
|
|
p.Top := Top;
|
|
p.Prev := Prev;
|
|
|
|
Inc(ObjNum);
|
|
p.Number := ObjNum;
|
|
|
|
if Prev <> nil then
|
|
Prev.Next := p
|
|
else
|
|
Node.First := p;
|
|
|
|
Prev := p;
|
|
p.Parent := Node;
|
|
Outline.LevelDown(i);
|
|
|
|
PrepareOutline(Outline, p, ObjNum);
|
|
Inc(ObjNum, p.CountTree);
|
|
|
|
Node.Count := Node.Count + 1;
|
|
Node.CountTree := Node.CountTree + p.CountTree + 1;
|
|
Outline.LevelUp;
|
|
end;
|
|
|
|
Node.Last := p;
|
|
end;
|
|
|
|
procedure WriteOutline(Node: TfrxPDFOutlineNode);
|
|
var
|
|
Page, y: Integer;
|
|
Dest: string;
|
|
begin
|
|
{ Actually, the following line of code does nothing:
|
|
UpdateXRef returns a number that was predicted
|
|
by PrepareOutline. }
|
|
|
|
Node.Number := UpdateXRef;
|
|
|
|
WriteLn(pdf, IntToStr(Node.Number) + ' 0 obj');
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Title ' + PrepareString(Node.Title, FEncKey, FProtection, Node.Number));
|
|
WriteLn(pdf, '/Parent ' + IntToStr(Node.Parent.Number) + ' 0 R');
|
|
|
|
if Node.Prev <> nil then
|
|
WriteLn(pdf, '/Prev ' + IntToStr(Node.Prev.Number) + ' 0 R');
|
|
|
|
if Node.Next <> nil then
|
|
WriteLn(pdf, '/Next ' + IntToStr(Node.Next.Number) + ' 0 R');
|
|
|
|
if Node.First <> nil then
|
|
begin
|
|
WriteLn(pdf, '/First ' + IntToStr(Node.First.Number) + ' 0 R');
|
|
WriteLn(pdf, '/Last ' + IntToStr(Node.Last.Number) + ' 0 R');
|
|
WriteLn(pdf, '/Count ' + IntToStr(Node.Count));
|
|
end;
|
|
|
|
if IsPageInRange(Node.Dest) then
|
|
begin
|
|
if pgN.Count > 0 then
|
|
Page := pgN.IndexOf(IntToStr(Node.Dest + 1))
|
|
else
|
|
Page := Node.Dest;
|
|
|
|
y := Round(TfrxPDFPage(FPages[Page]).Height - Node.Top * PDF_DIVIDER);
|
|
Dest := FPagesRef[Page];
|
|
WriteLn(pdf, '/Dest [' + Dest + ' 0 R /XYZ 0 ' + IntToStr(y) + ' 0]');
|
|
end;
|
|
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
|
|
if Node.First <> nil then
|
|
WriteOutline(Node.First);
|
|
|
|
if Node.Next <> nil then
|
|
WriteOutline(Node.Next);
|
|
end;
|
|
|
|
procedure WriteAnnots;
|
|
var
|
|
i: Integer;
|
|
annot: TfrxPDFAnnot;
|
|
begin
|
|
for i := 0 to FAnnots.Count - 1 do
|
|
begin
|
|
annot := TfrxPDFAnnot(FAnnots[i]);
|
|
// fix xref position
|
|
FXref[annot.Number - 1] := PrepXrefPos(pdf.Position);
|
|
|
|
Writeln(pdf, ObjNumber(annot.Number));
|
|
Writeln(pdf, '<<');
|
|
Writeln(pdf, '/Type /Annot');
|
|
Writeln(pdf, '/Subtype /Link');
|
|
Writeln(pdf, '/Rect [' + annot.Rect + ']');
|
|
|
|
if annot.Hyperlink <> '' then
|
|
begin
|
|
Writeln(pdf, '/BS << /W 0 >>');
|
|
Writeln(pdf, '/A <<');
|
|
Writeln(pdf, '/URI ' + annot.Hyperlink);
|
|
Writeln(pdf, '/Type /Action');
|
|
Writeln(pdf, '/S /URI');
|
|
Writeln(pdf, '>>');
|
|
end
|
|
else
|
|
begin
|
|
Writeln(pdf, '/Border [16 16 0]');
|
|
Writeln(pdf, '/Dest [' + FPagesRef[annot.DestPage] +
|
|
' 0 R /XYZ null ' + IntToStr(annot.DestY) + ' null]');
|
|
end;
|
|
|
|
Writeln(pdf, '>>');
|
|
Writeln(pdf, 'endobj');
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
for i := 0 to FFonts.Count - 1 do
|
|
WriteFont(TfrxPDFFont(FFonts[i]));
|
|
|
|
FPagesNumber := 1;
|
|
FXRef[0] := PrepXrefPos(pdf.Position);
|
|
WriteLn(pdf, ObjNumber(FPagesNumber));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Pages');
|
|
Write(pdf, '/Kids [');
|
|
for i := 0 to FPagesRef.Count - 1 do
|
|
Write(pdf, FPagesRef[i] + ' 0 R ');
|
|
WriteLn(pdf, ']');
|
|
WriteLn(pdf, '/Count ' + IntTOStr(FPagesRef.Count));
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
FInfoNumber := UpdateXRef();
|
|
WriteLn(pdf, ObjNumber(FInfoNumber));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Title ' + PrepareString(FTitle, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/Author ' + PrepareString(FAuthor, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/Subject ' + PrepareString(FSubject, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/Keywords ' + PrepareString(FKeywords, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/Creator ' + PrepareString(FCreator, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/Producer ' + PrepareString(FProducer, FEncKey, FProtection, FInfoNumber));
|
|
s := 'D:' + FormatDateTime('yyyy', Now) + FormatDateTime('mm', Now) +
|
|
FormatDateTime('dd', Now) + FormatDateTime('hh', Now) +
|
|
FormatDateTime('nn', Now) + FormatDateTime('ss', Now);
|
|
if FProtection then
|
|
begin
|
|
WriteLn(pdf, '/CreationDate ' + PrepareString(s, FEncKey, FProtection, FInfoNumber));
|
|
WriteLn(pdf, '/ModDate ' + PrepareString(s, FEncKey, FProtection, FInfoNumber));
|
|
end
|
|
else
|
|
begin
|
|
WriteLn(pdf, '/CreationDate (' + s + ')');
|
|
WriteLn(pdf, '/ModDate (' + s + ')');
|
|
end;
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
|
|
{ Write the document outline }
|
|
|
|
OutlineTree := TfrxPDFOutlineNode.Create;
|
|
pgN := TStringList.Create;
|
|
FOutlineObjId := 0;
|
|
|
|
if FOutline then
|
|
begin
|
|
frxParsePageNumbers(PageNumbers, pgN, Report.PreviewPages.Count);
|
|
FPreviewOutline.LevelRoot;
|
|
|
|
{ PrepareOutline needs to know the exact number of objects
|
|
that will be written before the first outline node object.
|
|
The number of already written objects is FXRef.Count, and
|
|
one object (/Type /Outlines) will be written before the first
|
|
outline node. That's why PrepareOutline is given FXRef.Count + 1. }
|
|
|
|
PrepareOutline(FPreviewOutline, OutlineTree, FXRef.Count + 1);
|
|
end;
|
|
|
|
if OutlineTree.CountTree > 0 then
|
|
begin
|
|
FOutlineObjId := UpdateXRef;
|
|
OutlineTree.Number := FOutlineObjId;
|
|
|
|
{ It's important to write the /Outlines object first,
|
|
because object numbers for outline nodes was calculated
|
|
in assumption that /Outlines will be written first. }
|
|
|
|
WriteLn(pdf, IntToStr(FOutlineObjId) + ' 0 obj');
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Outlines');
|
|
WriteLn(pdf, '/Count ' + IntToStr(OutlineTree.Count));
|
|
WriteLn(pdf, '/First ' + IntToStr(OutlineTree.First.Number) + ' 0 R');
|
|
WriteLn(pdf, '/Last ' + IntToStr(OutlineTree.Last.Number) + ' 0 R');
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
|
|
{ Write outline nodes }
|
|
|
|
WriteOutline(OutlineTree.First);
|
|
end;
|
|
|
|
OutlineTree.Free;
|
|
pgN.Free;
|
|
|
|
{ Write annots }
|
|
if FAnnots.Count > 0 then
|
|
WriteAnnots;
|
|
|
|
{ Write the catalog }
|
|
|
|
FRootNumber := UpdateXRef;
|
|
WriteLn(pdf, ObjNumber(FRootNumber));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Catalog');
|
|
WriteLn(pdf, '/Pages ' + IntToStr(FPagesNumber) + ' 0 R');
|
|
|
|
if FOutline then
|
|
s := '/UseOutlines'
|
|
else
|
|
s := '/UseNone';
|
|
|
|
WriteLn(pdf, '/PageMode ' + s);
|
|
|
|
if FOutline then
|
|
WriteLn(pdf, '/Outlines ' + IntToStr(FOutlineObjId) + ' 0 R');
|
|
|
|
WriteLn(pdf, '/ViewerPreferences <<');
|
|
|
|
if FTitle <> '' then
|
|
WriteLn(pdf, '/DisplayDocTitle true');
|
|
if FHideToolbar then
|
|
WriteLn(pdf, '/HideToolbar true');
|
|
if FHideMenubar then
|
|
WriteLn(pdf, '/HideMenubar true');
|
|
if FHideWindowUI then
|
|
WriteLn(pdf, '/HideWindowUI true');
|
|
if FFitWindow then
|
|
WriteLn(pdf, '/FitWindow true');
|
|
if FCenterWindow then
|
|
WriteLn(pdf, '/CenterWindow true');
|
|
if not FPrintScaling then
|
|
WriteLn(pdf, '/PrintScaling /None');
|
|
|
|
WriteLn(pdf, '>>');
|
|
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
|
|
FStartXRef := pdf.Position;
|
|
WriteLn(pdf, 'xref');
|
|
WriteLn(pdf, '0 ' + IntToStr(FXRef.Count + 1));
|
|
WriteLn(pdf, '0000000000 65535 f');
|
|
for i := 0 to FXRef.Count - 1 do
|
|
WriteLn(pdf, FXRef[i] + ' 00000 n');
|
|
WriteLn(pdf, 'trailer');
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Size ' + IntToStr(FXRef.Count + 1));
|
|
WriteLn(pdf, '/Root ' + ObjNumberRef(FRootNumber));
|
|
WriteLn(pdf, '/Info ' + ObjNumberRef(FInfoNumber));
|
|
WriteLn(pdf, '/ID [<' + FFileID + '><' + FFileID + '>]');
|
|
if FProtection then
|
|
begin
|
|
WriteLn(pdf, '/Encrypt <<');
|
|
WriteLn(pdf, '/Filter /Standard' );
|
|
WriteLn(pdf, '/V 2');
|
|
WriteLn(pdf, '/R 3');
|
|
WriteLn(pdf, '/Length 128');
|
|
WriteLn(pdf, '/P ' + IntToStr(Integer(FEncBits)));
|
|
WriteLn(pdf, '/O (' + EscapeSpecialChar(FOPass) + ')');
|
|
WriteLn(pdf, '/U (' + EscapeSpecialChar(FUPass) + ')');
|
|
WriteLn(pdf, '>>');
|
|
end;
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'startxref');
|
|
WriteLn(pdf, IntToStr(FStartXRef));
|
|
WriteLn(pdf, '%%EOF');
|
|
Clear;
|
|
if not Assigned(Stream) then
|
|
pdf.Free;
|
|
if FOpenAfterExport and (not Assigned(Stream)) then
|
|
{$IFDEF MSWINDOWS}
|
|
ShellExecute(0, 'open', PChar(FileName), '', '', 5);
|
|
|
|
{$ENDIF}
|
|
{$IFDEF LINUX}
|
|
FmuxOpenFile(PChar(FileName));
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
ShellExecute(FileName);
|
|
// _system(PAnsiChar('open ' + PChar(FileName)));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxPDFExport.Write(Stream: TStream; const S: AnsiString);
|
|
begin
|
|
Stream.Write(S[1], Length(S));
|
|
end;
|
|
|
|
procedure TfrxPDFExport.WriteLn(Stream: TStream; const S: AnsiString);
|
|
begin
|
|
Stream.Write(S[1], Length(S));
|
|
{$IFDEF Delphi12}
|
|
Stream.Write(AnsiChar(#13)+AnsiChar(#10), 2);
|
|
{$ELSE}
|
|
Stream.Write(#13#10, 2);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF Delphi12}
|
|
procedure TfrxPDFExport.WriteLn(Stream: TStream; const S: String);
|
|
begin
|
|
WriteLn(Stream, AnsiString(s));
|
|
end;
|
|
|
|
procedure TfrxPDFExport.Write(Stream: TStream; const S: String);
|
|
begin
|
|
Write(Stream, AnsiString(S));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TfrxPDFExport.EscapeSpecialChar(TextStr: AnsiString): AnsiString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := '';
|
|
for I := 1 to Length ( TextStr ) do
|
|
case TextStr [ I ] of
|
|
'(': Result := Result + '\(';
|
|
')': Result := Result + '\)';
|
|
'\': Result := Result + '\\';
|
|
#13: Result := result + '\r';
|
|
#10: Result := result + '\n';
|
|
else
|
|
Result := Result + AnsiChar(chr ( Ord ( textstr [ i ] ) ));
|
|
end;
|
|
end;
|
|
|
|
function TfrxPDFExport.CryptStr(Source: AnsiString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
|
|
var
|
|
k: array [ 1..21 ] of Byte;
|
|
rc4: TfrxRC4;
|
|
s, s1, ss: AnsiString;
|
|
begin
|
|
if Enc then
|
|
begin
|
|
rc4 := TfrxRC4.Create;
|
|
try
|
|
s := Key;
|
|
FillChar(k, 21, 0);
|
|
Move(s[1], k, 16);
|
|
Move(id, k [17], 3);
|
|
SetLength(s1, 21);
|
|
MD5Buf(@k, 21, @s1[1]);
|
|
ss := Source;
|
|
SetLength(Result, Length(ss));
|
|
rc4.Start(@s1[1], 16);
|
|
rc4.Crypt(@ss[1], @Result[1], Length(ss));
|
|
Result := EscapeSpecialChar(Result);
|
|
finally
|
|
rc4.Free;
|
|
end;
|
|
end
|
|
else
|
|
Result := EscapeSpecialChar(Source);
|
|
end;
|
|
|
|
function TfrxPDFExport.CryptStream(Source: TStream; Target: TStream; Key: AnsiString; id: Integer): AnsiString;
|
|
var
|
|
s: AnsiString;
|
|
k: array [ 1..21 ] of Byte;
|
|
rc4: TfrxRC4;
|
|
m1, m2: TMemoryStream;
|
|
begin
|
|
FillChar(k, 21, 0);
|
|
Move(Key[1], k, 16);
|
|
Move(id, k[17], 3);
|
|
SetLength(s, 16);
|
|
MD5Buf(@k, 21, @s[1]);
|
|
m1 := TMemoryStream.Create;
|
|
m2 := TMemoryStream.Create;
|
|
rc4 := TfrxRC4.Create;
|
|
try
|
|
m1.LoadFromStream(Source);
|
|
m2.SetSize(m1.Size);
|
|
rc4.Start(@s[1], 16);
|
|
rc4.Crypt(m1.Memory, m2.Memory, m1.Size);
|
|
m2.SaveToStream(Target);
|
|
finally
|
|
m1.Free;
|
|
m2.Free;
|
|
rc4.Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPDFExport.StrToUTF16H(const Value: WideString): AnsiString;
|
|
var
|
|
i: integer;
|
|
pwc: ^Word;
|
|
begin
|
|
result := 'FEFF';
|
|
for i := 1 to Length(Value) do
|
|
begin
|
|
pwc := @Value[i];
|
|
result := result + AnsiString(IntToHex(pwc^, 4));
|
|
end;
|
|
end;
|
|
|
|
function TfrxPDFExport.StrToUTF16(const Value: WideString): AnsiString;
|
|
var
|
|
i: integer;
|
|
pwc: ^Word;
|
|
begin
|
|
result := #$FE + #$FF;
|
|
for i := 1 to Length(Value) do
|
|
begin
|
|
pwc := @Value[i];
|
|
result := result + AnsiChar(pwc^ shr 8) + AnsiChar(pwc^ and $FF) ;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPDFExport.PrepareString(const Text: WideString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
|
|
begin
|
|
if Enc then
|
|
Result := '(' + CryptStr(StrToUTF16(Text), Key, Enc, id) + ')'
|
|
else
|
|
Result := '<' + StrToUTF16H(Text) + '>'
|
|
end;
|
|
|
|
function TfrxPDFExport.PMD52Str(p: Pointer): AnsiString;
|
|
begin
|
|
SetLength(Result, 16);
|
|
Move(p^, Result[1], 16);
|
|
end;
|
|
|
|
function TfrxPDFExport.PadPassword(Password: AnsiString): AnsiString;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := Length(Password);
|
|
Result := Copy(Password, 1, i);
|
|
SetLength(Result, 32);
|
|
if i < 32 then
|
|
Move(PDF_PK, Result[i + 1], 32 - i);
|
|
end;
|
|
|
|
procedure TfrxPDFExport.PrepareKeys;
|
|
var
|
|
s, s1, p, p1, fid: AnsiString;
|
|
i, j: Integer;
|
|
rc4: TfrxRC4;
|
|
md5: TfrxMD5;
|
|
begin
|
|
// OWNER KEY
|
|
if FOwnerPassword = '' then
|
|
FOwnerPassword := FUserPassword;
|
|
p := PadPassword(FOwnerPassword);
|
|
md5 := TfrxMD5.Create;
|
|
try
|
|
md5.Init;
|
|
md5.Update(@p[1], 32);
|
|
md5.Finalize;
|
|
s := PMD52Str(md5.Digest);
|
|
for i := 1 to 50 do
|
|
begin
|
|
md5.Init;
|
|
md5.Update(@s[1], 16);
|
|
md5.Finalize;
|
|
s := PMD52Str(md5.Digest);
|
|
end;
|
|
finally
|
|
md5.Free;
|
|
end;
|
|
|
|
rc4 := TfrxRC4.Create;
|
|
try
|
|
p := PadPassword(FUserPassword);
|
|
SetLength(s1, 32);
|
|
rc4.Start(@s[1], 16);
|
|
rc4.Crypt(@p[1], @s1[1], 32);
|
|
SetLength(p1, 16);
|
|
for i := 1 to 19 do
|
|
begin
|
|
for j := 1 to 16 do
|
|
p1[j] := AnsiChar(Byte(s[j]) xor i);
|
|
rc4.Start(@p1[1], 16);
|
|
rc4.Crypt(@s1[1], @s1[1], 32);
|
|
end;
|
|
FOPass := s1;
|
|
finally
|
|
rc4.Free;
|
|
end;
|
|
|
|
// ENCRYPTION KEY
|
|
p := PadPassword(FUserPassword);
|
|
md5 := TfrxMD5.Create;
|
|
try
|
|
md5.Init;
|
|
md5.Update(@p[1], 32);
|
|
md5.Update(@FOPass[1], 32);
|
|
md5.Update(@FEncBits, 4);
|
|
fid := '';
|
|
for i := 1 to 16 do
|
|
fid := fid + AnsiChar(chr(Byte(StrToInt('$' + String(FFileID[i * 2 - 1] + FFileID[i * 2])))));
|
|
md5.Update(@fid[1], 16);
|
|
md5.Finalize;
|
|
s := PMD52Str(md5.Digest);
|
|
for i := 1 to 50 do
|
|
begin
|
|
md5.Init;
|
|
md5.Update(@s[1], 16);
|
|
md5.Finalize;
|
|
s := PMD52Str(md5.Digest);
|
|
end;
|
|
finally
|
|
md5.Free;
|
|
end;
|
|
FEncKey := s;
|
|
|
|
// USER KEY
|
|
md5 := TfrxMD5.Create;
|
|
try
|
|
md5.Update(@PDF_PK, 32);
|
|
md5.Update(@fid[1], 16);
|
|
md5.Finalize;
|
|
s := PMD52Str(md5.Digest);
|
|
s1 := FEncKey;
|
|
rc4 := TfrxRC4.Create;
|
|
try
|
|
rc4.Start(@s1[1], 16 );
|
|
rc4.Crypt(@s[1], @s[1], 16 );
|
|
SetLength(p1, 16);
|
|
for i := 1 to 19 do
|
|
begin
|
|
for j := 1 to 16 do
|
|
p1[j] := AnsiChar(Byte(s1[j]) xor i);
|
|
rc4.Start(@p1[1], 16 );
|
|
rc4.Crypt(@s[1], @s[1], 16 );
|
|
end;
|
|
FUPass := s;
|
|
finally
|
|
rc4.Free;
|
|
end;
|
|
SetLength(FUPass, 32);
|
|
FillChar(FUPass[17], 16, 0);
|
|
finally
|
|
md5.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.SetProtectionFlags(const Value: TfrxPDFEncBits);
|
|
begin
|
|
FProtectionFlags := Value;
|
|
FEncBits := $FFFFFFC0;
|
|
FEncBits := FEncBits + (Cardinal(ePrint in Value) shl 2 +
|
|
Cardinal(eModify in Value) shl 3 +
|
|
Cardinal(eCopy in Value) shl 4 +
|
|
Cardinal(eAnnot in Value) shl 5);
|
|
end;
|
|
|
|
procedure TfrxPDFExport.WriteFont(pdfFont: TfrxPDFFont);
|
|
var
|
|
fontFileId, descriptorId, toUnicodeId, cIDSystemInfoId, descendantFontId: Longint;
|
|
fontName: String;
|
|
i: Integer;
|
|
memstream, fontstream, tounicode: TMemoryStream;
|
|
begin
|
|
fontFileId := 0;
|
|
//fontstream := nil;
|
|
{$IFDEF Delphi12}
|
|
fontName := String(pdfFont.GetFontName);
|
|
{$ELSE}
|
|
fontName := pdfFont.GetFontName;
|
|
{$ENDIF}
|
|
// embedded font
|
|
if FEmbedded then
|
|
begin
|
|
fontFileId := UpdateXRef;
|
|
WriteLn(pdf, ObjNumber(fontFileId));
|
|
pdfFont.PackFontFile;
|
|
if FCompressed then
|
|
begin
|
|
memstream := TMemoryStream.Create;
|
|
fontstream := TMemoryStream.Create;
|
|
try
|
|
//fontstream.Write(pdfFont.FontData.Memory, pdfFont.FontDataSize);
|
|
fontstream.CopyFrom(pdfFont.FontData, pdfFont.FontData.Size);
|
|
frxDeflateStream(fontstream, memstream, gzFastest);
|
|
WriteLn(pdf, '<< /Length ' + IntToStr(memstream.Size) + ' /Filter /FlateDecode /Length1 ' + IntToStr(fontstream.Size) + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
if FProtection then
|
|
CryptStream(memstream, pdf, FEncKey, fontFileId)
|
|
else
|
|
pdf.CopyFrom(memstream, 0);
|
|
finally
|
|
memstream.Free;
|
|
fontstream.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
WriteLn(pdf, '<< /Length ' + IntToStr(pdfFont.FontDataSize) + ' /Length1 ' + IntToStr(pdfFont.FontDataSize) + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
|
|
fontstream := TMemoryStream.Create;
|
|
try
|
|
fontstream.CopyFrom(pdfFont.FontData, pdfFont.FontData.Size);
|
|
if FProtection then
|
|
CryptStream(fontstream, pdf, FEncKey, fontFileId)
|
|
else
|
|
pdf.CopyFrom(fontstream, 0);
|
|
finally
|
|
fontstream.Free;
|
|
end;
|
|
end;
|
|
WriteLn(pdf, '');
|
|
WriteLn(pdf, 'endstream');
|
|
WriteLn(pdf, 'endobj');
|
|
end;
|
|
// descriptor
|
|
descriptorId := UpdateXRef;
|
|
WriteLn(pdf, ObjNumber(descriptorId));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /FontDescriptor');
|
|
WriteLn(pdf, '/FontName /' + fontName);
|
|
WriteLn(pdf, '/FontFamily /' + fontName);
|
|
WriteLn(pdf, '/Flags 32');
|
|
WriteLn(pdf, '/FontBBox [' + IntToStr(pdfFont.TextMetric.otmrcFontBox.left) + ' ' +
|
|
IntToStr(pdfFont.TextMetric.otmrcFontBox.bottom) + ' ' +
|
|
IntToStr(pdfFont.TextMetric.otmrcFontBox.right) + ' ' +
|
|
IntToStr(pdfFont.TextMetric.otmrcFontBox.top) + ' ]');
|
|
WriteLn(pdf, '/ItalicAngle ' + IntToStr(pdfFont.TextMetric.otmItalicAngle));
|
|
WriteLn(pdf, '/Ascent ' + IntToStr(pdfFont.TextMetric.otmAscent));
|
|
WriteLn(pdf, '/Descent ' + IntToStr(pdfFont.TextMetric.otmDescent));
|
|
WriteLn(pdf, '/Leading ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmInternalLeading));
|
|
WriteLn(pdf, '/CapHeight ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmHeight));
|
|
WriteLn(pdf, '/StemV ' + IntToStr(50 + Round(sqr(pdfFont.TextMetric.otmTextMetrics.tmWeight / 65))));
|
|
WriteLn(pdf, '/AvgWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmAveCharWidth));
|
|
WriteLn(pdf, '/MxWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmMaxCharWidth));
|
|
WriteLn(pdf, '/MissingWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmAveCharWidth));
|
|
if FEmbedded then
|
|
WriteLn(pdf, '/FontFile2 ' + ObjNumberRef(fontFileId));
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
// ToUnicode
|
|
toUnicodeId := UpdateXRef();
|
|
WriteLn(pdf, ObjNumber(toUnicodeId));
|
|
tounicode := TMemoryStream.Create;
|
|
try
|
|
WriteLn(tounicode, '/CIDInit /ProcSet findresource begin');
|
|
WriteLn(tounicode, '12 dict begin');
|
|
WriteLn(tounicode, 'begincmap');
|
|
WriteLn(tounicode, '/CIDSystemInfo');
|
|
WriteLn(tounicode, '<< /Registry (Adobe)');
|
|
WriteLn(tounicode, '/Ordering (UCS)');
|
|
WriteLn(tounicode, '/Ordering (Identity)');
|
|
WriteLn(tounicode, '/Supplement 0');
|
|
WriteLn(tounicode, '>> def');
|
|
Write(tounicode, '/CMapName /');
|
|
{$IFDEF Delphi12}
|
|
Write(tounicode, StringReplace(pdfFont.GetFontName, AnsiString(','), AnsiString('+'), [rfReplaceAll]));
|
|
{$ELSE}
|
|
Write(tounicode, StringReplace(pdfFont.GetFontName, ',', '+', [rfReplaceAll]));
|
|
{$ENDIF}
|
|
WriteLn(tounicode, ' def');
|
|
WriteLn(tounicode, '/CMapType 2 def');
|
|
WriteLn(tounicode, '1 begincodespacerange');
|
|
WriteLn(tounicode, '<0000> <FFFF>');
|
|
WriteLn(tounicode, 'endcodespacerange');
|
|
Write(tounicode, IntToStr(pdfFont.UsedAlphabet.Count));
|
|
WriteLn(tounicode, ' beginbfchar');
|
|
for i := 0 to pdfFont.UsedAlphabet.Count - 1 do
|
|
begin
|
|
Write(tounicode, '<');
|
|
Write(tounicode, IntToHex(Word(pdfFont.UsedAlphabet[i]), 4));
|
|
Write(tounicode, '> <');
|
|
Write(tounicode, IntToHex(Word(pdfFont.UsedAlphabetUnicode[i]), 4));
|
|
WriteLn(tounicode, '>');
|
|
end;
|
|
WriteLn(tounicode, 'endbfchar');
|
|
WriteLn(tounicode, 'endcmap');
|
|
WriteLn(tounicode, 'CMapName currentdict /CMap defineresource pop');
|
|
WriteLn(tounicode, 'end');
|
|
WriteLn(tounicode, 'end');
|
|
tounicode.Position := 0;
|
|
if FCompressed then
|
|
begin
|
|
memstream := TMemoryStream.Create;
|
|
try
|
|
frxDeflateStream(tounicode, memstream, gzFastest);
|
|
WriteLn(pdf, '<< /Length ' + IntToStr(memstream.Size) + ' /Filter /FlateDecode /Length1 ' + IntToStr(tounicode.Size) + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
if FProtection then
|
|
CryptStream(memstream, pdf, FEncKey, toUnicodeId)
|
|
else
|
|
pdf.CopyFrom(memstream, 0);
|
|
finally
|
|
memstream.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
WriteLn(pdf, '<< /Length ' + IntToStr(tounicode.Size) + ' /Length1 ' + IntToStr(tounicode.Size) + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
if FProtection then
|
|
CryptStream(tounicode, pdf, FEncKey, toUnicodeId)
|
|
else
|
|
pdf.CopyFrom(tounicode, 0);
|
|
end;
|
|
WriteLn(pdf, 'endstream');
|
|
WriteLn(pdf, 'endobj');
|
|
finally
|
|
tounicode.Free;
|
|
end;
|
|
//CIDSystemInfo
|
|
cIDSystemInfoId := UpdateXRef;
|
|
WriteLn(pdf, ObjNumber(cIDSystemInfoId));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Registry (Adobe) /Ordering (Identity) /Supplement 0');
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
//DescendantFonts
|
|
descendantFontId := UpdateXRef;
|
|
WriteLn(pdf, ObjNumber(descendantFontId));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Font');
|
|
WriteLn(pdf, '/Subtype /CIDFontType2');
|
|
WriteLn(pdf, '/BaseFont /' + fontName);
|
|
WriteLn(pdf, '/CIDSystemInfo ' + ObjNumberRef(cIDSystemInfoId));
|
|
WriteLn(pdf, '/FontDescriptor ' + ObjNumberRef(descriptorId));
|
|
Write(pdf, '/W [ ');
|
|
for i := 0 to pdfFont.UsedAlphabet.Count - 1 do
|
|
Write(pdf, IntToStr(Word(pdfFont.UsedAlphabet[i])) + ' [' + IntToStr(Integer(pdfFont.Widths [i])) + '] ');
|
|
WriteLn(pdf, ']');
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
// main
|
|
FXRef[pdfFont.Reference - 1] := PrepXrefPos(pdf.Position);
|
|
WriteLn(pdf, ObjNumber(pdfFont.Reference));
|
|
WriteLn(pdf, '<<');
|
|
WriteLn(pdf, '/Type /Font');
|
|
WriteLn(pdf, '/Subtype /Type0');
|
|
WriteLn(pdf, '/BaseFont /' + fontName);
|
|
WriteLn(pdf, '/Encoding /Identity-H');
|
|
WriteLn(pdf, '/DescendantFonts [' + ObjNumberRef(descendantFontId) + ']');
|
|
WriteLn(pdf, '/ToUnicode ' + ObjNumberRef(toUnicodeId));
|
|
WriteLn(pdf, '>>');
|
|
WriteLn(pdf, 'endobj');
|
|
end;
|
|
|
|
function TfrxPDFExport.AddPage(Page: TfrxReportPage): TfrxPDFPage;
|
|
var
|
|
p: TfrxPDFPage;
|
|
begin
|
|
p := TfrxPDFPage.Create;
|
|
p.Height := Page.Height * PDF_DIVIDER;
|
|
FPages.Add(p);
|
|
Result := p;
|
|
end;
|
|
|
|
function TfrxPDFExport.StrToHex(const Value: WideString): AnsiString;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := '';
|
|
for i := 1 to Length(Value) do
|
|
result := result + AnsiString(IntToHex(Word(Value[i]), 4));
|
|
end;
|
|
|
|
function TfrxPDFExport.StrToHexSp(const SourceStr, Value: WideString; SpaceAdjustment: Extended): AnsiString;
|
|
var
|
|
i: integer;
|
|
w: Integer;
|
|
z: Extended;
|
|
begin
|
|
result := '';
|
|
z := 0;
|
|
for i := 1 to Length(Value) do
|
|
begin
|
|
result := result + AnsiString(IntToHex(Word(Value[i]), 4));
|
|
if SourceStr[i] = ' ' then
|
|
begin
|
|
w := Trunc(SpaceAdjustment);
|
|
z := z + Frac(SpaceAdjustment);
|
|
if z > 1 then
|
|
begin
|
|
Inc(w);
|
|
z := Frac(z);
|
|
end;
|
|
if w <> 0 then
|
|
result := result + AnsiString('>' + IntToStr(w) + '<');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxPDFExport.ObjNumber(FNumber: longint): String;
|
|
begin
|
|
result := IntToStr(FNumber) + ' 0 obj';
|
|
end;
|
|
|
|
function TfrxPDFExport.ObjNumberRef(FNumber: longint): String;
|
|
begin
|
|
result := IntToStr(FNumber) + ' 0 R';
|
|
end;
|
|
|
|
function TfrxPDFExport.PrepXrefPos(pos: Longint): String;
|
|
begin
|
|
result := StringOfChar('0', 10 - Length(IntToStr(pos))) + IntToStr(pos)
|
|
end;
|
|
|
|
function TfrxPDFExport.UpdateXRef: longint;
|
|
begin
|
|
FXRef.Add(PrepXrefPos(pdf.Position));
|
|
result := FXRef.Count;
|
|
end;
|
|
|
|
function TfrxPDFExport.GetPDFColor(const Color: TAlphaColor): String;
|
|
begin
|
|
if Color = claBlack then
|
|
Result := '0 0 0'
|
|
else if Color = claWhite then
|
|
Result := '1 1 1'
|
|
else if Color = FLastColor then
|
|
Result := FLastColorResult
|
|
else begin
|
|
Result:= frFloat2Str(Byte(Color shr 16) / 255) + ' ' +
|
|
frFloat2Str(Byte(Color shr 8) / 255) + ' ' +
|
|
frFloat2Str(Byte(Color) / 255);
|
|
FLastColor := Color;
|
|
FLastColorResult := Result;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.GetStreamHash(out Hash: TfrxPDFXObjectHash; S: TStream);
|
|
var
|
|
H: TCryptoHash;
|
|
begin
|
|
H := TCryptoMD5.Create;
|
|
|
|
try
|
|
H.Push(S);
|
|
H.GetDigest(Hash[0], SizeOf(Hash));
|
|
finally
|
|
H.Free
|
|
end;
|
|
end;
|
|
|
|
|
|
function TfrxPDFExport.FindXObject(const Hash: TfrxPDFXObjectHash): Integer;
|
|
begin
|
|
for Result := 0 to High(FXObjects) do
|
|
if CompareMem(@Hash, @FXObjects[Result].Hash, SizeOf(Hash)) then
|
|
Exit;
|
|
|
|
Result := -1;
|
|
end;
|
|
|
|
function TfrxPDFExport.AddXObject(Id: Integer; const Hash: TfrxPDFXObjectHash): Integer;
|
|
var
|
|
X: TfrxPDFXObject;
|
|
begin
|
|
X.ObjId := Id;
|
|
Move(Hash, X.Hash, SizeOf(Hash));
|
|
SetLength(FXObjects, Length(FXObjects) + 1);
|
|
FXObjects[High(FXObjects)] := X;
|
|
Result := High(FXObjects);
|
|
end;
|
|
|
|
procedure TfrxPDFExport.ClearXObject;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to High(FXObjects) do
|
|
begin
|
|
FXObjects[i].ObjId := 0;
|
|
FillChar( FXObjects[i].Hash, Sizeof(TfrxPDFXObjectHash), 0 );
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFExport.AddObject(const Obj: TfrxView);
|
|
var
|
|
FontIndex: Integer;
|
|
x, y, dx, dy, fdx, fdy, PGap, FCharSpacing, ow, oh: Extended;
|
|
i, iz: Integer;
|
|
//Jpg: TJPEGImage;
|
|
s: AnsiString;
|
|
Lines: TWideStrings;
|
|
TempBitmap: TBitmap;
|
|
{$IFDEF DELPHI17}
|
|
bData: TBitmapData;
|
|
{$ENDIF}
|
|
OldFrameWidth: Extended;
|
|
TempColor: TAlphaColor;
|
|
Left, Right, Top, Bottom, Width, Height: String;
|
|
FUnderlinePosition: Double;
|
|
FStrikeoutPosition: Double;
|
|
FRealBounds: TfrxRect;
|
|
FLineHeight: Single;
|
|
FLineWidth: Single;
|
|
FHeightWoMargin: Extended;
|
|
pdfFont: TfrxPDFFont;
|
|
textObj: TfrxCustomMemoView;
|
|
AFont: TFont;
|
|
bx, by, bx1, by1, wx1, wx2, wy1, wy2, gx1, gy1: Integer;
|
|
FTextRect: TRectF;
|
|
angle, a_sin, a_cos, a_x, a_y: Extended;
|
|
rx, ry: Extended;
|
|
simulateBold, simulateItalic: Boolean;
|
|
dots: PRGBAWord;
|
|
Ix, Iy: Integer;
|
|
Counter: LongInt;
|
|
IsAlpha: Boolean;
|
|
// GZip: TfrxGZipCompressor;
|
|
IsTransparent: Boolean;
|
|
MaskBytes: array of byte;
|
|
MaskSize: Integer;
|
|
XMaskHash: TfrxPDFXObjectHash;
|
|
MaskIndex: Integer;
|
|
XMaskId: Integer;
|
|
// PDF/A backport
|
|
XObjectId: Integer;
|
|
XObjectHash: TfrxPDFXObjectHash;
|
|
XObjectStream: TStream;
|
|
XMaskStream: TStream;
|
|
PicIndex: Integer;
|
|
RemappedStr: WideString;
|
|
HWidth: Extended;
|
|
SpaceAdjustment: Extended;
|
|
|
|
function GetLeft(const Left: Extended): Extended;
|
|
begin
|
|
Result := FMarginLeft + Left * PDF_DIVIDER
|
|
end;
|
|
|
|
function GetTop(const Top: Extended): Extended;
|
|
begin
|
|
Result := FHeightWoMargin - Top * PDF_DIVIDER
|
|
end;
|
|
|
|
function GetVTextPos(const Top: Extended; const Height: Extended;
|
|
const Align: TfrxVAlign; const Line: Integer = 0;
|
|
const Count: Integer = 1): Extended;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Line <= Count then
|
|
i := Line
|
|
else
|
|
i := 0;
|
|
if Align = vaBottom then
|
|
Result := Top + Height - FLineHeight * (Count - i - 1)
|
|
else if Align = vaCenter then
|
|
Result := Top + (Height - (FLineHeight * Count)) / 2 + FLineHeight * (i + 1)
|
|
else
|
|
Result := Top + FLineHeight * (i + 1);
|
|
end;
|
|
|
|
function GetVTextPosR(const Height: Extended;
|
|
const Align: TfrxVAlign; const Line: Integer = 0;
|
|
const Count: Integer = 1): Extended;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if Line <= Count then
|
|
i := Line
|
|
else
|
|
i := 0;
|
|
if Align = vaBottom then
|
|
Result := Height - FLineHeight * (Count - i - 1)
|
|
else if Align = vaCenter then
|
|
Result := -FLineHeight * Count / 2 + FLineHeight * (i + 1)
|
|
else
|
|
Result := - Height + FLineHeight * (i + 1);
|
|
end;
|
|
|
|
|
|
function GetHTextPos(const Left: Extended; const Width: Extended; const Text: WideString;
|
|
const Align: TfrxHAlign): Extended;
|
|
begin
|
|
case Align of
|
|
haLeft: Result := Left;
|
|
haRight: Result := Left + Width - FLineWidth;
|
|
haCenter: Result := Left + (Width - FLineWidth) / 2;
|
|
haBlock: Result := Left;
|
|
else Result := Left;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
function GetHTextPosR(const Width: Extended; const Text: WideString;
|
|
const Align: TfrxHAlign): Extended;
|
|
begin
|
|
case Align of
|
|
haRight: Result := Width - FLineWidth;
|
|
haCenter: Result := -FLineWidth / 2;
|
|
else Result := -Width;
|
|
end;
|
|
end;
|
|
|
|
function GetPDFDash(const LineStyle: TfrxFrameStyle; Width: Extended): String;
|
|
var
|
|
dash, dot: String;
|
|
begin
|
|
if LineStyle = fsSolid then
|
|
Result := '[] 0 d'
|
|
else
|
|
begin
|
|
dash := frFloat2Str(Width * 6) + ' ';
|
|
dot := frFloat2Str(Width * 2) + ' ';
|
|
if LineStyle = fsDash then
|
|
Result := '[' + dash + dot + '] 0 d'
|
|
else if LineStyle = fsDashDot then
|
|
Result := '[' + dash + dash + dot + dash + '] 0 d'
|
|
else if LineStyle = fsDashDotDot then
|
|
Result := '[' + dash + dash + dot + dash + dot + dash + '] 0 d'
|
|
else if LineStyle = fsDot then
|
|
Result := '[' + dot + dot + '] 0 d'
|
|
else
|
|
Result := '[] 0 d';
|
|
end;
|
|
end;
|
|
|
|
procedure MakeUpFrames;
|
|
var
|
|
fRight, fBottom, fWidth, fHeight: String;
|
|
dLeft, dRight, dTop, dBottom: String;
|
|
begin
|
|
if (Obj.Frame.Typ <> []) and (Obj.Frame.Color <> claNull) then
|
|
begin
|
|
|
|
if Obj.Frame.DropShadow then
|
|
begin
|
|
fRight := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width - Obj.Frame.ShadowWidth));
|
|
fBottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height - Obj.Frame.ShadowWidth));
|
|
fWidth := frFloat2Str((Obj.Width - Obj.Frame.ShadowWidth) * PDF_DIVIDER);
|
|
fHeight := frFloat2Str((Obj.Height - Obj.Frame.ShadowWidth) * PDF_DIVIDER);
|
|
end
|
|
else
|
|
begin
|
|
fRight := Right;
|
|
fBottom := Bottom;
|
|
fWidth := Width;
|
|
fHeight := Height;
|
|
end;
|
|
|
|
dTop := frFloat2Str(GetTop(Obj.AbsTop) - 2 );
|
|
dRight := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width) - 2);
|
|
dBottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height) + 2);
|
|
dLeft := frFloat2Str(GetLeft(Obj.AbsLeft) + 2);
|
|
|
|
Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10);
|
|
if ftTop in Obj.Frame.Typ then
|
|
begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.TopLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.TopLine.Style, Obj.Frame.TopLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.TopLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, Left + ' ' + Top + ' m'#13#10 + fRight + ' ' + Top + ' l'#13#10'S'#13#10);
|
|
if( Obj.Frame.TopLine.Style = fsDouble ) then begin
|
|
Write (OutStream, GetPDFColor(Obj.Frame.TopLine.Color) + ' RG'#13#10);
|
|
WriteLn (OutStream, GetPDFDash(Obj.Frame.TopLine.Style, Obj.Frame.TopLine.Width));
|
|
Write (OutStream, frFloat2Str(Obj.Frame.TopLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write (OutStream, dLeft + ' ' + dTop + ' m'#13#10 + dRight + ' ' + dTop + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
if ftRight in Obj.Frame.Typ then
|
|
begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.RightLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.RightLine.Style, Obj.Frame.RightLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.RightLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, fRight + ' ' + Top + ' m'#13#10 + fRight + ' ' + fBottom + ' l'#13#10'S'#13#10);
|
|
if( Obj.Frame.RightLine.Style = fsDouble ) then begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.RightLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.RightLine.Style, Obj.Frame.RightLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.RightLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, dRight + ' ' + dTop + ' m'#13#10 + dRight + ' ' + dBottom + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
if ftBottom in Obj.Frame.Typ then
|
|
begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.BottomLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.BottomLine.Style, Obj.Frame.BottomLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.BottomLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, Left + ' ' + fBottom + ' m'#13#10 + fRight + ' ' + fBottom + ' l'#13#10'S'#13#10);
|
|
if( Obj.Frame.BottomLine.Style = fsDouble ) then begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.BottomLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.BottomLine.Style, Obj.Frame.BottomLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.BottomLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, dLeft + ' ' + dBottom + ' m'#13#10 + dRight + ' ' + dBottom + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
if ftLeft in Obj.Frame.Typ then
|
|
begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.LeftLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.LeftLine.Style, Obj.Frame.LeftLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.LeftLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, Left + ' ' + Top + ' m'#13#10 + Left + ' ' + fBottom + ' l'#13#10'S'#13#10);
|
|
if( Obj.Frame.LeftLine.Style = fsDouble ) then begin
|
|
Write(OutStream, GetPDFColor(Obj.Frame.LeftLine.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.LeftLine.Style, Obj.Frame.LeftLine.Width));
|
|
Write(OutStream, frFloat2Str(Obj.Frame.LeftLine.Width * PDF_DIVIDER) + ' w'#13#10);
|
|
Write(OutStream, dLeft + ' ' + dTop + ' m'#13#10 + dLeft + ' ' + dBottom + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
function HTMLTags(const View: TfrxCustomMemoView): Boolean;
|
|
begin
|
|
if View.AllowHTMLTags then
|
|
Result := FTags and (Pos('<' ,View.Memo.Text) > 0)
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function CheckOutPDFChars(const Str: WideString): WideString;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
for i := 1 to Length(Str) do
|
|
if Str[i] = '\' then
|
|
Result := Result + '\\'
|
|
else if Str[i] = '(' then
|
|
Result := Result + '\('
|
|
else if Str[i] = ')' then
|
|
Result := Result + '\)'
|
|
else
|
|
Result := Result + Str[i];
|
|
end;
|
|
|
|
procedure DrawArrow(Obj: TfrxCustomLineView; x1, y1, x2, y2: Extended);
|
|
var
|
|
k1, a, b, c, D: Double;
|
|
xp, yp, x3, y3, x4, y4, ld, wd: Extended;
|
|
begin
|
|
wd := Obj.ArrowWidth * PDF_DIVIDER;
|
|
ld := Obj.ArrowLength * PDF_DIVIDER;
|
|
if abs(x2 - x1) > 0 then
|
|
begin
|
|
k1 := (y2 - y1) / (x2 - x1);
|
|
a := Sqr(k1) + 1;
|
|
b := 2 * (k1 * ((x2 * y1 - x1 * y2) / (x2 - x1) - y2) - x2);
|
|
c := Sqr(x2) + Sqr(y2) - Sqr(ld) + Sqr((x2 * y1 - x1 * y2) / (x2 - x1)) -
|
|
2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1);
|
|
D := Sqr(b) - 4 * a * c;
|
|
xp := (-b + Sqrt(D)) / (2 * a);
|
|
if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then
|
|
xp := (-b - Sqrt(D)) / (2 * a);
|
|
yp := xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1);
|
|
if y2 <> y1 then
|
|
begin
|
|
x3 := xp + wd * sin(ArcTan(k1));
|
|
y3 := yp - wd * cos(ArcTan(k1));
|
|
x4 := xp - wd * sin(ArcTan(k1));
|
|
y4 := yp + wd * cos(ArcTan(k1));
|
|
end
|
|
else
|
|
begin
|
|
x3 := xp; y3 := yp - wd;
|
|
x4 := xp; y4 := yp + wd;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
xp := x2;
|
|
yp := y2 - ld;
|
|
if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then
|
|
yp := y2 + ld;
|
|
x3 := xp - wd; y3 := yp;
|
|
x4 := xp + wd; y4 := yp;
|
|
end;
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
WriteLn(OutStream, frFloat2Str(x3) + ' ' + frFloat2Str(y3) + ' m'#13#10 +
|
|
frFloat2Str(x2) + ' ' + frFloat2Str(y2) + ' l'#13#10 +
|
|
frFloat2Str(x4) + ' ' + frFloat2Str(y4) + ' l');
|
|
if Obj.ArrowSolid then
|
|
WriteLn(OutStream, '1 j'#13#10 + GetPDFColor(Obj.Frame.Color) + ' rg'#13#10'b')
|
|
else
|
|
WriteLn(OutStream, 'S');
|
|
end;
|
|
|
|
function FontNeedsBoldItalicSimulation(Font: TFont): Boolean;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Index := frxPDFFontsNeedStyleSimulation.IndexOf(Font.Family);
|
|
if (Index <> -1) {and not ((Index = 5) and (Font.Style = [fsBold]))} then
|
|
Result := True
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function GetGlobalFont(const Font: TFont): TfrxPDFFont;
|
|
var
|
|
i: Integer;
|
|
Font2: TFont;
|
|
needBISimulation: Boolean;
|
|
begin
|
|
needBISimulation := FontNeedsBoldItalicSimulation(Font);
|
|
i := 0;
|
|
while (i < FFonts.Count) do
|
|
begin
|
|
Font2 := TfrxPDFFont(FFonts[i]).SourceFont;
|
|
if (Font.Family = Font2.Family) and ((Font.Style = Font2.Style) or needBISimulation) then
|
|
break;
|
|
Inc(i);
|
|
end;
|
|
if i < FFonts.Count then
|
|
result := TfrxPDFFont(FFonts[i])
|
|
else
|
|
begin
|
|
Font2 := nil;
|
|
try
|
|
if needBISimulation then
|
|
begin
|
|
Font2 := TFont.Create;
|
|
Font2.Assign(Font);
|
|
Font2.Style := [];
|
|
result := TfrxPDFFont.Create(Font2);
|
|
end
|
|
else
|
|
result := TfrxPDFFont.Create(Font);
|
|
result.FillOutlineTextMetrix();
|
|
finally
|
|
if needBISimulation then
|
|
Font2.Free;
|
|
end;
|
|
FFonts.Add(result);
|
|
{$IFDEF Delphi12}
|
|
result.Name := AnsiString('/F' + IntToStr(FFonts.Count - 1));
|
|
{$ELSE}
|
|
result.Name := '/F' + IntToStr(FFonts.Count - 1);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function GetObjFontNumber(const Font: TFont): integer;
|
|
var
|
|
i: Integer;
|
|
Font2: TFont;
|
|
needBISimulation: Boolean;
|
|
begin
|
|
needBISimulation := FontNeedsBoldItalicSimulation(Font);
|
|
i := 0;
|
|
while (i < FPageFonts.Count) do
|
|
begin
|
|
Font2 := TfrxPDFFont(FPageFonts[i]).SourceFont;
|
|
if (Font.Family = Font2.Family) and ((Font.Style = Font2.Style) or needBISimulation) then
|
|
break;
|
|
Inc(i);
|
|
end;
|
|
if i < FPageFonts.Count then
|
|
result := i
|
|
else
|
|
begin
|
|
FPageFonts.Add(GetGlobalFont(Font));
|
|
result := FPageFonts.Count - 1;
|
|
end;
|
|
end;
|
|
|
|
procedure Cmd(const Args: string; const Name: string = '');
|
|
begin
|
|
if Name = '' then
|
|
WriteLn(OutStream, Args)
|
|
else if Args = '' then
|
|
WriteLn(OutStream, Name)
|
|
else
|
|
WriteLn(OutStream, Args + ' ' + Name);
|
|
end;
|
|
|
|
function CmdCoords(x, y: Extended): string;
|
|
begin
|
|
Result := frFloat2Str(GetLeft(x)) + ' ' + frFloat2Str(GetTop(y));
|
|
end;
|
|
|
|
procedure CmdMove(x, y: Extended);
|
|
begin
|
|
Cmd(CmdCoords(x, y), 'm');
|
|
end;
|
|
|
|
procedure CmdLine(x, y: Extended);
|
|
begin
|
|
Cmd(CmdCoords(x, y), 'l');
|
|
end;
|
|
|
|
procedure CmdBezier(x1, y1, x2, y2, x3, y3: Extended);
|
|
begin
|
|
Cmd(CmdCoords(x1, y1) + ' ' + CmdCoords(x2, y2) + ' ' +
|
|
CmdCoords(x3, y3), 'c');
|
|
end;
|
|
|
|
{ Rounded rectangle can be drawed
|
|
using the following PDF commands:
|
|
|
|
- m - start a new path
|
|
- v - add a bezier curve
|
|
- l - add a straight line
|
|
- S - stroke the path
|
|
- B - fill and stroke the path }
|
|
|
|
procedure WriteRoundedRect(RoundedRect: TfrxShapeView);
|
|
var
|
|
rad, rf, l, t, r, b, w, h: Extended;
|
|
begin
|
|
with RoundedRect do
|
|
begin
|
|
with Frame do
|
|
begin
|
|
Cmd(GetPDFDash(Style, Width));
|
|
Cmd(GetPDFColor(Color), 'RG');
|
|
Cmd(frFloat2Str(Width * PDF_DIVIDER), 'w');
|
|
end;
|
|
|
|
if Curve = 0 then
|
|
rad := 2 * 3.74
|
|
else
|
|
rad := Curve * 3.74;
|
|
|
|
rf := 0.5 * rad;
|
|
l := AbsLeft;
|
|
t := AbsTop;
|
|
w := Width;
|
|
h := Height;
|
|
r := l + w;
|
|
b := t + h;
|
|
|
|
Cmd(GetPDFColor(Color), 'rg');
|
|
CmdMove(l + rad, b);
|
|
CmdLine(r - rad, b);
|
|
CmdBezier(r - rf, b, r, b - rf, r, b - rad); // right-bottom
|
|
CmdLine(r, t + rad);
|
|
CmdBezier(r, t + rf, r - rf, t, r - rad, t); // right-top
|
|
CmdLine(l + rad, t);
|
|
CmdBezier(l + rf, t, l, t + rf, l, t + rad); // left-top
|
|
CmdLine(l, b - rad);
|
|
CmdBezier(l, b - rf, l + rf, b, l + rad, b); // left-bottom
|
|
|
|
if Color = claNull then
|
|
Cmd('', 'S')
|
|
else
|
|
Cmd('', 'B');
|
|
end;
|
|
end;
|
|
|
|
{ An extenral link is a URL like http://company.com/index.html }
|
|
|
|
procedure WriteExternalLink(const URI: string);
|
|
var
|
|
ObjId: Integer;
|
|
annot: TfrxPDFAnnot;
|
|
begin
|
|
ObjId := UpdateXRef;
|
|
Writeln(FPageAnnots, ObjNumberRef(ObjId)); // for /Annots array in the page object
|
|
|
|
annot := TfrxPDFAnnot.Create;
|
|
annot.Number := ObjId;
|
|
annot.Rect := Left + ' ' + Bottom + ' ' + Right + ' ' + Top;
|
|
annot.Hyperlink := String(PdfString(WideString(URI)));
|
|
FAnnots.Add(annot);
|
|
end;
|
|
|
|
{ Writes an anchor to the PDF document. This kind
|
|
of links make a jump to a specified location within
|
|
the current document.
|
|
|
|
Arguments:
|
|
|
|
- Page - an index of a page whither the anchor jumps
|
|
- Pos - a vertical position of the destination within the page }
|
|
|
|
procedure WritePageAnchor(Page: Integer; Pos: Double);
|
|
var
|
|
ObjId: Integer;
|
|
annot: TfrxPDFAnnot;
|
|
begin
|
|
ObjId := UpdateXRef;
|
|
Writeln(FPageAnnots, ObjNumberRef(ObjId)); // for /Annots array in the page object
|
|
|
|
annot := TfrxPDFAnnot.Create;
|
|
annot.Number := ObjId;
|
|
annot.Rect := Left + ' ' + Bottom + ' ' + Right + ' ' + Top;
|
|
annot.DestPage := Page;
|
|
annot.DestY := Round(GetTop(Pos));
|
|
FAnnots.Add(annot);
|
|
end;
|
|
|
|
{ Writes a link object to the PDF document }
|
|
|
|
procedure WriteLink(a: string);
|
|
var
|
|
x: TfrxXMLItem;
|
|
begin
|
|
if a = '' then Exit;
|
|
|
|
{ Anchors.
|
|
|
|
This kind of links make a jump to a specified
|
|
location within the current document. Anchors
|
|
begin with '#' sign. }
|
|
|
|
if a[1] = '#' then
|
|
begin
|
|
a := Copy(a, 2, Length(a) - 1);
|
|
x := (Report.PreviewPages as TfrxPreviewPages).FindAnchor(a);
|
|
|
|
if x <> nil then
|
|
WritePageAnchor(StrToInt(x.Prop['page']), StrToFloat(x.Prop['top']));
|
|
end
|
|
|
|
{ Page anchors.
|
|
|
|
This kind of links make a jump to a
|
|
specified page. }
|
|
|
|
else if a[1] = '@' then
|
|
begin
|
|
a := Copy(a, 2, Length(a) - 1);
|
|
WritePageAnchor(StrToInt(a) - 1, 0.0);
|
|
end
|
|
|
|
{ Extenal links.
|
|
|
|
An extenral link is a URL like http://company.com/index.html. }
|
|
|
|
else
|
|
WriteExternalLink(a)
|
|
end;
|
|
|
|
{ Export checkbox }
|
|
|
|
procedure ExportChebox(Obj: TfrxView);
|
|
var
|
|
cb: TfrxCheckBoxView;
|
|
L: Extended;
|
|
T: Extended;
|
|
W: Extended;
|
|
H: Extended;
|
|
begin
|
|
cb := TfrxCheckBoxView(Obj);
|
|
L := Obj.AbsLeft;
|
|
T := Obj.AbsTop;
|
|
H := Obj.Height;
|
|
W := Obj.Width;
|
|
|
|
if Obj.Color <> claNull then
|
|
begin
|
|
Write(OutStream, GetPDFColor(Obj.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
GetPDFColor(Obj.Color) + ' rg'#13#10 +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' '#13#10 +
|
|
frFloat2Str(Obj.Width * PDF_DIVIDER) + ' ' + frFloat2Str(Obj.Height * PDF_DIVIDER) + ' re'#13#10);
|
|
Write(OutStream, 'B'#13#10);
|
|
end;
|
|
|
|
if Obj.Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] then
|
|
begin
|
|
WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10);
|
|
WriteLn(OutStream, ' S ' +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w ' +
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' l ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' l ' );
|
|
Write(OutStream, 'S'#13#10);
|
|
end;
|
|
|
|
WriteLn(OutStream, GetPDFDash( fsSolid, Obj.Frame.Width * 2));
|
|
WriteLn(OutStream, GetPDFColor(cb.CheckColor) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 2) + ' w ' +
|
|
GetPDFColor(Obj.Color) + ' rg');
|
|
|
|
if cb.Checked then
|
|
case cb.CheckStyle of
|
|
csCross:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
|
|
frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
|
|
frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' +
|
|
frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
|
|
frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' );
|
|
csCheck:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
|
|
frFloat2Str(GetLeft(L + W / 5)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W / 3)) + ' ' + frFloat2Str(GetTop(T + H - H / 4)) + ' l ' +
|
|
frFloat2Str(GetLeft(L + W - W / 5)) + ' ' + frFloat2Str(GetTop(T + H / 7 )) + ' l ' ) ;
|
|
csLineCross:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' ) ;
|
|
csPlus:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(L + 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W - 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' l ' +
|
|
frFloat2Str(GetLeft(L + W / 2)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W / 2)) + ' ' + frFloat2Str(GetTop(T + obj.Height)) + ' l ');
|
|
end
|
|
else
|
|
case cb.UncheckStyle of
|
|
usEmpty: ;
|
|
usCross:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
|
|
frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
|
|
frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' +
|
|
frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
|
|
frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ');
|
|
usLineCross:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
|
|
frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
|
|
frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ');
|
|
usMinus:
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(L + 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
|
|
frFloat2Str(GetLeft(L + W - 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' l ');
|
|
end;
|
|
|
|
Write(OutStream, 'S'#13#10);
|
|
|
|
end;
|
|
|
|
function NeedSpaceAdjustment: Boolean;
|
|
function IsEndOfParagraph: Boolean;
|
|
begin
|
|
Result := Integer(Lines.Objects[i]) and 2 <> 0;
|
|
end;
|
|
begin
|
|
Result := (textObj.HAlign = haBlock) and not IsEndOfParagraph and
|
|
(pdfFont.LastRemappedStrSpacesCount > 0);
|
|
if not Result then
|
|
Exit;
|
|
FLineWidth := HWidth;
|
|
SpaceAdjustment := pdfFont.LastRemappedStrWidth - HWidth * PDF_DIVIDER * 1000 / textObj.Font.Size;
|
|
SpaceAdjustment := SpaceAdjustment / pdfFont.LastRemappedStrSpacesCount;
|
|
end;
|
|
|
|
begin
|
|
FHeightWoMargin := FHeight - FMarginTop;
|
|
Left := frFloat2Str(GetLeft(Obj.AbsLeft));
|
|
Top := frFloat2Str(GetTop(Obj.AbsTop));
|
|
Right := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width));
|
|
Bottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height));
|
|
Width := frFloat2Str(Obj.Width * PDF_DIVIDER);
|
|
Height := frFloat2Str(Obj.Height * PDF_DIVIDER);
|
|
|
|
OldFrameWidth := 0;
|
|
WriteLink(Obj.URL);
|
|
|
|
{ Memo object will be written to a pdf file as text if
|
|
the following conditions are satisfied. All other
|
|
memo objects will be saved as pictures:
|
|
|
|
- brush style is "solid" or "clear"
|
|
- "wordwrap" option is disabled
|
|
- clipping is disabled
|
|
- html formatting is disabled }
|
|
|
|
if (Obj is TfrxCustomMemoView)
|
|
and (TfrxCustomMemoView(Obj).BrushStyle in [ TBrushKind.bkSolid, TBrushKind.bkNone])
|
|
and not HTMLTags(TfrxCustomMemoView(Obj)) then
|
|
begin
|
|
// save clip to stack
|
|
Write(OutStream, 'q'#13#10);
|
|
Write(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft - Obj.Frame.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.Width)) + ' ' +
|
|
frFloat2Str((Obj.Width + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' ' + frFloat2Str((Obj.Height + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' re'#13#10'W'#13#10'n'#13#10);
|
|
ow := Obj.Width;
|
|
oh := Obj.Height;
|
|
// Shadow
|
|
if Obj.Frame.DropShadow then
|
|
begin
|
|
ow := Obj.Width - Obj.Frame.ShadowWidth;
|
|
oh := Obj.Height - Obj.Frame.ShadowWidth;
|
|
Width := frFloat2Str(ow * PDF_DIVIDER);
|
|
Height := frFloat2Str(oh * PDF_DIVIDER);
|
|
Right := frFloat2Str(GetLeft(Obj.AbsLeft + ow));
|
|
Bottom := frFloat2Str(GetTop(Obj.AbsTop + oh));
|
|
s := AnsiString(GetPDFColor(Obj.Frame.ShadowColor));
|
|
Write(OutStream, s + ' rg'#13#10 + s + ' RG'#13#10 +
|
|
AnsiString(frFloat2Str(GetLeft(Obj.AbsLeft + ow)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
|
|
frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' ' + frFloat2Str(oh * PDF_DIVIDER) + ' re'#13#10'B'#13#10 +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Frame.ShadowWidth)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
|
|
frFloat2Str(ow * PDF_DIVIDER) + ' ' + frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' re'#13#10'B'#13#10));
|
|
end;
|
|
|
|
textObj := TfrxCustomMemoView(Obj);
|
|
|
|
AFont := TFont.Create;
|
|
try
|
|
if textObj.Highlight.Active and
|
|
Assigned(textObj.Highlight.Font) then
|
|
begin
|
|
textObj.Font.Assign(textObj.Highlight.Font);
|
|
textObj.Color := textObj.Highlight.Color;
|
|
end;
|
|
|
|
wx1 := Round((textObj.Frame.Width - 1) / 2);
|
|
wx2 := Round(textObj.Frame.Width / 2);
|
|
wy1 := Round((textObj.Frame.Width - 1) / 2);
|
|
wy2 := Round(textObj.Frame.Width / 2);
|
|
|
|
bx := Round(textObj.AbsLeft);
|
|
by := Round(textObj.AbsTop);
|
|
bx1 := Round(textObj.AbsLeft + textObj.Width);
|
|
by1 := Round(textObj.AbsTop + textObj.Height);
|
|
if ftLeft in textObj.Frame.Typ then
|
|
Inc(bx, wx1);
|
|
if ftRight in textObj.Frame.Typ then
|
|
Dec(bx1, wx2);
|
|
if ftTop in textObj.Frame.Typ then
|
|
Inc(by, wy1);
|
|
if ftBottom in textObj.Frame.Typ then
|
|
Dec(by1, wy2);
|
|
gx1 := Round(textObj.GapX);
|
|
gy1 := Round(textObj.GapY);
|
|
|
|
FTextRect := RectF(bx + gx1, by + gy1, bx1 - gx1 + 1, by1 - gy1 + 1);
|
|
|
|
FBmpCanvas.Canvas.BeginScene();
|
|
textObj.Font.AssignToCanvas(FBmpCanvas.Canvas);
|
|
FBmpCanvas.Canvas.EndScene;
|
|
{$IFDEF Delphi10}
|
|
Lines := TfrxWideStrings.Create;
|
|
{$ELSE}
|
|
Lines := TWideStrings.Create;
|
|
{$ENDIF}
|
|
textObj.WrapText(textObj.WordBreak, FLineHeight, Lines, FBmpCanvas);
|
|
|
|
if textObj.Color <> claNull then
|
|
Write(OutStream, GetPDFColor(textObj.Color) + ' rg'#13#10 + Left + ' ' + Bottom + ' ' +
|
|
Width + ' ' + Height + ' re'#13#10'f'#13#10);
|
|
// Frames
|
|
MakeUpFrames;
|
|
|
|
if TextObj.Rotation > 0 then
|
|
begin
|
|
Angle := TextObj.Rotation * Pi / 180;
|
|
a_sin := Sin(Angle);
|
|
a_cos := Cos(Angle);
|
|
|
|
case TextObj.Rotation of
|
|
90, 180, 270:
|
|
begin
|
|
a_x := GetLeft(TextObj.AbsLeft + TextObj.Width/2);
|
|
a_y := GetTop(TextObj.AbsTop + TextObj.Height/2);
|
|
end
|
|
else
|
|
begin
|
|
case TextObj.Rotation of
|
|
45..135, 225..315:
|
|
begin
|
|
rx := TextObj.Height;
|
|
ry := TextObj.Width;
|
|
end
|
|
else
|
|
begin
|
|
rx := TextObj.Width;
|
|
ry := TextObj.Height;
|
|
end
|
|
end;
|
|
|
|
//a_x := GetLeft(TextObj.AbsLeft + 0.5 * (rx * a_cos + ry * a_sin));
|
|
//a_y := GetTop(TextObj.AbsTop + 0.5 * (rx * a_sin + ry * a_cos));
|
|
a_x := GetLeft(TextObj.AbsLeft + TextObj.Width/2);
|
|
a_y := GetTop(TextObj.AbsTop + TextObj.Height/2);
|
|
end
|
|
end;
|
|
|
|
WriteLn(OutStream, frFloat2Str(a_cos) + ' ' + frFloat2Str(a_sin) + ' ' +
|
|
frFloat2Str(-a_sin) + ' ' + frFloat2Str(a_cos) + ' ' +
|
|
frFloat2Str(a_x) + ' ' + frFloat2Str(a_y) + ' cm');
|
|
end;
|
|
|
|
if textObj.Underlines then
|
|
begin
|
|
iz := Trunc(textObj.Height / FLineHeight);
|
|
for i:= 0 to iz - 1 do
|
|
begin
|
|
y := GetTop(textObj.AbsTop + textObj.GapY + 1 + FLineHeight * (i + 1) - textObj.LineSpacing);
|
|
Write(OutStream, GetPDFColor(textObj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(textObj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
Left + ' ' + frFloat2Str(y) + ' m'#13#10 +
|
|
Right + ' ' + frFloat2Str(y) + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
|
|
|
|
if Lines.Count > 0 then
|
|
begin
|
|
textObj.Font.AssignToFont(AFont);
|
|
FontIndex := GetObjFontNumber(AFont);
|
|
pdfFont := TfrxPDFFont(FPageFonts[FontIndex]);
|
|
simulateBold := (TFontStyle.fsBold in textObj.Font.Style) and FontNeedsBoldItalicSimulation(AFont);
|
|
simulateItalic := (TFontStyle.fsItalic in textObj.Font.Style) and FontNeedsBoldItalicSimulation(AFont);
|
|
{$IFDEF Delphi12}
|
|
Write(OutStream, TfrxPDFFont(FFonts[FontIndex]).Name +
|
|
AnsiString(' ' + frFloat2Str(((Round(textObj.Font.Size) - tpPt * Round(textObj.Font.Size)) * 10) / 10) + ' Tf'#13#10));
|
|
{$ELSE}
|
|
Write(OutStream, TfrxPDFFont(FFonts[FontIndex]).Name +
|
|
' ' + IntToStr(Round(textObj.Font.Size)) + ' Tf'#13#10);
|
|
{$ENDIF}
|
|
if textObj.Font.Color <> claNull then
|
|
TempColor := textObj.Font.Color
|
|
else
|
|
TempColor := claBlack;
|
|
Write(OutStream, GetPDFColor(TempColor) + ' rg'#13#10);
|
|
//CharSpacing not used anymore , but we need it to emulate canvas behaviour
|
|
FCharSpacing := 0;// -0.2;// textObj.CharSpacing * PDF_DIVIDER;
|
|
if FCharSpacing <> 0 then
|
|
Write(OutStream, frFloat2Str(FCharSpacing) + ' Tc'#13#10);
|
|
|
|
// output lines of memo
|
|
FUnderlinePosition := textObj.Font.Size * 0.12;
|
|
FStrikeoutPosition := textObj.Font.Size * 0.28;
|
|
//frxDrawText.SetGaps(0, TfrxCustomMemoView(Obj).CharSpacing, TfrxCustomMemoView(Obj).LineSpacing);
|
|
|
|
for i := 0 to Lines.Count - 1 do
|
|
begin
|
|
// ParagraphGap is not implimented
|
|
// if textObj.Lines.Count <> Lines.Count then
|
|
// begin
|
|
// if Integer(Lines.Objects[i]) and 1 <> 0 then
|
|
// PGap := textObj.ParagraphGap
|
|
// else
|
|
// PGap := 0;
|
|
// end else
|
|
// if i = 0 then
|
|
// PGap := textObj.ParagraphGap
|
|
// else
|
|
PGap := 0;
|
|
|
|
if Length(Lines[i]) > 0 then
|
|
begin
|
|
// Text output
|
|
if textObj.HAlign <> haRight then
|
|
FCharSpacing := 0;
|
|
|
|
RemappedStr := pdfFont.RemapString(Lines[i], textObj.RTLReading);
|
|
FLineWidth := pdfFont.LastRemappedStrWidth / PDF_DIVIDER / 1000 * textObj.Font.Size;
|
|
|
|
if textObj.Rotation > 0 then
|
|
begin
|
|
if ((textObj.Rotation >= 45) and (textObj.Rotation <= 135)) or
|
|
((textObj.Rotation >= 225 ) and (textObj.Rotation <= 315)) then
|
|
begin
|
|
rx := oh;
|
|
ry := ow;
|
|
end
|
|
else
|
|
begin
|
|
rx := ow;
|
|
ry := oh;
|
|
end;
|
|
HWidth := rx;
|
|
x := FCharSpacing + (GetHTextPosR(rx / 2, Lines[i], textObj.HAlign)) * PDF_DIVIDER;
|
|
y := -(GetVTextPosR(ry / 2, textObj.VAlign, i, Lines.Count)) * PDF_DIVIDER + textObj.Font.Size * 0.4;
|
|
end
|
|
else
|
|
begin
|
|
HWidth := ow - textObj.GapX * 2 - PGap;
|
|
x := FCharSpacing + GetLeft(GetHTextPos(textObj.AbsLeft + textObj.GapX + PGap,
|
|
HWidth, Lines[i], textObj.HAlign));
|
|
y := GetTop(GetVTextPos(textObj.AbsTop + textObj.GapY - textObj.Font.Size * 0.2,
|
|
oh - textObj.GapY * 2, textObj.VAlign, i, Lines.Count));
|
|
end;
|
|
|
|
Write(OutStream, 'BT'#13#10);
|
|
Write(OutStream, frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Td'#13#10);
|
|
if simulateItalic then
|
|
begin
|
|
Write(OutStream, '1 0 0.3333 1 ');
|
|
Write(OutStream, frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Tm'#13#10);
|
|
end;
|
|
if simulateBold then
|
|
begin
|
|
Write(OutStream, '2 Tr ');
|
|
Write(OutStream, frFloat2Str(textObj.Font.Size / 35.0));
|
|
Write(OutStream, ' w ' + GetPDFColor(TempColor) + ' RG'#13#10);
|
|
end;
|
|
if NeedSpaceAdjustment then
|
|
Write(OutStream, '[<' + StrToHexSp(Lines[i], RemappedStr, SpaceAdjustment) + '>] TJ'#13#10'ET'#13#10)
|
|
else
|
|
Write(OutStream, '<' + StrToHex(RemappedStr) + '> Tj'#13#10'ET'#13#10);
|
|
if simulateBold then
|
|
Write(OutStream, '0 Tr'#13#10);
|
|
|
|
{ underlined text }
|
|
|
|
with textObj do
|
|
if TFontStyle.fsUnderline in Font.Style then
|
|
begin
|
|
Cmd(GetPDFColor(Font.Color), 'RG');
|
|
Cmd(frFloat2Str(Font.Size * 0.08), 'w');
|
|
Cmd(frFloat2Str(x) + ' ' + frFloat2Str(y - FUnderlinePosition), 'm');
|
|
Cmd(frFloat2Str(x + FLineWidth * PDF_DIVIDER) + ' ' +
|
|
frFloat2Str(y - FUnderlinePosition), 'l');
|
|
|
|
Cmd('', 'S');
|
|
end;
|
|
|
|
{ struck out text }
|
|
|
|
if TFontStyle.fsStrikeout in (textObj.Font.Style) then
|
|
Write(OutStream, GetPDFColor(textObj.Font.Color) + ' RG'#13#10 +
|
|
frFloat2Str(textObj.Font.Size * 0.08) + ' w'#13#10 +
|
|
frFloat2Str(x) + ' ' + frFloat2Str(y + FStrikeoutPosition) + ' m'#13#10 +
|
|
frFloat2Str(x + FLineWidth * PDF_DIVIDER) +
|
|
' ' + frFloat2Str(y + FStrikeoutPosition) + ' l'#13#10'S'#13#10);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
AFont.Free;
|
|
end;
|
|
// restore clip
|
|
Write(OutStream, 'Q'#13#10);
|
|
Lines.Free;
|
|
end
|
|
// Lines
|
|
else if Obj is TfrxCustomLineView then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
Left + ' ' + Top + ' m'#13#10 +
|
|
Right + ' ' + Bottom + ' l'#13#10'S'#13#10);
|
|
if TfrxCustomLineView(Obj).ArrowStart then
|
|
DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop));
|
|
if TfrxCustomLineView(Obj).ArrowEnd then
|
|
DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height));
|
|
end
|
|
// Rects
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
GetPDFColor(Obj.Color) + ' rg'#13#10 +
|
|
Left + ' ' + Bottom + ' '#13#10 +
|
|
Width + ' ' + Height + ' re'#13#10);
|
|
if Obj.Color <> claNull then
|
|
Write(OutStream, 'B'#13#10)
|
|
else
|
|
Write(OutStream, 'S'#13#10);
|
|
end
|
|
|
|
{ Rounded rectangle }
|
|
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRoundRectangle) then
|
|
WriteRoundedRect(TfrxShapeView(Obj))
|
|
|
|
// Shape line 1
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal1) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
Left + ' ' + Bottom + ' m'#13#10 + Right + ' ' + Top + ' l'#13#10'S'#13#10)
|
|
end
|
|
// Shape line 2
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal2) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
Left + ' ' + Top + ' m'#13#10 + Right + ' ' + Bottom + ' l'#13#10'S'#13#10)
|
|
end
|
|
// Shape diamond
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiamond) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
GetPDFColor(Obj.Color) + ' rg');
|
|
WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' m ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height / 2)) + ' l ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height / 2)) + ' l ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' l');
|
|
if Obj.Color <> claNull then
|
|
Write(OutStream, 'B'#13#10)
|
|
else
|
|
Write(OutStream, 'S'#13#10);
|
|
end
|
|
// Shape triangle
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skTriangle) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
GetPDFColor(Obj.Color) + ' rg');
|
|
WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' m ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' l');
|
|
if Obj.Color <> claNull then
|
|
Write(OutStream, 'B'#13#10)
|
|
else
|
|
Write(OutStream, 'S'#13#10);
|
|
end
|
|
// Shape ellipse
|
|
else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skEllipse) then
|
|
begin
|
|
WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
|
|
WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
|
|
frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
|
|
GetPDFColor(Obj.Color) + ' rg');
|
|
rx := Obj.Width / 2;
|
|
ry := Obj.Height / 2;
|
|
WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' m');
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA1)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA1)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' c');
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA1)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' c');
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA2)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' c');
|
|
WriteLn(OutStream,
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA1)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA2)) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' c');
|
|
if Obj.Color <> claNull then
|
|
Write(OutStream, 'B'#13#10)
|
|
else
|
|
Write(OutStream, 'S'#13#10);
|
|
end
|
|
else if (Obj is TfrxCheckboxView) then ExportChebox(Obj)
|
|
else
|
|
// Bitmaps
|
|
{$IFNDEF OLD_STYLE}
|
|
// Bitmaps
|
|
if not ((Obj.Name = '_pagebackground') and (not Background)) and
|
|
(Obj.Height > 0) and (Obj.Width > 0) then
|
|
begin
|
|
if Obj.Frame.Width > 0 then
|
|
begin
|
|
OldFrameWidth := Obj.Frame.Width;
|
|
Obj.Frame.Width := 0;
|
|
end;
|
|
|
|
FRealBounds := Obj.GetRealBounds;
|
|
dx := FRealBounds.Right - FRealBounds.Left;
|
|
dy := FRealBounds.Bottom - FRealBounds.Top;
|
|
|
|
if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
|
|
fdx := 0
|
|
else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
|
|
fdx := (dx - Obj.Width)
|
|
else
|
|
fdx := (dx - Obj.Width) / 2;
|
|
|
|
if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
|
|
fdy := 0
|
|
else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
|
|
fdy := (dy - Obj.Height)
|
|
else
|
|
fdy := (dy - Obj.Height) / 2;
|
|
|
|
TempBitmap := TBitmap.Create(1,1);
|
|
{$IFDEF DELPHI20}
|
|
///TempBitmap.PixelFormat := TPixelFormat.RGBA;
|
|
{$ENDIF}
|
|
|
|
try
|
|
|
|
if (PrintOptimized or (Obj is TfrxCustomMemoView)) and (Obj.BrushStyle in [TBrushKind.bkSolid, TBrushKind.bkNone]) then
|
|
i := PDF_PRINTOPT
|
|
else
|
|
i := 1;
|
|
|
|
iz := 0;
|
|
|
|
if (Obj.ClassName = 'TfrxBarCodeView') and not PrintOptimized then
|
|
begin
|
|
i := 2;
|
|
iz := i;
|
|
end;
|
|
|
|
TempBitmap.Width := Round(dx * i) + i;
|
|
TempBitmap.Height := Round(dy * i) + i;
|
|
IsTransparent := False;
|
|
IsAlpha := False;
|
|
if Obj is TfrxPictureView then
|
|
IsTransparent := TfrxPictureView(Obj).Transparent
|
|
else if Obj is TfrxMemoView then
|
|
IsTransparent := (TfrxMemoView(Obj).Color = claNull);
|
|
|
|
try
|
|
if IsTransparent then
|
|
begin
|
|
TempBitmap.Clear($FFFFFF);
|
|
MaskSize := TempBitmap.Height * TempBitmap.Width;
|
|
SetLength( MaskBytes, MaskSize );
|
|
end
|
|
else
|
|
TempBitmap.Clear(claWhite);
|
|
TempBitmap.Canvas.BeginScene();
|
|
Obj.Draw(TempBitmap.Canvas, i, i, -Round((Obj.AbsLeft - fdx) * i) + iz, -Round((Obj.AbsTop - fdy)* i));
|
|
TempBitmap.Canvas.EndScene;
|
|
if IsTransparent then
|
|
begin
|
|
IsAlpha := False;
|
|
Counter := 0;
|
|
{$IFDEF DELPHI17}
|
|
TempBitmap.Map(TMapAccess.maReadWrite, bData);
|
|
{$ENDIF}
|
|
for iy := 0 to TempBitmap.Height - 1 do
|
|
begin
|
|
{$IFDEF DELPHI18}
|
|
dots := bData.GetScanline(iy);
|
|
{$ELSE}
|
|
{$IFDEF DELPHI17}
|
|
dots := @PLongByteArray(bData.Data)[iy * bData.Pitch];
|
|
{$ELSE}
|
|
dots := Pointer(TempBitmap.Scanline[iy]);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
for ix := 0 to TempBitmap.Width - 1 do
|
|
begin
|
|
if dots[ix].Alpha <> 0 then
|
|
IsAlpha := True;
|
|
MaskBytes[Counter] := dots[ix].Alpha;
|
|
Inc(Counter);
|
|
end;
|
|
end;
|
|
{$IFDEF DELPHI17}
|
|
TempBitmap.Unmap(bData);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
except
|
|
// charts throw exceptions when numbers are malformed
|
|
end;
|
|
|
|
{ Write XObject with a picture inside }
|
|
|
|
|
|
XObjectStream := TMemoryStream.Create;
|
|
XMaskStream := TMemoryStream.Create;
|
|
try
|
|
SaveGraphicAs(TempBitmap, XObjectStream, gpJPG);
|
|
// Prepare mask
|
|
if IsAlpha = True then
|
|
begin
|
|
XMaskStream.Position := 0;
|
|
XMaskStream.Write( Pointer(MaskBytes)^, Counter );
|
|
XMaskStream.Position := 0;
|
|
GetStreamHash(XMaskHash, XMaskStream);
|
|
MaskIndex := FindXObject(XMaskHash);
|
|
|
|
if MaskIndex < 0 then
|
|
begin
|
|
XMaskId := UpdateXRef;
|
|
MaskIndex := AddXObject(XMaskId, XMaskHash);
|
|
Writeln(pdf, ObjNumber(XMaskId));
|
|
|
|
WriteLn(pdf, '<< /Type /XObject');
|
|
WriteLn(pdf, '/Subtype /Image');
|
|
WriteLn(pdf, '/Width ' + IntToStr(TempBitmap.Width));
|
|
WriteLn(pdf, '/Height ' + IntToStr(TempBitmap.Height));
|
|
WriteLn(pdf, '/ColorSpace /DeviceGray/Matte[ 0 0 0] ');
|
|
WriteLn(pdf, '/BitsPerComponent 8');
|
|
WriteLn(pdf, '/Interpolate false');
|
|
WriteLn(pdf, ' /Length ' + IntToStr(MaskSize) + ' >>');
|
|
WriteLn(pdf, 'stream');
|
|
if FProtection then
|
|
CryptStream(XMaskStream, pdf, FEncKey, XObjectId)
|
|
else
|
|
pdf.CopyFrom(XMaskStream, 0);
|
|
|
|
Write(pdf, #13#10'endstream'#13#10);
|
|
WriteLn(pdf, 'endobj');
|
|
end;
|
|
{ hash should be calculated for Pic + Mask }
|
|
XMaskStream.Position := XMaskStream.Size;
|
|
XObjectStream.Position := 0;
|
|
XMaskStream.CopyFrom(XObjectStream, 0);
|
|
XMaskStream.Position := 0;
|
|
XObjectStream.Position := 0;
|
|
GetStreamHash(XObjectHash, XMaskStream);
|
|
PicIndex := FindXObject(XObjectHash);
|
|
end
|
|
else
|
|
begin
|
|
XObjectStream.Position := 0;
|
|
GetStreamHash(XObjectHash, XObjectStream);
|
|
PicIndex := FindXObject(XObjectHash);
|
|
end;
|
|
|
|
if PicIndex < 0 then
|
|
begin
|
|
XObjectId := UpdateXRef;
|
|
PicIndex := AddXObject(XObjectId, XObjectHash);
|
|
|
|
Writeln(pdf, ObjNumber(XObjectId));
|
|
Writeln(pdf, '<<');
|
|
Writeln(pdf, '/Type /XObject');
|
|
Writeln(pdf, '/Subtype /Image');
|
|
Writeln(pdf, '/ColorSpace /DeviceRGB');
|
|
Writeln(pdf, '/BitsPerComponent 8');
|
|
Writeln(pdf, '/Filter /DCTDecode');
|
|
Writeln(pdf, '/Width ' + IntToStr(TempBitmap.Width));
|
|
Writeln(pdf, '/Height ' + IntToStr(TempBitmap.Height));
|
|
if IsAlpha = True then
|
|
WriteLn(pdf, '/SMask ' + IntToStr(XMaskId) + ' 0 R');
|
|
Writeln(pdf, '/Length ' + IntToStr(XObjectStream.Size));
|
|
Writeln(pdf, '>>');
|
|
|
|
Write(pdf, 'stream'#13#10); // 'stream'#10 is also valid
|
|
XObjectStream.Position := 0;
|
|
pdf.CopyFrom(XObjectStream, 0);
|
|
Write(pdf, #13#10'endstream'#13#10);
|
|
Inc(FPicTotalSize, XObjectStream.Size);
|
|
|
|
Writeln(pdf, 'endobj');
|
|
|
|
end;
|
|
finally
|
|
XObjectStream.Free;
|
|
XMaskStream.Free;
|
|
end;
|
|
finally
|
|
TempBitmap.Free;
|
|
end;
|
|
|
|
{ Reference to this XObject }
|
|
|
|
SetLength(FUsedXObjects, Length(FUsedXObjects) + 1);
|
|
FUsedXObjects[High(FUsedXObjects)] := PicIndex;
|
|
|
|
Writeln(OutStream, 'q');
|
|
Writeln(OutStream,
|
|
frFloat2Str(dx * PDF_DIVIDER) + ' ' +
|
|
'0 ' +
|
|
'0 ' +
|
|
frFloat2Str(dy * PDF_DIVIDER) + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft - fdx)) + ' ' +
|
|
frFloat2Str(GetTop(Obj.AbsTop - fdy + dy)) + ' ' +
|
|
'cm');
|
|
Writeln(OutStream, '/Im' + IntToStr(PicIndex) + ' Do');
|
|
Writeln(OUtStream, 'Q');
|
|
|
|
if OldFrameWidth > 0 then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
|
|
MakeUpFrames;
|
|
end;
|
|
{$ELSE}
|
|
if not ((Obj.Name = '_pagebackground') and (not Background)) and
|
|
(Obj.Height > 0) and (Obj.Width > 0) then
|
|
begin
|
|
if Obj.Frame.Width > 0 then
|
|
begin
|
|
OldFrameWidth := Obj.Frame.Width;
|
|
Obj.Frame.Width := 0;
|
|
end;
|
|
|
|
FRealBounds := Obj.GetRealBounds;
|
|
dx := FRealBounds.Right - FRealBounds.Left;
|
|
dy := FRealBounds.Bottom - FRealBounds.Top;
|
|
|
|
if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
|
|
fdx := 0
|
|
else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
|
|
fdx := (dx - Obj.Width)
|
|
else
|
|
fdx := (dx - Obj.Width) / 2;
|
|
|
|
if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
|
|
fdy := 0
|
|
else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
|
|
fdy := (dy - Obj.Height)
|
|
else
|
|
fdy := (dy - Obj.Height) / 2;
|
|
|
|
TempBitmap := TBitmap.Create;
|
|
TempBitmap.PixelFormat := pf24bit;
|
|
|
|
if (PrintOptimized or (Obj is TfrxCustomMemoView)) and (Obj.BrushStyle in [bsSolid, bsClear]) then
|
|
i := PDF_PRINTOPT
|
|
else
|
|
i := 1;
|
|
|
|
iz := 0;
|
|
|
|
if (Obj.ClassName = 'TfrxBarCodeView') and not PrintOptimized then
|
|
begin
|
|
i := 2;
|
|
iz := i;
|
|
end;
|
|
|
|
TempBitmap.Width := Round(dx * i) + i;
|
|
TempBitmap.Height := Round(dy * i) + i;
|
|
TempBitmap.Canvas.BeginScene();
|
|
Obj.Draw(TempBitmap.Canvas, i, i, -Round((Obj.AbsLeft - fdx) * i) + iz, -Round((Obj.AbsTop - fdy)* i));
|
|
TempBitmap.Canvas.EndScene;
|
|
if dx <> 0 then
|
|
BWidth := frFloat2Str(dx * PDF_DIVIDER)
|
|
else
|
|
BWidth := '1';
|
|
if dy <> 0 then
|
|
BHeight := frFloat2Str(dy * PDF_DIVIDER)
|
|
else
|
|
BHeight := '1';
|
|
|
|
Write(OutStream, 'q'#13#10 + BWidth + ' 0 0 ' + BHeight + ' ' +
|
|
frFloat2Str(GetLeft(Obj.AbsLeft - fdx)) + ' ' +
|
|
frFloat2Str(GetTop(Obj.AbsTop - fdy + dy)) + ' cm'#13#10'BI'#13#10 +
|
|
'/W ' + IntToStr(TempBitmap.Width) + #13#10 +
|
|
'/H ' + IntToStr(TempBitmap.Height) + #13#10'/CS /RGB'#13#10'/BPC 8'#13#10'/I true'#13#10'/F [/DCT]'#13#10'ID'#13#10);
|
|
|
|
Jpg := TJPEGImage.Create;
|
|
|
|
if (Obj.ClassName = 'TfrxBarCodeView') or
|
|
(Obj is TfrxCustomLineView) or
|
|
(Obj is TfrxShapeView) then
|
|
begin
|
|
Jpg.PixelFormat := jf8Bit;
|
|
Jpg.CompressionQuality := FQuality+5; // 95;
|
|
end
|
|
else begin
|
|
Jpg.PixelFormat := jf24Bit;
|
|
Jpg.CompressionQuality := FQuality; //90;
|
|
end;
|
|
|
|
Jpg.Assign(TempBitmap);
|
|
Jpg.SaveToStream(OutStream);
|
|
Jpg.Free;
|
|
|
|
Write(OutStream, #13#10'EI'#13#10'Q'#13#10);
|
|
TempBitmap.Free;
|
|
if OldFrameWidth > 0 then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
MakeUpFrames;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TfrxPDFExportDialog }
|
|
|
|
procedure TfrxPDFExportDialog.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption := frxGet(8700);
|
|
OkB.Text := frxGet(1);
|
|
CancelB.Text := frxGet(2);
|
|
GroupPageRange.Text := frxGet(7);
|
|
AllRB.Text := frxGet(3);
|
|
CurPageRB.Text := frxGet(4);
|
|
PageNumbersRB.Text := frxGet(5);
|
|
DescrL.Text := frxGet(9);
|
|
GroupQuality.Text := frxGet(8);
|
|
CompressedCB.Text := frxGet(8701);
|
|
EmbeddedCB.Text := frxGet(8702);
|
|
PrintOptCB.Text := frxGet(8703);
|
|
OutlineCB.Text := frxGet(8704);
|
|
BackgrCB.Text := frxGet(8705);
|
|
OpenCB.Text := frxGet(8706);
|
|
SaveDialog1.Filter := frxGet(8707);
|
|
SaveDialog1.DefaultExt := frxGet(8708);
|
|
|
|
ExportPage.Text := frxGet(107);
|
|
DocInfoGB.Text := frxGet(8971);
|
|
InfoPage.Text := frxGet(8972);
|
|
TitleL.Text := frxGet(8973);
|
|
AuthorL.Text := frxGet(8974);
|
|
SubjectL.Text := frxGet(8975);
|
|
KeywordsL.Text := frxGet(8976);
|
|
CreatorL.Text := frxGet(8977);
|
|
ProducerL.Text := frxGet(8978);
|
|
|
|
SecurityPage.Text := frxGet(8962);
|
|
SecGB.Text := frxGet(8979);
|
|
PermGB.Text := frxGet(8980);
|
|
OwnPassL.Text := frxGet(8964);
|
|
UserPassL.Text := frxGet(8965);
|
|
PrintCB.Text := frxGet(8966);
|
|
ModCB.Text := frxGet(8967);
|
|
CopyCB.Text := frxGet(8968);
|
|
AnnotCB.Text := frxGet(8969);
|
|
|
|
ViewerPage.Text := frxGet(8981);
|
|
ViewerGB.Text := frxGet(8982);
|
|
HideToolbarCB.Text := frxGet(8983);
|
|
HideMenubarCB.Text := frxGet(8984);
|
|
HideWindowUICB.Text := frxGet(8985);
|
|
FitWindowCB.Text := frxGet(8986);
|
|
CenterWindowCB.Text := frxGet(8987);
|
|
PrintScalingCB.Text := frxGet(8988);
|
|
{$IFDEF LINUX}
|
|
BorderStyleSizeable(Self);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxPDFExportDialog.PageNumbersEChange(Sender: TObject);
|
|
begin
|
|
PageNumbersRB.IsChecked := True;
|
|
end;
|
|
|
|
procedure TfrxPDFExportDialog.PageNumbersEKeyPress(Sender: TObject;
|
|
var Key: Char);
|
|
begin
|
|
case key of
|
|
'0'..'9':;
|
|
#8, '-', ',':;
|
|
else
|
|
key := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFExportDialog.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
|
begin
|
|
if Key = VK_F1 then
|
|
frxResources.Help(Self);
|
|
end;
|
|
|
|
procedure TfrxPDFExportDialog.OkBClick(Sender: TObject);
|
|
begin
|
|
|
|
end;
|
|
|
|
{ TfrxPDFFont }
|
|
|
|
constructor TfrxPDFFont.Create(Font: TFont);
|
|
var
|
|
dpi: integer;
|
|
begin
|
|
SourceFont := TFont.Create;
|
|
dpi := 72;//SourceFont.PixelsPerInch;
|
|
SourceFont.Assign(Font);
|
|
FSubstituteName := Font.Family;
|
|
FDpiFX := 96 / dpi;
|
|
PDFdpi_divider := 1 / (750 * FDpiFX);
|
|
SourceFont.Size := Round(750 * FDpiFX);
|
|
tempBitmap := TBitmap.Create(1,1);
|
|
Widths := TList.Create;
|
|
UsedAlphabet := TList.Create;
|
|
UsedAlphabetUnicode := TList.Create;
|
|
Saved := false;
|
|
PackFont := true;
|
|
FontDataSize := 0;
|
|
FComposedList := TList.Create;
|
|
FontData := TMemoryStream.Create;
|
|
TrueTypeTables := Nil;
|
|
GetFontFile;
|
|
end;
|
|
|
|
destructor TfrxPDFFont.Destroy;
|
|
begin
|
|
Cleanup;
|
|
SourceFont.Free;
|
|
Widths.Free;
|
|
UsedAlphabet.Free;
|
|
UsedAlphabetUnicode.Free;
|
|
FComposedList.Free;
|
|
if Assigned(TrueTypeTables) then
|
|
TrueTypeTables.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxPDFFont.Cleanup;
|
|
begin
|
|
tempBitmap.Free;
|
|
Widths.Clear;
|
|
UsedAlphabet.Clear;
|
|
UsedAlphabetUnicode.Clear;
|
|
FComposedList.Clear;
|
|
if FontData <> nil then
|
|
begin
|
|
FontData.Free;
|
|
FontDataSize := 0;
|
|
FontData := nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TfrxPDFFont.GetGlyphIndices(text: WideString; glyphs: System.PWord; widths: System.PInteger; rtl: boolean): integer;
|
|
var
|
|
maxGlyphs: Integer;
|
|
// maxItems: Integer;
|
|
j, len: Integer;
|
|
tempGlyphs, g1, g2: System.PWord;
|
|
tempWidths, w1, w2: System.PInteger;
|
|
FName: String;
|
|
begin
|
|
FName := FSubstituteName;
|
|
FName := PdfSubstituteName(FName);
|
|
if text = '' then
|
|
result := 0
|
|
else
|
|
begin
|
|
maxGlyphs := Length(text) * 3;
|
|
// maxItems := Length(text) * 2;
|
|
result := 0;
|
|
g2 := glyphs;
|
|
w2 := widths;
|
|
tempGlyphs := GetMemory(SizeOf(Word) * maxGlyphs);
|
|
tempWidths := GetMemory(SizeOf(Integer) * maxGlyphs);
|
|
try
|
|
len := FCurrentFont.GetGlyphIndices(text, tempGlyphs, tempWidths, rtl, FComposedList);
|
|
g1 := tempGlyphs;
|
|
w1 := tempWidths;
|
|
for j := 1 to len do
|
|
begin
|
|
g2^ := g1^;
|
|
w2^ := w1^;
|
|
Inc(g1);
|
|
Inc(g2);
|
|
Inc(w1);
|
|
Inc(w2);
|
|
end;
|
|
Inc(result, len);
|
|
finally
|
|
FreeMemory(tempGlyphs);
|
|
FreeMemory(tempWidths);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFFont.PackFontFile;
|
|
var
|
|
packed_font: TByteArray;
|
|
AUsedAlphabet: TList;
|
|
begin
|
|
if Self.PackFont then
|
|
begin
|
|
|
|
AUsedAlphabet := TList.Create;
|
|
AUsedAlphabet.Assign(UsedAlphabet, laOr, FComposedList);
|
|
packed_font := Self.TrueTypeTables.PackFont( SourceFont, AUsedAlphabet , FontData);
|
|
if packed_font <> nil then
|
|
begin
|
|
FontDataSize := Length(packed_font);
|
|
FontData.Size := FontDataSize;
|
|
{$IFDEF DELPHI18}
|
|
FontData.WriteData(packed_font, FontDataSize);
|
|
{$ELSE}
|
|
FontData.Write(packed_font[0], FontDataSize);
|
|
{$ENDIF}
|
|
FontData.Position := 0;
|
|
SetLength(packed_font, 0);
|
|
end;
|
|
AUsedAlphabet.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxPDFFont.FillOutlineTextMetrix;
|
|
var
|
|
FName: String;
|
|
begin
|
|
FName := FSubstituteName;
|
|
FName := PdfSubstituteName(FName);
|
|
FCurrentFont.GetOutlineTextMetrics(@TextMetric);
|
|
end;
|
|
|
|
//move this to font class later
|
|
{$IFDEF MSWINDOWS}
|
|
procedure TfrxPDFFont.GetFontFile;
|
|
var
|
|
CollectionMode: Cardinal;
|
|
Name: String;
|
|
memDC: HDC;
|
|
fnt: HFONT;
|
|
fBold: Integer;
|
|
fItalic: Cardinal;
|
|
begin
|
|
memDC := CreateCompatibleDC (0);
|
|
fBold := 0;
|
|
fItalic := 0;
|
|
if TFontStyle.fsBold in SourceFont.Style then fBold := 700;
|
|
if TFontStyle.fsItalic in SourceFont.Style then fItalic := 1;
|
|
fnt := CreateFont(0, 0, 0, 0, fBold, fItalic, 0, 0, DEFAULT_CHARSET, 0, 0, 0, 0, PWideChar(FSubstituteName));
|
|
try
|
|
SelectObject(memDC, fnt);
|
|
CollectionMode := $66637474;
|
|
FontDataSize := GetFontData(memDC, CollectionMode, 0, nil, 1);
|
|
|
|
if Cardinal(FontDataSize) = High(Cardinal) then
|
|
begin
|
|
CollectionMode := 0;
|
|
FontDataSize := GetFontData(memDC, CollectionMode, 0, nil, 1);
|
|
end;
|
|
FontData.SetSize(FontDataSize);
|
|
if FontData <> nil then
|
|
begin
|
|
GetFontData(memDC, CollectionMode, 0, FontData.Memory, FontDataSize);
|
|
if Assigned(TrueTypeTables) then
|
|
FreeAndNil(TrueTypeTables);
|
|
TrueTypeTables := TrueTypeCollection.Create();
|
|
TrueTypeTables.Initialize(FontData.Memory, FontDataSize);
|
|
|
|
Name := PdfSubstituteName(Name);
|
|
|
|
FCurrentFont := TrueTypeTables.GetTrueTypeFont(SourceFont);
|
|
FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
|
|
end;
|
|
finally
|
|
DeleteObject(fnt);
|
|
DeleteDC(memDC);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF MACOS}
|
|
|
|
function frxCFURLStartAccessingSecurityScopedResource(url: CFURLRef): Boolean;
|
|
var
|
|
CTLib: HMODULE;
|
|
begin
|
|
Result := False;
|
|
if not Assigned(_frxCFURLStartAccessingSecurityScopedResource) then
|
|
begin
|
|
CTLib := LoadLibrary(frxCoreFoundationLib);
|
|
if CTLib <> 0 then
|
|
begin
|
|
_frxCFURLStartAccessingSecurityScopedResource := Pointer(GetProcAddress(CTLib, PWideChar(_PFX + 'CFURLStartAccessingSecurityScopedResource'))^);
|
|
FreeLibrary(CTLib);
|
|
end;
|
|
end;
|
|
if Assigned(_frxCFURLStartAccessingSecurityScopedResource) then
|
|
Result := _frxCFURLStartAccessingSecurityScopedResource(url);
|
|
end;
|
|
|
|
procedure frxCFURLStopAccessingSecurityScopedResource(url: CFURLRef);
|
|
var
|
|
CTLib: HMODULE;
|
|
begin
|
|
if not Assigned(_frxCFURLStopAccessingSecurityScopedResource) then
|
|
begin
|
|
CTLib := LoadLibrary(frxCoreFoundationLib);
|
|
if CTLib <> 0 then
|
|
begin
|
|
_frxCFURLStopAccessingSecurityScopedResource := Pointer(GetProcAddress(CTLib, PWideChar(_PFX + 'CFURLStopAccessingSecurityScopedResource'))^);
|
|
FreeLibrary(CTLib);
|
|
end;
|
|
end;
|
|
if Assigned(_frxCFURLStopAccessingSecurityScopedResource) then
|
|
_frxCFURLStopAccessingSecurityScopedResource(url);
|
|
end;
|
|
|
|
procedure TfrxPDFFont.GetFontFile;
|
|
var
|
|
FontN, fPath: CFStringRef;
|
|
FontRef, NewFontRef: CTFontRef;
|
|
ASFont: ATSFontRef;
|
|
oFile: FSRef;
|
|
aURLRef: CFURLRef;
|
|
StrFilePath: String;
|
|
Name: String;
|
|
i: Integer;
|
|
cerr: CFErrorRef;
|
|
Status : OSStatus;
|
|
Accessing: Boolean;
|
|
begin
|
|
Name := FSubstituteName;
|
|
Name := PdfSubstituteName(Name);
|
|
// Name := PrepareFontName(Name, SourceFont, TrueTypeTables);
|
|
|
|
Accessing := false;
|
|
FontN := CFSTR(Name);
|
|
FontRef := CTFontCreateWithName(FontN, SourceFont.Size, nil);
|
|
if TFontStyle.fsItalic in SourceFont.Style then
|
|
begin
|
|
NewFontRef := CTFontCreateCopyWithSymbolicTraits(FontRef, 0, nil,
|
|
kCTFontItalicTrait, kCTFontItalicTrait);
|
|
if NewFontRef <> nil then
|
|
begin
|
|
CFRelease(FontRef);
|
|
FontRef := NewFontRef;
|
|
end;
|
|
end;
|
|
if TFontStyle.fsBold in SourceFont.Style then
|
|
begin
|
|
NewFontRef := CTFontCreateCopyWithSymbolicTraits(FontRef, 0, nil,
|
|
kCTFontBoldTrait, kCTFontBoldTrait);
|
|
if NewFontRef <> nil then
|
|
begin
|
|
CFRelease(FontRef);
|
|
FontRef := NewFontRef;
|
|
end;
|
|
end;
|
|
|
|
try
|
|
ASFont := CTFontGetPlatformFont(FontRef, nil);
|
|
Status := ATSFontGetFileReference( ASFont, oFile);
|
|
aURLRef := CFURLCreateFromFSRef(kCFAllocatorDefault, @oFile);
|
|
aURLRef := CFURLCreateFilePathURL(kCFAllocatorDefault, aURLRef, @cerr);
|
|
except
|
|
aURLRef := CFURLRef(CTFontCopyAttribute (FontRef, kCTFontURLAttribute));
|
|
Accessing := true;
|
|
{$IFDEF Delphi22}
|
|
CFURLStartAccessingSecurityScopedResource(aURLRef);
|
|
{$ELSE}
|
|
frxCFURLStartAccessingSecurityScopedResource(aURLRef);
|
|
{$ENDIF}
|
|
end;
|
|
fPath := CFURLCopyFileSystemPath(aURLRef, kCFURLPOSIXPathStyle);
|
|
StrFilePath := ConvCFString(fPath);
|
|
|
|
if StrFilePath <> '' then
|
|
begin
|
|
// just in case its not a URL to file
|
|
i := pos('localhost/', StrFilePath);
|
|
if i > 0 then
|
|
StrFilePath := Copy(StrFilePath, i + 11, Length(StrFilePath) - i - 10);
|
|
try
|
|
FontData.LoadFromFile(StrFilePath);
|
|
except
|
|
// use smth when font not found
|
|
FontData.LoadFromFile('/Library/Fonts/Arial.ttf');
|
|
end;
|
|
FontDataSize := FontData.Size;
|
|
FontData.Position := 0;
|
|
|
|
TrueTypeTables := TrueTypeCollection.Create();
|
|
try
|
|
TrueTypeTables.Initialize(FontData.Memory, FontData.Size);
|
|
except
|
|
on EInvalidTTFFormat do
|
|
begin
|
|
// Substitute
|
|
FontData.Clear;
|
|
FSubstituteName := 'Arial';
|
|
GetFontFile;
|
|
end;
|
|
end;
|
|
|
|
FCurrentFont := TrueTypeTables.GetTrueTypeFont(SourceFont);
|
|
FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
|
|
end;
|
|
if (Accessing) then
|
|
{$IFDEF Delphi22}
|
|
CFURLStopAccessingSecurityScopedResource(aURLRef);
|
|
{$ELSE}
|
|
frxCFURLStopAccessingSecurityScopedResource(aURLRef);
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF LINUX}
|
|
procedure TfrxPDFFont.GetFontFile;
|
|
var
|
|
StrFilePath: String;
|
|
Name, s: String;
|
|
i: Integer;
|
|
SkipList: TList;
|
|
begin
|
|
|
|
Name := PdfSubstituteName(FSubstituteName);
|
|
|
|
SkipList := TList.Create;
|
|
SkipList.Add(Pointer(TablesID.EmbedBitmapLocation));
|
|
SkipList.Add(Pointer(TablesID.EmbededBitmapData));
|
|
SkipList.Add(Pointer(TablesID.HorizontakDeviceMetrix));
|
|
SkipList.Add(Pointer(TablesID.VerticalDeviceMetrix));
|
|
SkipList.Add(Pointer(TablesID.DigitalSignature));
|
|
|
|
StrFilePath := frxPosixFonts.GetFontPath(SourceFont, Name, SkipList);
|
|
|
|
try
|
|
FontData.LoadFromFile(StrFilePath);
|
|
except
|
|
raise Exception.Create('Error. Cant load/find font.');
|
|
end;
|
|
FontDataSize := FontData.Size;
|
|
FontData.Position := 0;
|
|
|
|
TrueTypeTables := TrueTypeCollection.Create();
|
|
TrueTypeTables.Initialize(FontData.Memory, FontData.Size);
|
|
|
|
for i := 0 to TrueTypeTables.FontCollection.Count - 1 do
|
|
begin
|
|
FCurrentFont := TrueTypeFont(TrueTypeTables.FontCollection[i]);
|
|
if not FCurrentFont.IsLoaded then
|
|
FCurrentFont.PrepareFont( SkipList );
|
|
s := FCurrentFont.Names.Item[NameID.FullName];
|
|
if s = Name then
|
|
break;
|
|
end;
|
|
SkipList.Free;
|
|
|
|
FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
|
|
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TfrxPDFFont.RemapString(str: WideString;
|
|
rtl: Boolean): WideString;
|
|
var
|
|
maxGlyphs: Integer;
|
|
g, g_: System.PWord;
|
|
w, w_: System.PInteger;
|
|
actualLength: Integer;
|
|
i, j: Integer;
|
|
c: Word;
|
|
wc: WideChar;
|
|
begin
|
|
LastRemappedStrWidth := 0;
|
|
LastRemappedStrSpacesCount := 0;
|
|
result := '';
|
|
maxGlyphs := Length(str) * 3;
|
|
g := GetMemory(SizeOf(Word) * maxGlyphs);
|
|
w := GetMemory(SizeOf(Integer) * maxGlyphs);
|
|
tempBitmap.Canvas.BeginScene;
|
|
try
|
|
tempBitmap.Canvas.Font.Assign(SourceFont);
|
|
actualLength := GetGlyphIndices( str, g, w, rtl);
|
|
g_ := g;
|
|
w_ := w;
|
|
for i := 0 to actualLength - 1 do
|
|
begin
|
|
c := g_^;
|
|
Inc(LastRemappedStrWidth, w_^);
|
|
if actualLength = Length(str) then
|
|
begin
|
|
if rtl then
|
|
j := actualLength - i
|
|
else
|
|
j := i + 1;
|
|
if str[j] = ' ' then
|
|
Inc(LastRemappedStrSpacesCount);
|
|
end;
|
|
if UsedAlphabet.IndexOf(Pointer(c)) = -1 then
|
|
begin
|
|
UsedAlphabet.Add(Pointer(c));
|
|
Widths.Add(Pointer(w_^));
|
|
if actualLength = Length(str) then
|
|
begin
|
|
if rtl then
|
|
j := actualLength - i
|
|
else
|
|
j := i + 1;
|
|
UsedAlphabetUnicode.Add(Pointer(Word(str[j])));
|
|
end
|
|
else
|
|
UsedAlphabetUnicode.Add(Pointer(TextMetric.otmTextMetrics.tmDefaultChar));
|
|
end;
|
|
wc := WideChar(c);
|
|
result := result + wc;
|
|
Inc(g_);
|
|
Inc(w_);
|
|
end;
|
|
|
|
finally
|
|
FreeMemory(g);
|
|
FreeMemory(w);
|
|
tempBitmap.Canvas.EndScene;
|
|
end;
|
|
|
|
end;
|
|
|
|
function TfrxPDFFont.GetFontName: AnsiString;
|
|
var
|
|
s: AnsiString;
|
|
|
|
function HexEncode7F(Str: WideString): AnsiString;
|
|
var
|
|
AnStr: AnsiString;
|
|
s: AnsiString;
|
|
Index, Len: Integer;
|
|
begin
|
|
s := '';
|
|
AnStr := AnsiString(Str);
|
|
Len := Length(AnStr);
|
|
Index := 0;
|
|
while Index < Len do
|
|
begin
|
|
Index := Index + 1;
|
|
if Byte(AnStr[Index]) > $7F then
|
|
s := s + '#' + AnsiString(IntToHex(Byte(AnStr[Index]), 2))
|
|
else
|
|
s := s + AnsiString(AnStr[Index]);
|
|
end;
|
|
Result := s;
|
|
end;
|
|
|
|
begin
|
|
{$IFDEF Delphi12}
|
|
Result := AnsiString(FSubstituteName);
|
|
Result := StringReplace(Result, AnsiString(' '), AnsiString('#20'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('('), AnsiString('#28'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString(')'), AnsiString('#29'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('%'), AnsiString('#25'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('<'), AnsiString('#3C'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('>'), AnsiString('#3E'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('['), AnsiString('#5B'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString(']'), AnsiString('#5D'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('{'), AnsiString('#7B'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('}'), AnsiString('#7D'), [rfReplaceAll]);
|
|
Result := StringReplace(Result, AnsiString('/'), AnsiString('#2F'), [rfReplaceAll]);
|
|
{$ELSE}
|
|
Result := SourceFont.Name;
|
|
Result := StringReplace(Result, ' ', '#20', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '(', '#28', [rfReplaceAll]);
|
|
Result := StringReplace(Result, ')', '#29', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '%', '#25', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '<', '#3C', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '>', '#3E', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '[', '#5B', [rfReplaceAll]);
|
|
Result := StringReplace(Result, ']', '#5D', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '{', '#7B', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '}', '#7D', [rfReplaceAll]);
|
|
Result := StringReplace(Result, '/', '#2F', [rfReplaceAll]);
|
|
{$ENDIF}
|
|
if frxPDFFontsNeedStyleSimulation.IndexOf(FSubstituteName) = -1 then
|
|
begin
|
|
s := '';
|
|
if fsBold in SourceFont.Style then
|
|
s := s + 'Bold';
|
|
if fsItalic in SourceFont.Style then
|
|
s := s + 'Italic';
|
|
if s <> '' then
|
|
Result := Result + ',' + s;
|
|
end;
|
|
{$IFDEF Delphi12}
|
|
Result := HexEncode7F(String(Result));
|
|
{$ELSE}
|
|
Result := HexEncode7F(Result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TfrxPDFRun }
|
|
|
|
constructor TfrxPDFRun.Create(t: WideString; a: SCRIPT_ANALYSIS);
|
|
begin
|
|
text := t;
|
|
analysis := a;
|
|
end;
|
|
|
|
initialization
|
|
frxPDFFontsNeedStyleSimulation := TStringList.Create;
|
|
frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$30B4#$30B7#$30C3#$30AF);
|
|
frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$FF30#$30B4#$30B7#$30C3#$30AF);
|
|
frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$660E#$671D);
|
|
frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$FF30#$660E#$671D);
|
|
frxPDFFontsNeedStyleSimulation.Add('MS UI Gothic');
|
|
frxPDFFontsNeedStyleSimulation.Add('Arial Unicode MS');
|
|
// doesn't have Italic
|
|
//frxPDFFontsNeedStyleSimulation.Add('Tahoma');
|
|
|
|
finalization
|
|
frxPDFFontsNeedStyleSimulation.Free;
|
|
|
|
end.
|