337 lines
8.4 KiB
ObjectPascal
337 lines
8.4 KiB
ObjectPascal
unit Unit1;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls, ShellApi, Printers,
|
|
SynCommons, SynPdf, mORMotReport;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
edt1: TEdit;
|
|
lbl1: TLabel;
|
|
Label1: TLabel;
|
|
mmo1: TMemo;
|
|
btn1: TButton;
|
|
btn2: TButton;
|
|
Button1: TButton;
|
|
procedure btn2Click(Sender: TObject);
|
|
procedure btn1Click(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure Button1Click(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
{$R vista.RES} // includes Win10 manifest - use .RES for linux cross-compilation
|
|
|
|
procedure TForm1.btn2Click(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
const
|
|
UNICODE: array[0..5] of WideChar =
|
|
(#27161,#28310,#33836,#22283,#30908,#0);
|
|
procedure TForm1.btn1Click(Sender: TObject);
|
|
var Bmp: TBitmap;
|
|
U: RawUTF8;
|
|
s: string;
|
|
i: integer;
|
|
{ R, Marg: TRect;
|
|
iz: TSize;
|
|
M: TMetaFile;}
|
|
begin
|
|
Bmp := TBitmap.Create;
|
|
try
|
|
Bmp.Width := ClientWidth;
|
|
Bmp.Height := ClientHeight;
|
|
PaintTo(Bmp.Canvas,0,0); // create some bitmap content
|
|
with TGDIPages.Create(self) do
|
|
try
|
|
// the name of the report is taken from main Window's caption
|
|
Caption := self.Caption;
|
|
//Orientation := poLandscape;
|
|
// now we add some content to the report
|
|
BeginDoc;
|
|
{
|
|
M := TMetaFile.Create;
|
|
M.LoadFromFile('emf1.emf');
|
|
Siz := PaperSize;
|
|
Marg := PageMargins;
|
|
R.Left := Marg.Left;
|
|
R.Right := Siz.cx-Marg.Right;
|
|
R.Top := Marg.Top;
|
|
R.Bottom := Siz.cy-Marg.Top;
|
|
DrawMeta(R,M);
|
|
M.Free;
|
|
}
|
|
|
|
// header and footer
|
|
Font.Name := 'Georgia';
|
|
//Font.Name := 'Arial Unicode MS';
|
|
Font.Size := 11;
|
|
SaveLayout;
|
|
Font.Style := [fsItalic,fsUnderline];
|
|
TextAlign := taRight;
|
|
AddTextToHeaderAt('http://synopse.info',RightMarginPos);
|
|
Font.Style := [];
|
|
AddLineToFooter(false);
|
|
AddPagesToFooterAt(sPageN,RightMarginPos);
|
|
RestoreSavedLayout;
|
|
AddTextToHeader(ExeVersion.ProgramName);
|
|
AddTextToFooter(DateTimeToStr(Now));
|
|
AddLineToHeader(false);
|
|
Font.Size := 12;
|
|
ExportPDFForceJPEGCompression := 0;
|
|
|
|
{ // test
|
|
WordWrapLeftCols := true;
|
|
AddColumns([10,22,22,22,22]);
|
|
AddColumnHeaders(['#','Two','Three','4','5'],true,true);
|
|
for i := 1 to 50 do
|
|
DrawTextAcrossCols([IntToStr(i),'Column '+IntToStr(i),
|
|
'This is some big text which must be justified on multiple lines. Text "four" and "five" will be invisible in pdf...',
|
|
'four','five']);
|
|
EndDoc;
|
|
ExportPDF('cells.pdf',True,True);}
|
|
|
|
// main content (automaticaly split on next pages)
|
|
NewHalfLine;
|
|
TextAlign := taJustified;
|
|
U := RawUnicodeToUtf8(UNICODE,StrLenW(UNICODE));
|
|
U := 'This is some big '+U+' text which must be justified on multiple lines. ';
|
|
U := U+U+U+U;
|
|
DrawTextU(U);
|
|
NewLine;
|
|
TextAlign := taLeft;
|
|
DrawTitle(edt1.Text,true);
|
|
for i := 1 to 10 do
|
|
DrawText('This is some text '+IntToStr(i));
|
|
NewLine;
|
|
DrawBMP(Bmp,maxInt,50,'Some bitmap in the report');
|
|
AddBookMark('bookmarkname');
|
|
WordWrapLeftCols := true;
|
|
AddColumns([10,20,50]);
|
|
AddColumnHeaders(['#','Two','Three'],true,true);
|
|
for i := 1 to 100 do
|
|
DrawTextAcrossCols([IntToStr(i),'Column '+IntToStr(i),'Some text here. '+s]);
|
|
NewLine;
|
|
DrawBMP(Bmp,maxInt,50,'Some bitmap in the report (twice)');
|
|
DrawTitle('This is your text',false,0,'','bookmarkname');
|
|
DrawText(mmo1.Text);
|
|
|
|
EndDoc;
|
|
ForceInternalAntiAliasedFontFallBack := true;
|
|
ForceNoAntiAliased := true;
|
|
//ForceInternalAntiAliased := false;
|
|
ExportPDFAuthor := 'A.Bouchez';
|
|
ExportPDFSubject := 'This is some sample file';
|
|
// set optional PDF export options
|
|
// ExportPDFForceJPEGCompression := 80;
|
|
// ExportPDFEmbeddedTTF := true;
|
|
// ExportPDFUseUniscribe := true;
|
|
// ExportPDFA1 := true;
|
|
//ExportPDF('test.pdf',true,true); close; exit;
|
|
// show a preview form, and allow basic actions via corresponding buttons
|
|
// ForceInternalAntiAliased := true;
|
|
// ForceInternalAntiAliasedFontFallBack := true;
|
|
ShowPreviewForm;
|
|
|
|
finally
|
|
Free;
|
|
end;
|
|
finally
|
|
Bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TForm1.FormShow(Sender: TObject);
|
|
var FN: TFileName;
|
|
M: TMetaFile;
|
|
i: integer;
|
|
begin
|
|
exit;
|
|
//btn1Click(nil); Close; exit;
|
|
//Button1Click(nil); Close; exit;
|
|
with TPdfDocument.Create do
|
|
try
|
|
for i := 0 to 24 do begin
|
|
AddPage;
|
|
M := TMetaFile.Create;
|
|
M.LoadFromFile(IntToStr(i)+'.emf');
|
|
Canvas.RenderMetaFile(M,Canvas.Page.PageHeight/M.Height*1.3);
|
|
M.Free;
|
|
end;
|
|
{ AddPage;
|
|
with Canvas do
|
|
begin
|
|
SetFont('Arial',12,[fsBold]);
|
|
TextOut(100,500,'Test');
|
|
MoveTo(100,400);
|
|
LineTo(500,500);
|
|
Stroke;
|
|
end; }
|
|
FN := ChangeFileExt(ExeVersion.ProgramFileName,'.pdf');
|
|
SaveToFile(FN);
|
|
ShellExecute(Handle,nil,pointer(FN),nil,nil,SW_SHOWNORMAL);
|
|
finally
|
|
Free;
|
|
end;
|
|
Close;
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
var
|
|
i, y: integer;
|
|
TestImage: TBitmap;
|
|
Stream: TStream;
|
|
MF: TMetaFile;
|
|
R: TRect;
|
|
begin
|
|
if false then
|
|
with TGDIPages.Create(self) do
|
|
try
|
|
BeginDoc;
|
|
MF := TMetafile.Create;
|
|
MF.LoadFromFile('d:\download\Sample (1).emf');
|
|
DrawGraphic(MF,0,PaperSize.cx-20);
|
|
{ for y := 0 to 4 do
|
|
begin
|
|
|
|
DrawTitle(edt1.Text, true);
|
|
for i := 1 to 10 do
|
|
DrawText('This is some text ' + IntToStr(i));
|
|
NewLine;
|
|
|
|
TestImage := TBitmap.Create;
|
|
try
|
|
TestImage.Width := 500;
|
|
TestImage.Height := 500;
|
|
|
|
TestImage.Canvas.Pen.Color := clRed;
|
|
TestImage.Canvas.MoveTo(0, y * 80);
|
|
TestImage.Canvas.LineTo(TestImage.Width, y * 80);
|
|
|
|
DrawBMP(TestImage, maxInt, RightMarginPos);
|
|
finally
|
|
TestImage.Free;
|
|
end;
|
|
|
|
NewPage;
|
|
end;}
|
|
|
|
EndDoc;
|
|
ForceInternalAntiAliased := true;
|
|
ForceInternalAntiAliasedFontFallBack := true;
|
|
ExportPDFGeneratePDF15File := true;
|
|
ExportPDFUseUniscribe := true;
|
|
ShowPreviewForm;
|
|
//ExportPDF('test.pdf', true, true);
|
|
finally
|
|
Free;
|
|
end
|
|
else
|
|
if false then
|
|
with TPdfDocumentGDI.Create do
|
|
try
|
|
Stream := TFileStream.Create(ExeVersion.ProgramFilePath + 'streamdirect.pdf', fmCreate);
|
|
try
|
|
SaveToStreamDirectBegin(Stream);
|
|
for i := 1 to 9 do
|
|
begin
|
|
AddPage;
|
|
with VCLCanvas do
|
|
begin
|
|
Font.Name := 'Times new roman';
|
|
Font.Size := 120;
|
|
Font.Style := [fsBold, fsItalic];
|
|
Font.Color := clNavy;
|
|
TextOut(100, 100, 'Page ' + IntToStr(i));
|
|
end;
|
|
SaveToStreamDirectPageFlush; // direct writing
|
|
end;
|
|
SaveToStreamDirectEnd;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
finally
|
|
Free;
|
|
end
|
|
else
|
|
with TPdfDocumentGDI.Create do
|
|
try
|
|
for i := 1 to 9 do
|
|
begin
|
|
AddPage;
|
|
with VCLCanvas do
|
|
begin
|
|
Font.Name := 'Times new roman';
|
|
Font.Size := 120;
|
|
Font.Style := [fsBold, fsItalic];
|
|
Font.Color := clNavy;
|
|
TextOut(100, 100, 'Page ' + IntToStr(i));
|
|
end;
|
|
end;
|
|
SaveToFile(ExeVersion.ProgramFilePath + 'multipages.pdf');
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{
|
|
var
|
|
xRect: TRect;
|
|
const
|
|
Text: WideString = 'RERERERE:';
|
|
begin
|
|
with TPdfDocumentGDI.Create do
|
|
try
|
|
PDFA1 := true;
|
|
AddPage;
|
|
UseUniScribe := false; //uniscribe does not change anything about the problem
|
|
with VCLCanvas do begin
|
|
Font.Name := 'Tahoma';
|
|
Font.Size := 8;
|
|
Font.Style := [fsBold];
|
|
Pen.Color := $AAAAAA;
|
|
|
|
xRect := Rect(0, 0, TextWidth(Text), TextHeight(Text));
|
|
OffsetRect(xRect, 100, 100);
|
|
|
|
Rectangle(xRect);
|
|
|
|
Windows.ExtTextOutW(Handle, xRect.Left, xRect.Top, ETO_CLIPPED,
|
|
@xRect, PWideChar(Text), Length(Text), nil);
|
|
|
|
Font.Size := 24;
|
|
|
|
xRect := Rect(0, 0, TextWidth(Text), TextHeight(Text));
|
|
OffsetRect(xRect, 100, 200);
|
|
|
|
Rectangle(xRect);
|
|
|
|
Windows.ExtTextOutW(Handle, xRect.Left, xRect.Top, ETO_CLIPPED,
|
|
@xRect, PWideChar(Text), Length(Text), nil);
|
|
|
|
end;
|
|
SaveToFile('TestVcl.pdf');
|
|
ShellExecute(Handle,nil,'TestVcl.pdf',nil,nil,SW_SHOWNORMAL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
}
|
|
|
|
end.
|
|
|