[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    {
    Delphi1 & Delphi2.

    This unit is to replace QuickReport's Preview Form.

    Advantages:
      1. cursor keys can be used to move around the preview page.
      2. [page_up] and [page_down] keys used to move between pages
      3. [home] or [ctrl][page_up] to move to first page
      4. [end] or [ctrl][page_down] to move to last page

      5. automatically fills entire screen (except task bar)

    Usage:

      1. Make sure QuickRep is in the uses clause on your MainForm.
      2. Add this Preview unit to your project.
      3. Add the following procedure to your MainForm -
    	procedure TMainForm.MyPreview;
    	begin
    	   FmPreview.ShowModal;
    	end;
      4. add -
    	QRPrinter.OnPreview := MyPreview;
         to your code (or place it in FormCreate method) before calling -
    	YourReport.Quickreport1.preview;

    Angus Johnson
    ajohnson@rpi.net.au
    }

    unit Preview;  { dfm file is at end .. use XX34 to decode }

    interface

    uses
      SysUtils, Classes, Controls, Forms, Quickrep, ExtCtrls, Messages,
      StdCtrls, Buttons, WinTypes, WinProcs, Dialogs, Printers,
      IniFiles;

    type
      TFmPreview = class(TForm)
    	 Panel1: TPanel;
    	 QRPreview1: TQRPreview;
    	 Label1: TLabel;
    	 PrintDialog1: TPrintDialog;
    	 bbPrev: TBitBtn;
    	 bbNext: TBitBtn;
    	 bbZoomOut: TBitBtn;
    	 bbZoomW: TBitBtn;
    	 bbZoomIn: TBitBtn;
    	 bbPrint: TBitBtn;
        bbClose: TBitBtn;
    	 procedure FormShow(Sender: TObject);
    	 procedure bbZoomOutClick(Sender: TObject);
    	 procedure bbZoomWClick(Sender: TObject);
    	 procedure bbPrevClick(Sender: TObject);
    	 procedure bbNextClick(Sender: TObject);
    	 procedure bbPrintClick(Sender: TObject);
    	 procedure bbZoomInClick(Sender: TObject);
    	 procedure bbCloseClick(Sender: TObject);
    	 procedure FormActivate(Sender: TObject);
    	 procedure FormClose(Sender: TObject; var Action: TCloseAction);
    	 procedure FormKeyDown(Sender: TObject; var Key: Word;
    	   Shift: TShiftState);
      private
    	 procedure CMDialogKey(var message: TCMDialogKey); message CM_DIALOGKEY;
      public
      end;

    var
      FmPreview: TFmPreview;

    implementation

    uses
      Main;

    {$R *.DFM}

    procedure TFmPreview.FormShow(Sender: TObject);
    begin
    	QRPreview1.Zoom := 100; {defaults to ZoomIn}
    	Label1.caption := 'Page 1 of ' +inttostr(QRPrinter.PageCount);
    	if QRPrinter.PageCount = 1 then bbNext.enabled := false
    	else bbNext.enabled := true;
    	bbClose.setfocus;
    	bbZoomIn.enabled := false;
    	bbZoomW.enabled := true;
    	bbZoomOut.enabled := true;
    end;

    procedure TFmPreview.bbZoomOutClick(Sender: TObject);
    begin
    	QRPreview1.ZoomToFit;
    	bbZoomOut.enabled := false;
    	bbZoomW.enabled := true;
    	bbZoomIn.enabled := true;
    	bbClose.setfocus;
    end;

    procedure TFmPreview.bbZoomWClick(Sender: TObject);
    begin
    	QRPreview1.ZoomToWidth;
    	bbZoomW.enabled := false;
    	bbZoomOut.enabled := true;
    	bbZoomIn.enabled := true;
    	bbClose.setfocus;
    end;

    procedure TFmPreview.bbPrevClick(Sender: TObject);
    begin {Previous page}
      if QRPreview1.PageNumber > 1 then
             QRPreview1.PageNumber := QRPreview1.PageNumber-1;
      Label1.caption := 'Page ' + inttostr(QRPreview1.PageNumber)+
                            ' of ' +inttostr(QRPrinter.PageCount);
      bbNext.enabled := true;
      if QRPreview1.PageNumber = 1 then begin
    	 bbPrev.enabled := false;
    	 bbNext.setfocus;
      end;
    end;

    procedure TFmPreview.bbNextClick(Sender: TObject);
    begin {Next page}
      if QRPreview1.PageNumber < QRPrinter.PageCount then
    					QRPreview1.PageNumber := QRPreview1.PageNumber+1;
      Label1.caption := 'Page ' + inttostr(QRPreview1.PageNumber)+
    					' of ' +inttostr(QRPrinter.PageCount);
      bbPrev.enabled := true;
      if QRPreview1.PageNumber = QRPrinter.PageCount then begin
    	 bbNext.enabled := false;
    	 bbPrev.setfocus;
      end;
    end;

    procedure TFmPreview.bbPrintClick(Sender: TObject);
    begin
      {A PrintDialog component can be added to the form with an -
      if not PrintDialog1.execute then exit -
      statement placed here.}
      screen.cursor := crHourglass;
      try
    	 QRPrinter.Print;
    	 while tag > 1 do begin
    	   QRPrinter.Print;
    	   tag := tag-1;
    	 end;
    	 tag := 1;
      finally
    	 screen.cursor := crDefault;
      end;
      close;
    end;

    procedure TFmPreview.bbZoomInClick(Sender: TObject);
    begin
    	QRPreview1.Zoom := 100;
    	bbZoomIn.enabled := false;
    	bbZoomW.enabled := true;
    	bbZoomOut.enabled := true;
    	bbClose.setfocus;
    end;

    procedure TFmPreview.bbCloseClick(Sender: TObject);
    begin
    	close;
    end;

    procedure TFmPreview.FormActivate(Sender: TObject);
    var
      TrayHwnd: HWnd;
      Rect: TRect;
      CxFullScreen, CyFullScreen, CyCaption: integer;
    begin
      {size the form to fill the screen...}
      TrayHwnd := FindWindow('Shell_TrayWnd','');
      if TrayHwnd = 0 then {not Win95 screen}
    	 WindowState := wsMaximized
      else begin
    	 GetWindowRect(TrayHwnd,Rect);
    	 CxFullScreen    := GetSystemMetrics(SM_CXFULLSCREEN);
    	 CyFullScreen    := GetSystemMetrics(SM_CYFULLSCREEN);
    	 CyCaption       := GetSystemMetrics(SM_CYCAPTION);

    	 {NOTE: Position must equal either poDefault or poDesigned,
    	  and WindowState = wsNormal}
    	 Top      := 0;
    	 Left     := 0;
    	 Width    := CxFullScreen;
    	 Height   := CyFullScreen + CyCaption;

    	 if (Rect.Top < 0) and (Rect.Left < 0) then begin
    	   {Taskbar on either top or left}
    	   if Rect.Right > Rect.Bottom then {Taskbar on top}
    		 Top  := Rect.Bottom
    	   else {Taskbar on left}
    		 Left := Rect.Right;
    	 end;
      end;
      bbClose.left := width - 76;
      bbPrint.left := width - 144;
    end;

    procedure TFmPreview.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      QRPreview1.PageNumber := 1; {this is necessary if reopening form!!!?}
      bbPrev.enabled := false;
      QRPreview1.HorzScrollbar.Position := 0;
      QRPreview1.VertScrollbar.Position := 0;
    end;

    procedure TFmPreview.CMDialogKey(var message: TCMDialogKey);
    begin {INTERCEPTS ARROW KEYS INORDER TO MOVE AROUND PAGE}
      with message do
    	 case CharCode of
    	   VK_LEFT: begin
    		 with QRPreview1.HorzScrollbar do Position := Position -50;
    		 exit;
    		 end;
    		VK_RIGHT: begin
    		 with QRPreview1.HorzScrollbar do Position := Position +50;
    		 exit;
    		 end;
    		VK_UP: begin
    		 with QRPreview1.VertScrollbar do Position := Position -50;
    		 exit;
    		 end;
    		VK_DOWN: begin
    		 with QRPreview1.VertScrollbar do Position := Position +50;
    		 exit;
    		 end;
    	 end;
      inherited;
    end;

    procedure TFmPreview.FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    begin {INTERCEPTS [PG_UP],[PG_DN], [CTRL][PG_UP],[CTRL][PG_DN], [HOME],[END]}
      if (((Key = VK_NEXT) and (Shift = [ssCtrl])) or (Key = VK_END))
    											and bbNext.enabled then begin
    	 QRPreview1.PageNumber := QRPrinter.PageCount; {GOTO LAST PAGE}
    	 Label1.caption := 'Page ' + inttostr(QRPrinter.PageCount)+
    					  ' of ' +inttostr(QRPrinter.PageCount);
    	 bbPrev.enabled := true;
    	 bbNext.enabled := false;
    	 bbPrev.setfocus;
    	 end
      else if (((Key = VK_PRIOR) and (Shift = [ssCtrl])) or (Key = VK_HOME))
    											 and bbPrev.enabled then begin
    	 QRPreview1.PageNumber := 1; {GOTO FIRST PAGE}
    	 Label1.caption := 'Page 1' +
    					  ' of ' +inttostr(QRPrinter.PageCount);
    	 bbPrev.enabled := false;
    	 bbNext.enabled := true;
    	 bbNext.setfocus;
    	 end
      else if (Key = VK_NEXT) and bbNext.enabled then bbNextClick(Sender)
      else if (Key = VK_PRIOR) and bbPrev.enabled then bbPrevClick(Sender);
    end;

    end.
    { the following contains additional files that should be included with this
      file.  To extract, you need XX3402 available with the SWAG distribution.

      1.     Cut the text below out, and save to a file  ..  filename.xx
      2.     Use XX3402  :   xx3402 d filename.xx
      3.     The decoded file should be created in the same directory.
      4.     If the file is a archive file, use the proper archive program to
             extract the members.

    { ------------------            CUT              ----------------------}

    *XX3402-001873-240597--72--85-09701-----PREVIEW.DFM--1-OF--1
    zkc+J2NBI373JYZ3Jk+k21o5++-II2Mk0ZF4PJ-mNLNdNLQ7FapEQaJqOKJr-2lZNbE0++BI
    Pr+0++h0Pr7YNL77MqxiQkgAMaZHSLBoNKpBNKtp++d-RLFjIqBmPqlg0+R1ML-oOKxi-UpE
    QaZiR0-EQaJqOKJr12BgOKJiR2VZOKRcR+Cn+Eh1P4ZZPbFLOKFoO+Bs+Ud4Pqto9YBjP4xm
    -klXP3RdPaFjRpFZS5E9FaxiR0t6NKZbO5E0x+Z4Pqto9YtVPKI4-I3mOK3g0YNjPbEiIrFt
    P4I9++d9NLZEQaJqOKJr0EpEOLVZP5BENL77PaBc+a+6I4xnOLFdPqs51b-jIqBmNKJiEqJi
    R4Jm-ZBXMKlZN+U8Hqt-MrFdRa3oNEQAFaxmPI3XR4ZqMLFZ-oxiEqljQqI50INjQap1P4xn
    NEZDPYhZSIFjRqs50oNjQap9NLZ2PrRi-YxiIqVjRkQ6FaxmPJBcPrQ8J4JsR2VZOKRcR+6D
    ++NII43iNKk4I43iNKkl-2lZNbE0++BIPr+0++JLOKFoO+Bs+UN6NKZbO5E04UJ-P4ZbPUQ3
    MKlIPr+6J43WHr7YNL60+++4J2lVMaJg-YlVMaJgAEFANKNo+sU++pFjQ+64-JRdN5Fc+b+4
    G4JdNqVo+Uw7EKldNqthNKto-kVoMIBZPbFZQUV-RLFjIqZuNEU5Eq3kR4ZjPUM9I43bNG+l
    64xa612+++RIEaZoEbFi-a7WI57ZRUFANKNo+U21J4xk+U63JqZYR4U0EUN6NKZbO5E03UR1
    ML-oOKxi-UdEQaIaRW-EMKRZ-oJiMK7gNKE603FVMYxmN4Jm+U+5Hqt1P4ZXOkQ9Ma7EQaJq
    EqldMqg+++RIEaZoEbFi-a7WHaJsR+FANKNo+YE1J4xk+U63JqZYR4U0EUN6NKZbO5E03UR1
    ML-oOKxi-UcaHaJsR0-EMKRZ03FVMYxmN4Jm+U25Hqt1P4ZXOkQ9Ma7CNLVoEqldMqg+++RI
    EaZoEbFi0K7WKaxjPIxpR+FANKNo+zc++pFjQ+60-JRdN5Fc+YQ4G4JdNqVo+VM5Eq3kR4Zj
    PUM7KaxjPG+aHrJo03FVMYxmN4Jm+U65Hqt1P4ZXOkQCMa7OPqxhHrJoEqldMqg+++RIEaZo
    EbFi-q7WKaxjPJQ2H4JaR+B0+EBIPr+0+UJLOKFoO+77-YVZOKRcR+6K-oBVQ5FdPqs40p-V
    NqIU7ZRdN5Fc03FVMYxmN4Jm+UA5Hqt1P4ZXOkQAMa7OPqxhJoBgOKBf+++5J27dR27oPUVW
    MZdjPqp7PUFANKNo+sk-+pFjQ+60-JRdN5Fc+YQ4G4JdNqVo+VM5Eq3kR4ZjPUM6KaxjPG+a
    GKs5FKtVMalZN+U6J43WHr7YNL60-+RDPYBgOKBf-kpWMZdjPqp7PYBgOKBf+++5J27dR27o
    PURWMZ-mOKto-2lZNbE1wE21J4xk+U63JqZYR4U0EUN6NKZbO5E03UR1ML-oOKxi-UNEQaZi
    7bE6J43WHr7YNL60-ERDPYBgOKBf-klWMZ-mOKtoEqldMqg+++RIEaZoEbFi-q7WEqljQqI2
    H4JaR+Ao+UBIPr+0+UJLOKFoO+70-YVZOKRcR+6K-YBVPaBZP+Y5Eq3kR4ZjPUM47YBgPrBZ
    03FVMYxmN4Jm+UM5Hqt1P4ZXOkQAMa71P4xnNIBgOKBf0YRgSL-c9YFVR428M+2++3k-++-0
    HJk-++++++++RU+++0U++++F++++2E++++2+-+++++++n+++++++++++++++++++++++++++
    ++++++0+++0+++++U6++U++++6++U+0+U+++kA1++60+U++++Dw++Dw+++1zzk1z++++zk1z
    +Dzz++1zzzw+RrRrRrRrRrRk++++Xzzzzzzzzzzk++++VrRrRrRrRrTk++++VsW6RrRsW6Tk
    ++++VsaNVrS7aMTk++++VsaNa5WNaMTk++++VrWNaMaNa5Tk++++VrS7aNaNVrTk++++VrRs
    aNaMRrTk++++VrS7aNaNVrTk++++VrWNaMaNa5Tk++++VsaNa5WNaMTk++++VsaNVrS7aMTk
    ++++VsW6RrRsW6Tk++++VrRrRrRrRrTk++++W6W6W6W6W6Xk++++RrRrRrRrRrRk++++++++
    +++++++++++++++++++++++++++++++++++8J33GI57ZRaZZRkdFIZ-mNLNdNLQl-2lZNbE0
    ++BIPr+04UJLOKFoO+Bs+UN6NKZbO5E1aE23EKldNqs5043gEqldNKto0YNjPbEiEqxgPr65
    14BgJqZiN4xrJ4JsR+h4Pqto9YVZOKRcR+9k0INjPbEiHa3hNEM3EL7dMKk8FaxiR0tHR5Zg
    NEg+0Z-VQaJiR2NjPbE603FVMYxmN4Jm+U28I43bNItpPK7ZQU6--3djPqo0N+++13FEQaZi
    R2FdMKljNklEQaZiR2FdMKljNn22H4JaR+B5+UBIPr+05U++++++
    ***** END OF BLOCK 1 *****

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]