pntdlg.pas

delphi框架可以学习, 写的很好的

unit PntDlg;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Buttons, ExtCtrls, TransButton, ppViewr, Spin, ppReport,
  ppPrintr, ppTypes, ppComm, ppRelatv, ppProd, ppClass, ppBands, ppCache, IniFiles;

type
  TfrmPntDlg = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet3: TTabSheet;
    Label13: TLabel;
    Label7: TLabel;
    TransButton1: TTransButton;
    Label15: TLabel;
    GroupBox2: TGroupBox;
    rbPrintAll: TRadioButton;
    rbPrintCurrent: TRadioButton;
    rbPrintPart: TRadioButton;
    BtnSave: TBitBtn;
    BtnCancel: TBitBtn;
    Label16: TLabel;
    Panel2: TPanel;
    Label12: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    seWidth: TSpinEdit;
    seHeight: TSpinEdit;
    Label17: TLabel;
    Label18: TLabel;
    Panel3: TPanel;
    Panel1: TPanel;
    Label5: TLabel;
    RptForm: TppViewer;
    Label1: TLabel;
    seTop: TSpinEdit;
    Label2: TLabel;
    seBottom: TSpinEdit;
    Label3: TLabel;
    seLeft: TSpinEdit;
    Label4: TLabel;
    seRight: TSpinEdit;
    cbSavePrinterSetup: TCheckBox;
    Label8: TLabel;
    Label11: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    BtnRestore: TBitBtn;
    Edit1: TEdit;
    cmbPagerName: TComboBox;
    cmbPrinterName: TComboBox;
    SpinEdit1: TSpinEdit;
    btnSaveLocal: TBitBtn;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure TransButton1Click(Sender: TObject);
    procedure cmbPagerNameClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure seWidthChange(Sender: TObject);
    procedure seHeightChange(Sender: TObject);
    procedure seTopChange(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure rbPrintPartClick(Sender: TObject);
    procedure cbSavePrinterSetupClick(Sender: TObject);
    procedure BtnRestoreClick(Sender: TObject);
    procedure btnSaveLocalClick(Sender: TObject);
  private
    Refreshed: Boolean;
    SavePrinterSetup: TppPrinterSetup;
    SaveUnits: TppUnitType;
    procedure RefreshRptForm;
    procedure RefreshValue;
  public
  end;

var
  frmPntDlg: TfrmPntDlg;
  ReportName: String;

function ShowPrinterSetup(RepName: String; Report: TppReport; IsModified: Boolean): Integer; export;

implementation
uses dm32, MyPublic;

{$R *.DFM}

function ShowPrinterSetup(RepName: String; Report: TppReport; IsModified: Boolean): Integer;
begin
  ReportName := RepName;

  Result:= idCancel;
  if not Assigned(Report) then exit;
  
  try
    Application.CreateForm(TfrmPntDlg, frmPntDlg);
    frmPntDlg.cbSavePrinterSetup.Checked:= IsModified;
    frmPntDlg.cbSavePrinterSetup.Enabled:= IsModified;
    frmPntDlg.RptForm.Report:= Report;
    frmPntDlg.RptForm.FirstPage;
    frmPntDlg.ShowModal;
    if frmPntDlg.Tag = 0
    then Result:= idCancel
    else Result:= idOK;
  finally
    frmPntDlg.Free;
    frmPntDlg:= nil;
  end;
end;

{ TfrmSetPrinter }

procedure TfrmPntDlg.RefreshRptForm;
begin
  if Refreshed then 
  with RptForm.ScreenDevice do
  begin
    Reset;
    MakePageRequest;
  end;  
end;

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

procedure TfrmPntDlg.FormShow(Sender: TObject);
begin
  SaveUnits:= (RptForm.Report as TppReport).Units;
  (RptForm.Report as TppReport).Units:= utMMThousandths;
  SavePrinterSetup:= TppPrinterSetup.Create(Self);
  SavePrinterSetup.Units:= utMMThousandths;
  //主要是为了保存原有的数据，以备恢复按扭使用。
  with RptForm.Report.PrinterSetup do
  begin
    SavePrinterSetup.Copies      := Copies;
    SavePrinterSetup.PaperName   := PaperName;
    SavePrinterSetup.PrinterName := PrinterName;
    SavePrinterSetup.MarginBottom:= MarginBottom;
    SavePrinterSetup.MarginLeft  := MarginLeft;
    SavePrinterSetup.MarginRight := MarginRight;
    SavePrinterSetup.MarginTop   := MarginTop;
    SavePrinterSetup.PaperHeight := PaperHeight;
    SavePrinterSetup.PaperWidth  := PaperWidth;

    cmbPrinterName.Items:= PrinterNames;

    cmbPagerName.Items  := PaperNames;
    cmbPagerName.Enabled:= PaperNames.Count > 1;
  end;
  
  RefreshRptForm;
  RefreshValue;
end;

procedure TfrmPntDlg.cmbPagerNameClick(Sender: TObject);
begin
  with RptForm.Report.PrinterSetup do
  begin
    Refreshed:= False;
    if cmbPagerName.ItemIndex = cmbPagerName.Items.Count -1
    then PaperName:= 'Custom'
    else PaperName:= cmbPagerName.Text;

    seWidth.Value := Round(PaperWidth);
    seHeight.Value:= Round(PaperHeight);
    Refreshed:= True;
  end;
  RefreshRptForm;
end;

procedure TfrmPntDlg.BtnSaveClick(Sender: TObject);
begin
  Tag:= 1;  //退出窗口后刷新报表的标志

 { if cbSavePrinterSetup.Checked then
  with dm.qryRep do
  if Active then
  if not ISEmpty then
  try
    //保存报表至数据库中
    //其实打印设置这个小预览窗口中的那个报表已经是预览报表窗口中的那个了。
    //现在保存回去，退出这个窗口后，预览窗口会再读取一次。
    (RptForm.Report as TppReport).Template.SaveToDatabase;

    if ApplyUpdates(-1) > 0
    then ShowMessageBox('保存', '无法保存改动的设置,只有当次有效,下次无法使用该设置!', MB_ICONERROR, 15);
  except
  end;    }
  
  Close;
end;

procedure TfrmPntDlg.BtnCancelClick(Sender: TObject);
begin
  Tag:= 0;

  with dm.qryRep do
  if Active then
  if not ISEmpty then Cancel;
  
  Close;
end;

procedure TfrmPntDlg.seWidthChange(Sender: TObject);
begin
  if not Refreshed then exit;

  if seWidth.text = '' then
   begin
     seLeft.MaxValue:= 0;
     seRight.MaxValue:= 0;
   end
  else
   begin
     seLeft.MaxValue:= seWidth.Value;
     seRight.MaxValue:= seWidth.Value;
   end;

  with RptForm.Report.PrinterSetup do
  begin
    PaperName:= 'Custom';
    if seWidth.text = ''
    then PaperWidth  := 0
    else PaperWidth  := seWidth.value;
    cmbPagerName.ItemIndex:= cmbPagerName.Items.Count -1;
  end;

  RefreshRptForm;
end;

procedure TfrmPntDlg.seHeightChange(Sender: TObject);
begin
  if not Refreshed then exit;

  if seHeight.text = '' then
   begin
     seTop.MaxValue:= 0;
     seBottom.MaxValue:= 0;
   end
  else
   begin
     seTop.MaxValue:= seWidth.Value;
     seBottom.MaxValue:= seWidth.Value;
   end;

  with RptForm.Report.PrinterSetup do
  begin
    PaperName:= 'Custom';
    if seHeight.text = ''
    then PaperHeight := 0
    else PaperHeight := seHeight.value;
    cmbPagerName.ItemIndex:= cmbPagerName.Items.Count -1;
  end;
    
  RefreshRptForm; 
end;

procedure TfrmPntDlg.seTopChange(Sender: TObject);
begin
  if not Refreshed then exit;
  //刷新预览窗口
  with RptForm.Report.PrinterSetup do
  begin
    if seTop.text = ''
    then MarginTop   := 0
    else MarginTop   := seTop.Value;

    if seBottom.text = ''
    then MarginBottom:= 0
    else MarginBottom:= seBottom.Value;

    if seLeft.text = ''
    then MarginLeft  := 0
    else MarginLeft  := seLeft.Value;

    if seRight.text = ''
    then MarginRight := 0
    else MarginRight := seRight.Value;
  end;

  RefreshRptForm;
end;

procedure TfrmPntDlg.Edit1Change(Sender: TObject);
begin
  with rbPrintPart do
  if not Checked then Checked:= True;
end;

procedure TfrmPntDlg.rbPrintPartClick(Sender: TObject);
begin
  Edit1.SetFocus;
end;

procedure TfrmPntDlg.cbSavePrinterSetupClick(Sender: TObject);
begin
  if Refreshed then
    RptForm.Report.SavePrinterSetup:= (Sender as TCheckBox).Checked;
end;

procedure TfrmPntDlg.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if Tag = 0 then //取消
  if Assigned(SavePrinterSetup) then //则恢复
  begin
     BtnRestoreClick(niL);
     SavePrinterSetup.Free;
  end;
  
  (RptForm.Report as TppReport).Units:= SaveUnits;
  Action:= caFree;
end;

procedure TfrmPntDlg.BtnRestoreClick(Sender: TObject);
begin
  with RptForm.Report.PrinterSetup do
  begin
    PrinterName := SavePrinterSetup.PrinterName;
    PaperName   := SavePrinterSetup.PaperName;
    
    Copies      := SavePrinterSetup.Copies;
    MarginBottom:= SavePrinterSetup.MarginBottom;
    MarginLeft  := SavePrinterSetup.MarginLeft;
    MarginRight := SavePrinterSetup.MarginRight;
    MarginTop   := SavePrinterSetup.MarginTop;
    PaperHeight := SavePrinterSetup.PaperHeight;
    PaperWidth  := SavePrinterSetup.PaperWidth;
  end;
  
  if Sender <> nil then
  begin
    RefreshValue;
    RefreshRptForm;
  end;
end;

procedure TfrmPntDlg.RefreshValue;
begin
  //刷新打印设置值为当前值
  Refreshed:= False;

  with RptForm.Report.PrinterSetup do
  begin
    cmbPagerName.ItemIndex:= cmbPagerName.Items.IndexOf(PaperName);
    if cmbPagerName.Items.Count > 0
    then cmbPagerName.Items[cmbPagerName.Items.Count - 1]:= '自动义纸张大小';
    if cmbPagerName.ItemIndex = -1
    then cmbPagerName.ItemIndex:= cmbPagerName.Items.Count - 1;

    cmbPrinterName.ItemIndex:= cmbPrinterName.Items.IndexOf(PrinterName);
    if cmbPrinterName.Items.Count > 0
    then cmbPrinterName.Items[0]:= '默认打印机';
    if cmbPrinterName.ItemIndex = -1
    then cmbPrinterName.ItemIndex:= 0;

    if ReadIni(ReportName,'Height',0) <>0 then begin
      seWidth.Value := Round(ReadIni(ReportName, 'Width', 0));
      seHeight.Value:= Round(ReadIni(ReportName, 'Height',0));
      seTop.Value   := Round(ReadIni(ReportName, 'Top',   0));
      seBottom.Value:= Round(ReadIni(ReportName, 'Bottom',0));
      seLeft.Value  := Round(ReadIni(ReportName, 'Left',  0));
      seRight.Value := Round(ReadIni(ReportName, 'Right', 0));
    end else begin
      seWidth.Value := Round(PaperWidth);
      seHeight.Value:= Round(PaperHeight);
      seTop.Value   := Round(MarginTop);
      seBottom.Value:= Round(MarginBottom);
      seLeft.Value  := Round(MarginLeft);
      seRight.Value := Round(MarginRight);
    end;

    //cbSavePrinterSetup.Checked:= RptForm.Report.SavePrinterSetup;
  end;
  Refreshed:= True;
end;

procedure TfrmPntDlg.btnSaveLocalClick(Sender: TObject);
begin
  //保存页边距至INI文件
  Tag:= 1;

  WriteINI(ReportName, 'Height', seHeight.Value);
  WriteINI(ReportName, 'Width',  seWidth.Value);
  WriteINI(ReportName, 'Top',    seTop.Value);
  WriteINI(ReportName, 'Bottom', seBottom.Value);
  WriteINI(ReportName, 'Left',   seLeft.Value);
  WriteINI(ReportName, 'Right',  seRight.Value);

  Close;
end;

end.