Mega Code Archive
Printing and Previewing Using Delphi 4 and TQRPrinter
<![CDATA[
Title: Printing and Previewing Using Delphi 4 and TQRPrinter
Question: It's possible to create linear reports using the TPrinter class. However, using the TQRPrinter class instead, we can make the same work and much more. We can also make previewing using the same QuickReport preview feature.
Answer:
Here's a Delphi 4 project which show how to do this.
{ === FQRPrinter.Dfm === }
object Form1: TForm1
Left = 209
Top = 107
Width = 268
Height = 94
Caption = 'Printing With TQRPrinter'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Icon.Data = {
0000010001002020100000000000E80200001600000028000000200000004000
0000010004000000000000020000000000000000000000000000000000000000
0000000080000080000000808000800000008000800080800000C0C0C0008080
80000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000788000000000000000000000
0000007778888000000000000000000000007777800888800000000000000000
0077778878800888800000000000000077778878788880088880000000000077
7788777878888880088880000000087788777778788888888008888000000888
7777777878888888888008800000887877777778788888888888800000008F78
77777778F88888888888888000008F78777777F8877888888888888800008F78
7777FF77788778888888888808008F7877FF7777777887788888888807808F78
FF777997788778877888888807888FF8877AA7788777770887788888080088F7
78877887777700F70887788800000088F77888877700FFFF0778877800000000
88F7788800FFFCCF70877880000000000088F7788FFCCFFFF088800000000000
000088F778FFFFCCF70000000000000000000088F8FFCCFFFF70000000000000
00000000888FFFFCCFF700000000000000000000008FFCCFFFFF700000000000
000000000008FFFFFCCFF700000000000000000000008FFCCFFFFF8800000000
00000000000008FFFFFF880000000000000000000000008FFF88000000000000
000000000000000888000000000000000000000000000000000000000000FFFF
FFFFFFFFFFFFFFF1FFFFFFC07FFFFF001FFFFC0007FFF00001FFC000007F8000
001F8000000F8000000F0000000F000000070000000300000001000000000000
00000000000300000007C0000007F000001FFC00007FFF0001FFFFC000FFFFF0
007FFFFC003FFFFE000FFFFF000FFFFF803FFFFFC0FFFFFFE3FFFFFFFFFF}
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 92
Top = 21
Width = 75
Height = 25
Caption = '&Preview'
TabOrder = 0
OnClick = Button1Click
end
end
{ === FQRPrinter.Pas === }
unit FQRPrinter;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure OnClosePreview(Sender: TObject; var Action: TCloseAction);
procedure PreviewReport(Sender: TObject);
end;
var
Form1: TForm1;
implementation
uses Printers, QRPrntr, QRPrev;
{$R *.DFM}
{$R Quickrpt.res}
procedure TForm1.OnClosePreview(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TForm1.PreviewReport(Sender: TObject);
begin
{ Personalize the button's hints here }
with TQRStandardPreview.Create(Self) do
begin
ZoomFit.Hint := '';
Zoom100.Hint := '';
ZoomToWidth.Hint := '';
FirstPage.Hint := '';
PreviousPage.Hint := '';
ToolButton2.Hint := '';
LastPage.Hint := '';
PrintSetup.Hint := '';
Print.Hint := '';
SaveReport.Hint := '';
LoadReport.Hint := '';
ExitButton.Caption := '';
OnClose := OnClosePreview;
QRPreview.QRPrinter := TQRPrinter(Sender);
Caption := 'Print Preview - ' + TQRPrinter(Sender).Title;
WindowState := wsMaximized;
Show;
end;
end;
Procedure PreparePage(Var Rep: TQrPrinter);
Begin
With Rep do
Begin
NewPage;
Canvas.Font.Name := 'Draft 10cpi';//'Arial';
Canvas.Font.Size := 10;
Canvas.Font.color := clBlack;
Canvas.Font.Style := [fsBold];
Canvas.TextOut(
XPos(PaperWidth - 200), YPos(100), 'Page ' + IntToStr(PageNumber));
End;
End;
procedure TForm1.Button1Click(Sender: TObject);
var
Rep: TQRPrinter;
x: Integer;
NextLine: Integer;
TopMarginPage: Integer;
BottomMarginPage: Integer;
LeftMargin: Integer;
EndOfPage: Integer;
Spacement: Integer;
begin
Rep := TQRPrinter.Create;
with Rep do
try
OnPreview := PreviewReport;
TopMarginPage := 100;
BottomParginPage := 100;
LeftMargin := 100;
PaperSize := A4;
Orientation := poPortrait;
Copies := 1;
Title := 'Sample Report';
Application.ProcessMessages;
Preview;
BeginDoc;
PreparePage(Rep);
EndOfPage := YSize(PaperLength - BottomMarginPage);
NextLine := YPos(TopMarginPage);
Spacement := Canvas.TextHeight('X');
for x := 1 to 200 do
begin
Canvas.TextOut(XPos(MargemEsquerda), ProximaLinha,
'Printing Test - Line ' + IntToStr(x));
Inc(NextLine, Spacement);
if NextLine = EndOfPage - Spacement Then
begin
PreparePage(Rep);
NextLine := YPos(TopMarginPage);
end;
end;
EndDoc;
repeat
Application.ProcessMessages
until not ShowingPreview;
finally
Free;
Application.ProcessMessages;
end;
end;
end.
{ === RelQRPrinter.Dpr === }
program RelQRPrinter;
uses
Forms,
FQRPrinter in 'FQRPrinter.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
]]>