DFM文件就不贴了,要启动DELPHI太麻烦。^_^
主要是要加一个TQRPreview控件
// preview.pas
unit Preview;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, quickrpt, Qrctrls, ToolWin, ComCtrls, qrprntr, Menus, ImgList;
type
TPreviewDlg = class(TForm)
RepToolBar: TToolBar;
tbSeparator1: TToolButton;
tbFit: TToolButton;
tb100: TToolButton;
tbWidth: TToolButton;
tbSeparator2: TToolButton;
tbFirst: TToolButton;
tbPrev: TToolButton;
tbNext: TToolButton;
tbLast: TToolButton;
tbSeparator3: TToolButton;
tbSetup: TToolButton;
tbPrint: TToolButton;
tbSeparator4: TToolButton;
tbExit: TToolButton;
PrevStatus: TStatusBar;
QRPreview: TQRPreview;
imgTools: TImageList;
PreviewMenu: TMainMenu;
mnuRate: TMenuItem;
mnuFit: TMenuItem;
mnu100: TMenuItem;
mnuWidth: TMenuItem;
mnuPage: TMenuItem;
mnuFirst: TMenuItem;
mnuPrev: TMenuItem;
mnuNext: TMenuItem;
mnuLast: TMenuItem;
mnuPrint: TMenuItem;
mnuSetup: TMenuItem;
mnuPrintOut: TMenuItem;
mnuExit: TMenuItem;
mnuPrintCurrent: TMenuItem;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure mnuFitClick(Sender: TObject);
procedure mnu100Click(Sender: TObject);
procedure mnuWidthClick(Sender: TObject);
procedure mnuFirstClick(Sender: TObject);
procedure mnuPrevClick(Sender: TObject);
procedure mnuNextClick(Sender: TObject);
procedure mnuLastClick(Sender: TObject);
procedure mnuSetupClick(Sender: TObject);
procedure mnuPrintOutClick(Sender: TObject);
procedure mnuExitClick(Sender: TObject);
procedure QRPreviewPageAvailable(Sender: TObject;
PageNum: Integer);
procedure mnuPrintCurrentClick(Sender: TObject);
private
{ Private declarations }
PageCount : Integer;
public
{ Public declarations }
end;
var
PreviewDlg: TPreviewDlg;
implementation
{$R *.DFM}
procedure TPreviewDlg.FormShow(Sender: TObject);
begin
PageCount := 1;
PrevStatus.SimpleText := '第 1 页, 共 '
+ IntToStr( PageCount ) + ' 页';
mnuWidth.Click
end;
procedure TPreviewDlg.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
QRPreview.QRPrinter := Nil;
end;
procedure TPreviewDlg.mnuFitClick(Sender: TObject);
begin
QRPreview.ZoomToFit;
mnuFit.Checked := true;
mnu100.Checked := false;
mnuWidth.Checked := false;
tbFit.Down := true;
tb100.Down := false;
tbWidth.Down := false;
end;
procedure TPreviewDlg.mnu100Click(Sender: TObject);
begin
QRPreview.Zoom := 100;
mnu100.Checked := true;
mnuFit.Checked := false;
mnuWidth.Checked := false;
tb100.Down := true;
tbFit.Down := false;
tbWidth.Down :=false;
end;
procedure TPreviewDlg.mnuWidthClick(Sender: TObject);
begin
QRPreview.ZoomToWidth;
mnuWidth.Checked := true;
mnu100.Checked := false;
mnuFit.Checked := false;
tbWidth.Down := true;
tbFit.Down := false;
tb100.Down := false;
end;
procedure TPreviewDlg.mnuFirstClick(Sender: TObject);
begin
With QRPreviewdo
begin
PageNumber := 1;
PrevStatus.SimpleText := '第 1 页, 共 '
+ IntToStr( PageCount ) + ' 页';
end;
end;
procedure TPreviewDlg.mnuPrevClick(Sender: TObject);
begin
With QRPreviewdo
begin
If ( PageNumber > 1 ) then
begin
PageNumber := PageNumber - 1;
PrevStatus.SimpleText := '第 ' + IntToStr( PageNumber )
+ ' 页, 共 ' + IntToStr( PageCount )
+ ' 页';
end;
end;
end;
procedure TPreviewDlg.mnuNextClick(Sender: TObject);
begin
With QRPreviewdo
begin
If ( PageNumber < PageCount ) then
begin
PageNumber := PageNumber + 1;
PrevStatus.SimpleText := '第 ' + IntToStr( PageNumber )
+ ' 页, 共 ' + IntToStr( PageCount )
+ ' 页';
end;
end;
end;
procedure TPreviewDlg.mnuLastClick(Sender: TObject);
begin
With QRPreviewdo
begin
PageNumber := PageCount;
PrevStatus.SimpleText := '第 ' + IntToStr( PageNumber )
+ ' 页, 共 ' + IntToStr( PageCount ) + ' 页';
end;
end;
procedure TPreviewDlg.mnuSetupClick(Sender: TObject);
begin
QRPreview.QRPrinter.PrintSetup;
end;
procedure TPreviewDlg.mnuPrintOutClick(Sender: TObject);
begin
With QRPreviewdo
begin
QRPrinter.FirstPage := 0;
QRPrinter.LastPage := 0;
QRPrinter.Print;
end;
end;
procedure TPreviewDlg.mnuPrintCurrentClick(Sender: TObject);
begin
With QRPreviewdo
begin
QRPrinter.FirstPage := PageNumber;
QRPrinter.LastPage := PageNumber;
QRPrinter.Print;
end;
end;
procedure TPreviewDlg.mnuExitClick(Sender: TObject);
begin
Close;
end;
procedure TPreviewDlg.QRPreviewPageAvailable(Sender: TObject;
PageNum: Integer);
begin
QRPreview.PageNumber := 1;
PageCount := PageNum;
PrevStatus.SimpleText := '第 1 页, 共 '
+ IntToStr( PageCount ) + ' 页';
end;
end.