FastReport_2022_VCL/LibD28x64/frxExportPDF_old.pas
2024-01-01 16:13:08 +01:00

482 lines
14 KiB
ObjectPascal

{******************************************}
{ }
{ FastReport VCL }
{ PDF export filter }
{ }
{ Copyright (c) 1998-2021 }
{ by Fast Reports Inc. }
{ }
{******************************************}
unit frxExportPDF;
interface
{$I frx.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComObj, Printers, frxClass, JPEG, ShellAPI,
ComCtrls, frxPDFFile
{$IFDEF Delphi6}, Variants {$ENDIF};
type
TfrxPDFExportDialog = class(TForm)
PageControl1: TPageControl;
ExportPage: TTabSheet;
InfoPage: TTabSheet;
SecurityPage: TTabSheet;
ViewerPage: TTabSheet;
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;
Shift: TShiftState);
end;
TfrxPDFExport = class(TfrxCustomExportFilter)
private
FCompressed: Boolean;
FEmbedded: Boolean;
FOpenAfterExport: Boolean;
FPDF: TfrxPDFFile;
FPDFpage: TfrxPDFPage;
FPrintOpt: Boolean;
FOutline: Boolean;
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;
public
constructor Create(AOwner: TComponent); 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;
published
property Compressed: Boolean read FCompressed write FCompressed default True;
property EmbeddedFonts: Boolean read FEmbedded write FEmbedded default False;
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 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 FProtectionFlags;
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;
implementation
uses frxUtils, frxUnicodeUtils, frxFileUtils, frxRes, frxrcExports;
{$R *.dfm}
{ TfrxPDFExport }
constructor TfrxPDFExport.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCompressed := 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;
end;
class function TfrxPDFExport.GetDescription: String;
begin
Result := frxResources.Get('PDFexport');
end;
function TfrxPDFExport.ShowModal: TModalResult;
var
s: String;
begin
if FTitle = '' 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 + [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.Checked := FOpenAfterExport;
CompressedCB.Checked := FCompressed;
EmbeddedCB.Checked := FEmbedded;
PrintOptCB.Checked := FPrintOpt;
OutlineCB.Checked := FOutline;
OutlineCB.Enabled := FOutline;
BackgrCB.Checked := FBackground;
if PageNumbers <> '' then
begin
PageNumbersE.Text := PageNumbers;
PageNumbersRB.Checked := True;
end;
OwnPassE.Text := String(FOwnerPassword);
UserPassE.Text := String(FUserPassword);
PrintCB.Checked := ePrint in FProtectionFlags;
CopyCB.Checked := eCopy in FProtectionFlags;
ModCB.Checked := eModify in FProtectionFlags;
AnnotCB.Checked := eAnnot in FProtectionFlags;
TitleE.Text := FTitle;
AuthorE.Text := FAuthor;
SubjectE.Text := FSubject;
KeywordsE.Text := FKeywords;
CreatorE.Text := FCreator;
ProducerE.Text := FProducer;
PrintScalingCB.Checked := FPrintScaling;
FitWindowCB.Checked := FFitWindow;
HideMenubarCB.Checked := FHideMenubar;
CenterWindowCB.Checked := FCenterWindow;
HideWindowUICB.Checked := FHideWindowUI;
HideToolbarCB.Checked := FHideToolbar;
Result := ShowModal;
if Result = mrOk then
begin
FOwnerPassword := AnsiString(OwnPassE.Text);
FUserPassword := AnsiString(UserPassE.Text);
FProtectionFlags := [];
if PrintCB.Checked then
FProtectionFlags := FProtectionFlags + [ePrint];
if CopyCB.Checked then
FProtectionFlags := FProtectionFlags + [eCopy];
if ModCB.Checked then
FProtectionFlags := FProtectionFlags + [eModify];
if AnnotCB.Checked then
FProtectionFlags := FProtectionFlags + [eAnnot];
PageNumbers := '';
CurPage := False;
if CurPageRB.Checked then
CurPage := True
else if PageNumbersRB.Checked then
PageNumbers := PageNumbersE.Text;
FOpenAfterExport := OpenCB.Checked;
FCompressed := CompressedCB.Checked;
FEmbedded := EmbeddedCB.Checked;
FPrintOpt := PrintOptCB.Checked;
FOutline := OutlineCB.Checked;
FBackground := BackgrCB.Checked;
FTitle := TitleE.Text;
FAuthor := AuthorE.Text;
FSubject := SubjectE.Text;
FKeywords := KeywordsE.Text;
FCreator := CreatorE.Text;
FProducer := ProducerE.Text;
FPrintScaling := PrintScalingCB.Checked;
FFitWindow := FitWindowCB.Checked;
FHideMenubar := HideMenubarCB.Checked;
FCenterWindow := CenterWindowCB.Checked;
FHideWindowUI := HideWindowUICB.Checked;
FHideToolbar := HideToolbarCB.Checked;
if not SlaveExport then
begin
if DefaultPath <> '' then
SaveDialog1.InitialDir := DefaultPath;
if SaveDialog1.Execute then
FileName := SaveDialog1.FileName
else
Result := mrCancel;
end;
end;
Free;
end;
end else
Result := mrOk;
end;
function TfrxPDFExport.Start: Boolean;
var
f: 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 + '\' + FileName;
f := Report.PreviewPages.Count > 200;
FPDF := TfrxPDFFile.Create(UseFileCache and f, Report.EngineOptions.TempDir);
FPDF.Compressed := FCompressed;
FPDF.EmbeddedFonts := FEmbedded;
FPDF.PrintOptimized := FPrintOpt;
FPDF.Outline := FOutline;
FPDF.Background := FBackground;
FPDF.Author := FAuthor;
FPDF.Subject := FSubject;
FPDF.Creator := FCreator;
FPDF.Producer := FProducer;
FPDF.Keywords := FKeywords;
FPDF.PrintScaling := FPrintScaling;
FPDF.FitWindow := FFitWindow;
FPDF.HideMenubar := FHideMenubar;
FPDF.CenterWindow := FCenterWindow;
FPDF.HideWindowUI := FHideWindowUI;
FPDF.HideToolbar := FHideToolbar;
FPDF.HTMLTags := FTags;
FPDF.PageNumbers := PageNumbers;
FPDF.TotalPages := Report.PreviewPages.Count;
if FOutline then
FPDF.PreviewOutline := Report.PreviewPages.Outline;
FPDF.Protection := (FOwnerPassword <> '') or (FUserPassword <> '');
FPDF.OwnerPassword := FOwnerPassword;
FPDF.UserPassword := FUserPassword;
FPDF.ProtectionFlags := FProtectionFlags;
FPDF.Start;
Result := True
end else
Result := False;
end;
procedure TfrxPDFExport.StartPage(Page: TfrxReportPage; Index: Integer);
begin
FPDFPage := FPDF.AddPage(Page);
end;
procedure TfrxPDFExport.ExportObject(Obj: TfrxComponent);
begin
if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
FPDFPage.AddObject(TfrxView(Obj));
end;
procedure TfrxPDFExport.Finish;
var
Exp: TStream;
begin
try
try
if Assigned(Stream) then
Exp := Stream
else
Exp := TFileStream.Create(FileName, fmCreate);
try
FPDF.Title := FTitle;
FPDF.SaveToStream(Exp);
finally
if not Assigned(Stream) then
Exp.Free;
if FOpenAfterExport and (not Assigned(Stream)) then
ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOW);
end;
except
on e: Exception do
case Report.EngineOptions.NewSilentMode of
simSilent: Report.Errors.Add(e.Message);
simMessageBoxes: frxErrorMsg(e.Message);
simReThrow: raise;
end;
end;
finally
FPDF.Free;
end;
end;
{ TfrxPDFExportDialog }
procedure TfrxPDFExportDialog.FormCreate(Sender: TObject);
begin
Caption := frxGet(8700);
OkB.Caption := frxGet(1);
CancelB.Caption := frxGet(2);
GroupPageRange.Caption := frxGet(7);
AllRB.Caption := frxGet(3);
CurPageRB.Caption := frxGet(4);
PageNumbersRB.Caption := frxGet(5);
DescrL.Caption := frxGet(9);
GroupQuality.Caption := frxGet(8);
CompressedCB.Caption := frxGet(8701);
EmbeddedCB.Caption := frxGet(8702);
PrintOptCB.Caption := frxGet(8703);
OutlineCB.Caption := frxGet(8704);
BackgrCB.Caption := frxGet(8705);
OpenCB.Caption := frxGet(8706);
SaveDialog1.Filter := frxGet(8707);
SaveDialog1.DefaultExt := frxGet(8708);
ExportPage.Caption := frxGet(107);
DocInfoGB.Caption := frxGet(8971);
InfoPage.Caption := frxGet(8972);
TitleL.Caption := frxGet(8973);
AuthorL.Caption := frxGet(8974);
SubjectL.Caption := frxGet(8975);
KeywordsL.Caption := frxGet(8976);
CreatorL.Caption := frxGet(8977);
ProducerL.Caption := frxGet(8978);
SecurityPage.Caption := frxGet(8962);
SecGB.Caption := frxGet(8979);
PermGB.Caption := frxGet(8980);
OwnPassL.Caption := frxGet(8964);
UserPassL.Caption := frxGet(8965);
PrintCB.Caption := frxGet(8966);
ModCB.Caption := frxGet(8967);
CopyCB.Caption := frxGet(8968);
AnnotCB.Caption := frxGet(8969);
ViewerPage.Caption := frxGet(8981);
ViewerGB.Caption := frxGet(8982);
HideToolbarCB.Caption := frxGet(8983);
HideMenubarCB.Caption := frxGet(8984);
HideWindowUICB.Caption := frxGet(8985);
FitWindowCB.Caption := frxGet(8986);
CenterWindowCB.Caption := frxGet(8987);
PrintScalingCB.Caption := frxGet(8988);
if UseRightToLeftAlignment then
FlipChildren(True);
end;
procedure TfrxPDFExportDialog.PageNumbersEChange(Sender: TObject);
begin
PageNumbersRB.Checked := 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;
Shift: TShiftState);
begin
if Key = VK_F1 then
frxResources.Help(Self);
end;
end.