previewunit.pas

一个报表控件TRepoEdit

unit PreviewUnit;

{*********************************************}
{*   Preview Form of QuickReport by BV       *}
{*   for Delphi 4                            *}
{*   (R) Copyright                           *}
{*   Borzov Vladimir [e-mail]           *}
{*********************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, QRPrntr, QR3const, ComCtrls, ToolWin, Menus,qrprnsu,
  ImgList,printers;

const RegParamName='PreviewStyle';
      RegSectionName='Preview';

var PreviewFormStyle:TFormStyle;

type
  TRepoEditPreview = class(TForm)
    QRPreview: TQRPreview;
    StatusBar: TStatusBar;
    ToolBar1: TToolBar;
    ZoomFit: TToolButton;
    Zoom100: TToolButton;
    ZoomToWidth: TToolButton;
    Separator1: TToolButton;
    FirstPage: TToolButton;
    PreviousPage: TToolButton;
    ToolButton2: TToolButton;
    LastPage: TToolButton;
    Separator2: TToolButton;
    BtnPrintSetup: TToolButton;
    BtnPrint: TToolButton;
    Separator3: TToolButton;
    SaveReport: TToolButton;
    LoadReport: TToolButton;
    Separator4: TToolButton;
    Images: TImageList;
    ExitButton: TSpeedButton;
    CheckZoom: TComboBox;
    ToolButton3: TToolButton;
    ToolButton1: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ZoomToFitClick(Sender: TObject);
    procedure ZoomTo100Click(Sender: TObject);
    procedure ZoomToWidthClick(Sender: TObject);
    procedure FirstPageClick(Sender: TObject);
    procedure PrevPageClick(Sender: TObject);
    procedure NextPageClick(Sender: TObject);
    procedure LastPageClick(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure ExitClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure SaveClick(Sender: TObject);
    procedure LoadClick(Sender: TObject);
    procedure QRPreviewPageAvailable(Sender: TObject; PageNum: Integer);
    procedure QRPreviewProgressUpdate(Sender: TObject; Progress: Integer);
    procedure FormCreate(Sender: TObject);
    procedure CheckZoomChange(Sender: TObject);
    procedure QRPreviewResize(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure BtnPrintSetupClick(Sender: TObject);
  private
    FQRPrinter : TQRPrinter;
    Gauge : TProgressBar;
    LastProgress : integer;
    AppWindowState:TwindowState;
//    function GetQrPrinter:TQrPrinter;
//    procedure SetQrPRINTER(Value:TQrPrinter);
  protected
//    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor CreatePreview(AOwner : TComponent; aQRPrinter : TQRPrinter); virtual;
    procedure Show;
    procedure UpdateInfo;
    function MyPrinterSetup:boolean;
//    property QRPrinter : TQRPrinter read GetQRPrinter write SetQRPrinter;
    property QRPrinter : TQRPrinter read FQRPrinter write FQRPrinter;
  end;

const sqrPage='Page. ';
      sqrOf=' of ';
      SqrLoadReport='Load report from:';
      SqrFileNotExist='File not found!';


type
TbvPreviewInterface = class(TQRPreviewInterface)
public
  function Show(AQRPrinter : TQRPrinter) : TWinControl; override;
//   if you not have d4cupd1.exe,d4cupd2.exe and d4cupd3.exe - delphi update files, then comment top line and uncomment bottom line
//    procedure Show(AQRPrinter : TQRPrinter); override;
end;


implementation


{$R *.DFM}

uses MessUnit;



constructor TRepoEditPreview.CreatePreview(AOwner : TComponent; aQRPrinter : TQRPrinter);
begin
  inherited Create(AOwner);
  QRPrinter := aQRPrinter;
  QRPreview.QRPrinter := aQRPrinter;
      Caption:='Print Preview: ';
  if (QRPrinter <> nil) then begin
    if (QRPrinter.Title <> '') then Caption := Caption+QRPrinter.Title;

  end;
  Gauge := TProgressBar.Create(Self);
  Gauge.Parent := self.StatusBar;//
  Gauge.Height := statusbar.height-2; //-4;//
  gauge.Smooth:=true;
  Gauge.Top := 2;
  Gauge.Left := 0;
  Gauge.Width := statusbar.panels[0].width; //-2;
  LastProgress := 0;
  ZoomToWidth.Down := true;
  WindowState := wsMaximized;
end;

procedure TRepoEditPreview.FormClose(Sender: TObject;
  var Action: TCloseAction);
var i:integer;
begin
//  application.processmessages;
  if FormStyle=fsMDIChild then
  try
    if AppWindowState=wsNormal then WindowState:=wsMinimized;
  except
  end;
  try
     if Assigned(qrPrinter) then QRPrinter.ClosePreview(Self);
  except
    on e:exception do
      bvMessError('Error when closing a preview'+#13+#13+
          'Message: '+e.message);
  end;
  Action:=caFree;   //???????
end;

procedure TRepoEditPreview.UpdateInfo;
begin
  StatusBar.Panels[2].Text := SqrPage + ' ' + IntToStr(QRPreview.PageNumber) + ' ' +
    SqrOf + ' ' + IntToStr(QRPreview.QRPrinter.PageCount);
  BtnPrint.Enabled:=qrPrinter.Status=mpFinished;
end;

procedure TRepoEditPreview.ZoomToFitClick(Sender: TObject);
begin
  Application.ProcessMessages;
  QRPreview.ZoomToFit;
//  CheckZoom.text:=inttostr(qrpreview.Zoom);
end;

procedure TRepoEditPreview.ZoomTo100Click(Sender: TObject);
begin
  Application.ProcessMessages;
  QRPreview.Zoom := 100;
//  CheckZoom.text:=inttostr(qrpreview.Zoom);
end;

procedure TRepoEditPreview.ZoomToWidthClick(Sender: TObject);
begin
  Application.ProcessMessages;
  QRPreview.ZoomToWidth;
//  CheckZoom.text:=inttostr(qrpreview.Zoom);
end;

procedure TRepoEditPreview.FirstPageClick(Sender: TObject);
begin
  QRPreview.PageNumber := 1;
  UpdateInfo;
end;

procedure TRepoEditPreview.PrevPageClick(Sender: TObject);
begin
  QRPreview.PageNumber := QRPreview.PageNumber - 1;
  UpdateInfo;
end;

procedure TRepoEditPreview.NextPageClick(Sender: TObject);
begin
  QRPreview.PageNumber := QRPreview.PageNumber + 1;
  UpdateInfo;
end;

procedure TRepoEditPreview.LastPageClick(Sender: TObject);
begin
  QRPreview.PageNumber := QRPrinter.PageCount;
  UpdateInfo;
end;

procedure TRepoEditPreview.BtnPrintClick(Sender: TObject);
begin
  //if qrPrinter.PrintSetup then // if you have qr304bv - uncomment this line and set to "enabled" and "visible" button "PrintSetup"
  qrPrinter.Print;
//  if MyPrinterSetup then  QRPrinter.Print;
end;

procedure TRepoEditPreview.ExitClick(Sender: TObject);
begin
//  application.ProcessMessages;
  Close;
//  application.ProcessMessages;
end;

procedure TRepoEditPreview.FormResize(Sender: TObject);
begin
  if not (csDestroying in Componentstate) then QRPreview.UpdateZoom;
end;

procedure TRepoEditPreview.Show;
begin
{  QRPreview.QRPrinter.ShowingPreview:=true;}
  inherited Show;
  UpdateInfo;
end;

procedure TRepoEditPreview.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_Next : if Shift = [ssCtrl] then
                LastPageClick(Self)
              else
                NextPageClick(Self);
    VK_Prior : if Shift = [ssCtrl] then
                 FirstPageClick(Self)
               else
                 PrevPageClick(Self);
    VK_Home : FirstPageClick(Self);
    VK_End : LastPageClick(Self);
  end;
end;

procedure TRepoEditPreview.SaveClick(Sender: TObject);
var
  aExportFilter : TQRExportFilter;
{$ifndef win32}
  FileExt : string;
  I : integer;
{$endif}
begin
  aExportFilter := nil;
  with TSaveDialog.Create(Application) do
  try
    Title := SqrSaveReport;
    Filter := QRExportFilterLibrary.SaveDialogFilterString;
    DefaultExt := cQRPDefaultExt;
    if Execute then
    begin
      if FilterIndex = 1 then
        QRPrinter.Save(Filename)
      else
      begin
        try
          aExportFilter := TQRExportFilterLibraryEntry(
            QRExportFilterLibrary.Filters[FilterIndex - 2]).ExportFilterClass.Create(Filename);
          QRPrinter.ExportToFilter(aExportFilter);
        finally
          aExportFilter.Free
        end
      end

    end;
  finally
    Free;
  end;
end;

function TRepoEditPreview.MyPrinterSetup:boolean;
var
  aDialog : TQRPrintDialog;
begin
  Result:=false;
  aDialog := TQRPrintDialog.Create(Application);
  aDialog.Printer := TPrinter.Create;

  aDialog.Printer.PrinterIndex := qrPrinter.PrinterIndex; //  (Owner as TRepoEdit).ThReport.PrinterSettings.PrinterIndex;


  with aDialog do
  try
    MinPage := 0;
    MaxPage := 9999;
    if (QRPrinter <> nil) and (QRPrinter.Status = mpFinished) then
    begin
      MinPage := 1;
      MaxPage := QRPrinter.PageCount;
      FromPage := 1;
      ToPage := MaxPage;
    end;

    if self.QRPrinter.printerok then begin
      Options := [poPageNums, poSelection, poWarning];
      aDialog.Printer.Orientation :=qrpreview.QRPrinter.Orientation; // (self.Owner as TRepoEdit).ThReport.Page.Orientation;
      Copies :=QRPreview.QRPrinter.Copies ;
      if Execute then
      begin
        qrPreview.qrprinter.Copies := Copies;
        qrPreview.qrprinter.PrinterIndex := aDialog.Printer.PrinterIndex;
        qrPreview.qrprinter.Orientation := aDialog.Printer.Orientation;
        case PrintRange of
          prAllPages,
          prSelection : begin
                         qrPreview.qrprinter.FirstPage := 0;
                         qrPreview.qrprinter.LastPage := 0;
                       end;

          prPageNums : begin
                         qrPreview.qrprinter.FirstPage := FromPage;
                         qrPreview.qrprinter.LastPage := ToPage;
                       end;
        end;
        Self.Tag := 0;
        Result:=true;
      end
      else begin
        Self.Tag := 1;
        Result:=false;
      end;
      Application.ProcessMessages;
      aDialog.Printer.Free;
      Application.ProcessMessages;
    end;

  finally
    free;
  end
end;

procedure TRepoEditPreview.LoadClick(Sender: TObject);
begin
  with TOpenDialog.Create(Application) do
  try
    Title := SqrLoadReport;
    Filter := SqrQRFile + ' (*.' +cQRPDefaultExt + ')|*.' + cqrpDefaultExt;
    if Execute then
      if FileExists(FileName) then
      begin
        QRPrinter.Load(Filename);
        QRPreview.PageNumber := 1;
        QRPreview.PreviewImage.PageNumber := 1;
        UpdateInfo;
        btnPrintSetup.Enabled := False;
      end
      else
        bvMess(SqrFileNotExist);
  finally
    application.processmessages;
    free;
  end;
end;

procedure TRepoEditPreview.QRPreviewPageAvailable(Sender: TObject;
  PageNum: Integer);
begin
  UpdateInfo;
end;

procedure TRepoEditPreview.QRPreviewProgressUpdate(Sender: TObject;
  Progress: Integer);
begin
  if Progress >= LastProgress + 5 then
  begin
    StatusBar.Panels[1].Text := IntToStr(Progress)+'%';
    LastProgress := Progress;
  end;
  Gauge.Position := Progress;
  if (Progress = 0) or (Progress = 100) then begin
     StatusBar.Panels[1].Text := '';
     LastProgress:=0;
  end;

  if qrPrinter.status=mpfinished then begin
    BtnPrint.Enabled:=true;
    Gauge.Visible:=false;
    StatusBar.Panels[0].Bevel:=pblowered;
  end
  else begin
    BtnPrint.Enabled:=false;
    Gauge.Visible:=true;
    StatusBar.Panels[0].Bevel:=pbNONE;
  end
end;

procedure TRepoEditPreview.FormCreate(Sender: TObject);
var i:integer;
begin
   HorzScrollbar.Tracking := true;
   VertScrollbar.Tracking := true;
  AppWindowState:=wsMaximized;

  if (application.mainform.formstyle<>fsMDIFORM)
     and (PreviewFormStyle=fsMDIChild)
  then  FormStyle:=fsStayOnTop
  else begin
     FormStyle:=PreviewFormStyle;
  end;

  if FormStyle=fsMDIChild then
  try
    for i:=0 to Screen.FormCount-1 do
        if (screen.forms[i].FormStyle=fsMDIChild)
        then begin
          if (Screen.Forms[i].WindowState=wsnormal)
          then  begin
            AppWindowState:=wsNormal;
          end;
          break
        end;
  except
  end

end;

procedure TRepoEditPreview.CheckZoomChange(Sender: TObject);
begin
  Application.ProcessMessages;
  if CheckZoom.ItemIndex>0  then begin
     if zoomFit.down then ZoomFit.Down:=false;
     if Zoom100.Down then Zoom100.Down:=false;
     if ZoomToWidth.down then ZoomToWidth.Down:=false;
  end;
  try
    QRPreview.Zoom := StrToInt(CheckZoom.Text);
  except
  end;
end;


procedure TRepoEditPreview.QRPreviewResize(Sender: TObject);
begin
  CheckZoom.text:=inttostr(qrpreview.Zoom);
end;

procedure TRepoEditPreview.ToolButton4Click(Sender: TObject);
begin
  Application.ProcessMessages;
  if zoomFit.down then ZoomFit.Down:=false;
  if Zoom100.Down then Zoom100.Down:=false;
  if ZoomToWidth.down then ZoomToWidth.Down:=false;
  QRPreview.Zoom := qrpreview.zoom+5;
  QRPreview.OnResize(qrpreview);
end;

procedure TRepoEditPreview.ToolButton1Click(Sender: TObject);
begin
  Application.ProcessMessages;
  if zoomFit.down then ZoomFit.Down:=false;
  if Zoom100.Down then Zoom100.Down:=false;
  if ZoomToWidth.down then ZoomToWidth.Down:=false;
  QRPreview.Zoom := qrpreview.zoom-5;
  QRPreview.OnResize(qrpreview);
end;

function TbvPreviewInterface.Show(AQRPrinter : TQRPrinter) : TWinControl;
//   if you not have d4cupd1.exe,d4cupd2.exe and d4cupd3.exe - delphi update files, then comment top line and uncomment bottom line
//procedure TbvPreviewInterface.Show(AQRPrinter : TQRPrinter);

var thPrev:TRepoEditPreview;
begin
  thPrev :=
            TRepoEditPreview.CreatePreview(Application,AQRPrinter);
  Application.ProcessMessages;
  thPrev.Show;
  Application.ProcessMessages;
  Result:=thPrev;  //   If you not have professiontal version, then comment this ( or qr304bv)
end;

procedure TRepoEditPreview.BtnPrintSetupClick(Sender: TObject);
begin
  qrprinter.PrintSetup;
end;

initialization

  RegisterPreviewClass(TbvPreviewInterface);

  PreviewFormStyle:=fsStayOnTop;

end.