prvdlg.pas

来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 446 行

unit PrvDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, Menus, ImgList, TransButton, Buttons,
  ppEndUsr, ppDB, ppDBPipe, ppChrt, ppPrnabl, ppClass, ppCtrls, ppChrtDP,
  ppBands, ppCache, ppComm, ppRelatv, ppProd, ppReport, ppCTMain, ppSubRpt,
  ppRegion, myChkBox, ppBarCod, ppMemo, ppRichTx, ppVar, ppStrtch,ppTypes,
  ppViewr, ActnList, IniFiles, RzPanel, RzButton, RzCmboBx;

type
  TfrmPrvDlg = class(TForm)
    ppViewer1: TppViewer;
    FStatusBar: TStatusBar;
    PopupMenu1: TPopupMenu;
    popPrintItem: TMenuItem;
    N5: TMenuItem;
    popSetupItem: TMenuItem;
    popRefreshItem: TMenuItem;
    Label2: TLabel;
    ActionList1: TActionList;
    doClose: TAction;
    doRef: TAction;
    ImageList1: TImageList;
    Panel3: TRzPanel;
    Label3: TLabel;
    RzToolbar1: TRzToolbar;
    BtnError: TRzToolButton;
    RzSpacer1: TRzSpacer;
    BtnBuild: TRzToolButton;
    BtnPrint: TRzToolButton;
    RzSpacer2: TRzSpacer;
    Btn: TRzToolButton;
    cbZoomInOut: TRzComboBox;
    Label4: TLabel;
    TransButton1: TTransButton;
    TransButton2: TTransButton;
    TransButton3: TTransButton;
    TransButton4: TTransButton;
    edtPreviewPage: TEdit;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure ZoomPercentages(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure BtnFirstPageClick(Sender: TObject);
    procedure BtnPriorPageClick(Sender: TObject);
    procedure BtnNextPageClick(Sender: TObject);
    procedure BtnLastPageClick(Sender: TObject);
    procedure cbZoomInOutKeyPress(Sender: TObject; var Key: Char);
    procedure BtnStopClick(Sender: TObject);
    procedure ppViewer1StatusChange(Sender: TObject);
    procedure SetPageItemClick(Sender: TObject);
    procedure ppViewer1PageChange(Sender: TObject);
    procedure ppViewer1PrintStateChange(Sender: TObject);
    procedure SetPrinterItemClick(Sender: TObject);
    procedure PrintingItemClick(Sender: TObject);
    procedure OpenItemClick(Sender: TObject);
    procedure edtPreviewPageKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ppViewer1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ppViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ppViewer1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure doCloseExecute(Sender: TObject);
    procedure doRefExecute(Sender: TObject);
  private
    FSelectedRect: TRect;  //鼠标拖动的Rect  //me
    FPageCount: Integer;
    FIsModified: Boolean;   //页数
    function  GetPageCount: Integer;
    function  GetPageIndex: Integer;

    function  SwapRect(ARect: TRect): TRect;   //me
    procedure StartDraging(X, Y: Integer);     //me
    procedure EndDraging;                      //me
    procedure ClearFSelectedRect;              //me
    procedure DrawFSelectedRect(X, Y: Integer);//me
    procedure ZoomInOut(const Value: Boolean); //me
    procedure ZoomCursor(Value : Boolean);     //me
  public
    RepName: string;
    procedure RefreshppViewer1;
    property PageCount : Integer read GetPageCount;
    property PageIndex : Integer read GetPageIndex;
    property IsModified: Boolean read FIsModified write FIsModified;
  end;

implementation
uses PntDlg, MyPublic;

{$R *.DFM}
procedure HideComponent(Sender: TObject);
begin
  if Sender is TppLine then (Sender as TppLine).Visible:= False
    else
  if Sender is TppLabel then (Sender as TppLabel).Visible:= False
    else
  if Sender is TppMemo then (Sender as TppMemo).Visible:= False
    else
  if Sender is TppRichText then (Sender as TppRichText).Visible:= False;
end;

function TfrmPrvDlg.GetPageCount: Integer;
begin
  FPageCount := (ppViewer1.Report as TppReport).PageCount;
  Result := FPageCount;
end;

function TfrmPrvDlg.GetPageIndex: Integer;
begin
  Result := (ppViewer1.Report as TppReport).PageNo;
end;

procedure TfrmPrvDlg.ZoomPercentages(Sender: TObject);
var
 strPercentage : Integer;
begin              
 case cbZoomInOut.ItemIndex of
   7 : ppViewer1.ZoomSetting := zsWholePage;
   8 : ppViewer1.ZoomSetting := zsPageWidth;
   else
     try
       strPercentage := StrToInt(TRim(StringReplace(cbZoomInOut.Text,'%','',[])));
       if (strPercentage > 0) and (strPercentage <= 200)
       then ppViewer1.ZoomPercentage := strPercentage;
     except
     end;  
 end;
 cbZoomInOut.SelectAll;
end;

procedure TfrmPrvDlg.BtnPrintClick(Sender: TObject);
begin
 //打印
 try
   ppViewer1.Print;
 except
   ShowMess('错误','你的计算机还没有安装打印机或断开了连接!',MB_ICONERROR, 15);
 end;
end;

procedure TfrmPrvDlg.BtnFirstPageClick(Sender: TObject);
begin
 ppViewer1.FirstPage;
end;

procedure TfrmPrvDlg.BtnPriorPageClick(Sender: TObject);
begin
 ppViewer1.PriorPage;
end;

procedure TfrmPrvDlg.BtnNextPageClick(Sender: TObject);
begin
 ppViewer1.NextPage;
end;

procedure TfrmPrvDlg.BtnLastPageClick(Sender: TObject);
begin
 ppViewer1.LastPage;
end;

procedure TfrmPrvDlg.cbZoomInOutKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = #13 then ZoomPercentages(nil);
end;

procedure TfrmPrvDlg.BtnStopClick(Sender: TObject);
begin
  if ppViewer1.Report.Printing
  then ppViewer1.Cancel;

  Panel3.Enabled:= True;
end;

procedure TfrmPrvDlg.ppViewer1StatusChange(Sender: TObject);
begin
  FStatusBar.Panels[1].text:= ppViewer1.Status;
end;

procedure TfrmPrvDlg.SetPageItemClick(Sender: TObject);
var
  RstValue: Integer;
  Report: TppReport;
begin
  with BtnBuild do
  if not(Visible and Enabled) then exit;

  //页面设置
  Report:= ppViewer1.Report as TppReport;  //保存
  ppViewer1.Report:= nil;                  //取消与Report的连接
  RstValue:= ShowPrinterSetup(RepName, Report, IsModified);     //传递指针
  ppViewer1.Report:= Report;               //恢复与Report的连接
  if RstValue = idOK  then RefreshppViewer1;
end;

procedure TfrmPrvDlg.ppViewer1PageChange(Sender: TObject);
begin
  edtPreviewPage.Text  := IntToStr(ppViewer1.AbsolutePageNo);
end;

procedure TfrmPrvDlg.ppViewer1PrintStateChange(Sender: TObject);
begin
  Panel3.Enabled:= not ppViewer1.Busy;
end;

procedure TfrmPrvDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  //Action:= caHide;
  ppViewer1.Report:= nil;
end;

procedure TfrmPrvDlg.SetPrinterItemClick(Sender: TObject);
begin
  with TPrinterSetupDialog.Create(Self) do
  try
    Execute;
  finally
    Free;
  end;
end;

procedure TfrmPrvDlg.PrintingItemClick(Sender: TObject);
begin
  with TPrintDialog.Create(Self) do
  try
    if Execute
    then BtnPrint.Click;
  finally
    Free;
  end;
end;

procedure TfrmPrvDlg.RefreshppViewer1;
begin
  //如果修改参数成功，则刷新报表显示
  with ppViewer1.ScreenDevice do
  try
    Reset;
    MakePageRequest;
  except
  end;
end;

procedure TfrmPrvDlg.OpenItemClick(Sender: TObject);
var
  ls_FileName: String;
begin
  with TOpenDialog.Create(Self) do
  try
    Filter:= '报表文件(*.rtm)|*.rtm|所有文件(*.*)|*.*';
    Options:= [ofReadOnly, ofHideReadOnly, ofEnableSizing];

    if Execute then
    begin
      ls_FileName:= FileName;
      with (ppViewer1.Report as TppReport).Template do
      begin
        FileName:= ls_FileName;
        LoadFromFile;
        RefreshppViewer1;
      end;  
    end;
  finally
    Free;
  end;
end;

procedure TfrmPrvDlg.edtPreviewPageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  li_Page: Longint;
begin
  if Key = 13 then
  begin
   try
     li_Page := StrToInt(EdtPreviewPage.Text);
     if li_Page > PageCount then
     begin
      li_Page := FPageCount;
      EdtPreviewPage.Text := IntToStr(li_Page);
     end;
     ppViewer1.ScreenDevice.GotoPage(li_Page);
   except
     EdtPreviewPage.SelectAll;
   end;
  end;
end;

procedure TfrmPrvDlg.FormShow(Sender: TObject);
begin
  cbZoomInOut.ItemIndex := 7;
  ppViewer1.ZoomSetting:= zsWholePage;
end;

procedure TfrmPrvDlg.PopupMenu1Popup(Sender: TObject);
begin
  popSetupItem.Enabled:= BtnBuild.Enabled;
  popPrintItem.Enabled:= BtnPrint.Enabled;
end;

procedure TfrmPrvDlg.ClearFSelectedRect;
begin
  if (FSelectedRect.Right = -1) and (FSelectedRect.Bottom = -1) then exit;
  ppViewer1.PaintBox.Canvas.DrawFocusRect(SwapRect(FSelectedRect));
  FSelectedRect.Right := -1;
  FSelectedRect.Bottom:= -1;
end;

procedure TfrmPrvDlg.DrawFSelectedRect(X, Y: Integer);
begin
  if (X <> FSelectedRect.Left ) or (Y <> FSelectedRect.Top) then
  begin
   ClearFSelectedRect;
   FSelectedRect.Right := X;
   FSelectedRect.Bottom:= Y;
   ppViewer1.PaintBox.Canvas.DrawFocusRect(SwapRect(FSelectedRect));
  end;
end;

procedure TfrmPrvDlg.EndDraging;
var
  RestoreMouseRect: TRect;
begin
  RestoreMouseRect := Rect(0, 0, Screen.Width -1, Screen.Height-1);
  ClipCursor(@RestoreMouseRect);
  Screen.Cursor:= crDefault;
end;

procedure TfrmPrvDlg.StartDraging(X, Y: Integer);
var
  CxFrame: Integer;
  RestoreMouseRect: TRect;
begin
  ClearFSelectedRect;

  if GetWindowRect(Handle, RestoreMouseRect) then
  with RestoreMouseRect do
  begin
    if BorderStyle= bsSingle then
    begin
      CxFrame:= GetSystemMetrics(SM_CXFRAME);
      Left:= Left + CxFrame;
      Top:= Top + CxFrame;
      Right:= Right - CxFrame;
      Bottom:= Bottom - CxFrame;
    end;
    if ppViewer1.ScrollBox.HorzScrollBar.ButtonSize > 0
    then Right:= Right - ppViewer1.ScrollBox.HorzScrollBar.ButtonSize
    else Right:= Right - GetSystemMetrics(SM_CYHSCROLL);

    if ppViewer1.ScrollBox.VertScrollBar.ButtonSize > 0
    then Bottom:= Bottom - ppViewer1.ScrollBox.VertScrollBar.ButtonSize
    else Bottom:= Bottom - GetSystemMetrics(SM_CYVSCROLL);

  end;
  ClipCursor(@RestoreMouseRect);  //锁定鼠标在拖动范围

  FSelectedRect:= Rect(X,Y,-1,-1);
end;

function TfrmPrvDlg.SwapRect(ARect: TRect): TRect;
var
 TempX: Integer;
begin
 if ARect.Left > ARect.Right  then
  begin
    TempX := ARect.Left;
    ARect.Left := ARect.Right;
    ARect.Right := TempX;
  end;

  if ARect.Top > ARect.Bottom then
  begin
    TempX := ARect.Top;
    ARect.Top := ARect.Bottom;
    ARect.Bottom := TempX;
  end;
  Result := ARect;
end;

procedure TfrmPrvDlg.ZoomCursor(Value: Boolean);
begin
  if Value //放大图标
  then Screen.Cursor := crCross
  else Screen.Cursor := crCross;
end;

procedure TfrmPrvDlg.ZoomInOut(const Value: Boolean);
begin
  if Value then //放大
  begin
    ppViewer1.ZoomPercentage:= ppViewer1.ZoomPercentage + 10;
  end
  else  //缩小
  begin
    ppViewer1.ZoomPercentage:= ppViewer1.ZoomPercentage - 10;
  end;
end;

procedure TfrmPrvDlg.ppViewer1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  StartDraging(X, Y);
  if Assigned(OnMouseDown) then OnMouseDown(Sender, Button, Shift, X, Y);
end;

procedure TfrmPrvDlg.ppViewer1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  with FSelectedRect do
  if (Right <> -1) and (Shift <> [])
  then ZoomCursor( (Left > Right) or ( Top > Bottom) );

  if Shift <> [] then DrawFSelectedRect(X, Y);
end;

procedure TfrmPrvDlg.ppViewer1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FSelectedRect.Right <> -1 then
  begin
    ZoomInOut(FSelectedRect.Right > FSelectedRect.Left);
  end;  

  EndDraging;
  ClearFSelectedRect;
end;

procedure TfrmPrvDlg.doCloseExecute(Sender: TObject);
begin
  while ppViewer1.Report.Printing do
  ppViewer1.Cancel;

  Close;
end;

procedure TfrmPrvDlg.doRefExecute(Sender: TObject);
begin
  RefreshppViewer1;
end;

end.