pagesetuprvfrm.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

unit PageSetupRVFrm;

interface

{$I RichViewActions.inc}

uses
  Windows, WinSpool, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, ComCtrls, StdCtrls, RVSpinEdit, RVOfficeRadioBtn, Printers;

type
  TfrmRVPageSetup = class(TForm)
    btnOk: TButton;
    btnCancel: TButton;
    pc: TPageControl;
    tsPage: TTabSheet;
    tsHF: TTabSheet;
    rgOrientation: TRVOfficeRadioGroup;
    il: TImageList;
    gbMargins: TGroupBox;
    lblTop: TLabel;
    lblBottom: TLabel;
    lblLeft: TLabel;
    lblRight: TLabel;
    seTop: TRVSpinEdit;
    seBottom: TRVSpinEdit;
    seLeft: TRVSpinEdit;
    seRight: TRVSpinEdit;
    cbMirrorMargins: TCheckBox;
    gbPaper: TGroupBox;
    lblSize: TLabel;
    cmbSize: TComboBox;
    lblSource: TLabel;
    cmbSource: TComboBox;
    gbHeader: TGroupBox;
    ilAlign: TImageList;
    rbHLeft: TRVOfficeRadioButton;
    rbHCenter: TRVOfficeRadioButton;
    rbHRight: TRVOfficeRadioButton;
    lblHText: TLabel;
    txtHText: TEdit;
    btnHFont: TButton;
    cbHOnFirstPage: TCheckBox;
    gbFooter: TGroupBox;
    lblFText: TLabel;
    rbFLeft: TRVOfficeRadioButton;
    rbFCenter: TRVOfficeRadioButton;
    rbFRight: TRVOfficeRadioButton;
    txtFText: TEdit;
    btnFFont: TButton;
    cbFOnFirstPage: TCheckBox;
    lblCodes: TLabel;
    fd: TFontDialog;
    gbNumbers: TGroupBox;
    lblStartFrom: TLabel;
    seStartFrom: TRVSpinEdit;
    procedure btnOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnHFontClick(Sender: TObject);
    procedure btnFFontClick(Sender: TObject);
  private
    { Private declarations }
    FHeaderFont, FFooterFont: TFont;    
  protected

  public
    { Public declarations }
    function Init:Boolean;
    procedure Apply;
  end;

implementation

uses uTxtfrm;

type
  TBinName = array [0..23] of Char;
  TBinNames = array [0..1000] of TBinName;
  PBinNames = ^TBinNames;
  TPaperName = array [0..63] of Char;
  TPaperNames = array [0..1000] of TPaperName;
  PPaperNames = ^TPaperNames;
  TWordArray = array [0..1000] of Word;
  PWordArray = ^TWordArray;

{$R *.dfm}


{ TfrmRVPageSetup }

procedure TfrmRVPageSetup.Apply;
var
  ADevice, ADriver, APort: array[0..79] of Char;
  ADeviceMode: THandle;
  DevMode: PDeviceMode;
begin
  TTxtFrm(Owner).RVPrint1.TopMarginMM:=seTop.AsInteger;
  TTxtFrm(Owner).RVPrint1.BottomMarginMM:=seBottom.AsInteger;
  TTxtFrm(Owner).RVPrint1.LeftMarginMM:=seLeft.AsInteger;
  TTxtFrm(Owner).RVPrint1.RightMarginMM:=seRight.AsInteger;
  TTxtFrm(Owner).RVPrint1.MirrorMargins:=cbMirrorMargins.Checked;

  case rgOrientation.ItemIndex of
    0:
      Printer.Orientation := poPortrait;
    1:
      Printer.Orientation := poLandscape;
  end;
  Printer.GetPrinter(ADevice,ADriver,APort,ADeviceMode);
  DevMode := PDeviceMode(GlobalLock(ADeviceMode));
  try
    if cmbSize.ItemIndex>=0 then
    begin
      DevMode.dmPaperSize := Integer(cmbSize.Items.Objects[cmbSize.ItemIndex]);
      DevMode.dmFields := DevMode.dmFields or DM_PAPERSIZE;
    end;
    if cmbSource.ItemIndex>=0 then
    begin
      DevMode.dmDefaultSource := Integer(cmbSource.Items.Objects[cmbSource.ItemIndex]);
      DevMode.dmFields := DevMode.dmFields or DM_DEFAULTSOURCE;
    end;
  finally
    GlobalUnlock(ADeviceMode);
  end;
  Printer.SetPrinter(ADevice,ADriver,APort,ADeviceMode);

  with TTxtFrm(Owner).PageHeader do
  begin
    Text:=txtHText.Text;
    PrintOnFirstPage:=cbHOnFirstPage.Checked;
    if rbHLeft.Checked then
      Alignment:=taLeftJustify
    else if rbHRight.Checked then
      Alignment:=taRightJustify
    else if rbHCenter.Checked then
      Alignment:=taCenter;
    Font.Assign(FHeaderFont);
  end;

  with TTxtFrm(Owner).PageFooter do
  begin
    Text:=txtFText.Text;
    PrintOnFirstPage:=cbFOnFirstPage.Checked;
    if rbFLeft.Checked then
      Alignment:=taLeftJustify
    else if rbFRight.Checked then
      Alignment:=taRightJustify
    else if rbFCenter.Checked then
      Alignment:=taCenter;
    Font.Assign(FFooterFont);
  end;
  TTxtFrm(Owner).StartPage:=seStartFrom.AsInteger;
end;

function TfrmRVPageSetup.Init:Boolean;
var
  ADevice, ADriver, APort: array[0..79] of Char;
  ADeviceMode: THandle;
  DevMode: PDeviceMode;
  BinCount,PaperCount,i: integer;
  BinNames: PBinNames;
  BinCodes, PaperCodes: PWordArray;
  PaperNames: PPaperNames;  
begin
  Printer.GetPrinter(ADevice,ADriver,APort,ADeviceMode);
  result:=ADeviceMode<>0;
  if not result then
    exit;
  DevMode := PDeviceMode(GlobalLock(ADeviceMode));
  try
    BinCount := DeviceCapabilities(ADevice, APort, DC_BINNAMES, nil, DevMode);
    GetMem(BinNames, sizeof(TBinName)*BinCount);
    GetMem(BinCodes, sizeof(Integer)*BinCount);
    try
      DeviceCapabilities(ADevice, APort, DC_BINNAMES, Pointer(BinNames), DevMode);
      DeviceCapabilities(ADevice, APort, DC_BINS, Pointer(BinCodes), DevMode);
      for i := 0 to BinCount-1 do
        cmbSource.Items.AddObject(BinNames[i], TObject(BinCodes[i]));
      if (DevMode.dmFields and DM_DEFAULTSOURCE)<>0 then
      begin
        for i := 0 to BinCount-1 do
          if BinCodes[i]=Word(DevMode.dmDefaultSource) then
            cmbSource.ItemIndex:=i; 
      end;
    finally
      FreeMem(BinNames);
      FreeMem(BinCodes);
    end;

    PaperCount := DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, nil, DevMode);
    GetMem(PaperNames, sizeof(TPaperName)*PaperCount);
    GetMem(PaperCodes, sizeof(Integer)*PaperCount);
    try
      DeviceCapabilities(ADevice, APort, DC_PAPERNAMES, Pointer(PaperNames), DevMode);
      DeviceCapabilities(ADevice, APort, DC_PAPERS, Pointer(PaperCodes), DevMode);
      for i := 0 to PaperCount-1 do
        cmbSize.Items.AddObject(PaperNames[i], TObject(PaperCodes[i]));
      if (DevMode.dmFields and DM_PAPERSIZE)<>0 then
      begin
        for i := 0 to PaperCount-1 do
          if PaperCodes[i]=Word(DevMode.dmPaperSize) then
            cmbSize.ItemIndex:=i;
      end;
    finally
      FreeMem(PaperNames);
      FreeMem(PaperCodes);
    end;
  finally
    GlobalUnlock(ADeviceMode);
  end;

  seTop.Value:=TTxtFrm(Owner).RVPrint1.TopMarginMM;
  seBottom.Value:=TTxtFrm(Owner).RVPrint1.BottomMarginMM;
  seLeft.Value:=TTxtFrm(Owner).RVPrint1.LeftMarginMM;
  seRight.Value:=TTxtFrm(Owner).RVPrint1.RightMarginMM;
  cbMirrorMargins.Checked:=TTxtFrm(Owner).RVPrint1.MirrorMargins;

  case Printer.Orientation of
    poPortrait:
      rgOrientation.ItemIndex := 0;
    poLandscape:
      rgOrientation.ItemIndex := 1;
  end;

  with TTxtFrm(Owner).PageHeader do
  begin
    txtHText.Text:=Text;
    cbHOnFirstPage.Checked:=PrintOnFirstPage;
    case Alignment of
      taLeftJustify:
        rbHLeft.Checked := True;
      taRightJustify:
        rbHRight.Checked := True;
      taCenter:
        rbHCenter.Checked := True;
    end;
    FHeaderFont.Assign(Font);
  end;

  with TTxtFrm(Owner).PageFooter do
  begin
    txtFText.Text:=Text;
    cbFOnFirstPage.Checked:=PrintOnFirstPage;
    case Alignment of
      taLeftJustify:
        rbFLeft.Checked := True;
      taRightJustify:
        rbFRight.Checked := True;
      taCenter:
        rbFCenter.Checked := True;
    end;
    FFooterFont.Assign(Font);  
  end;
  seStartFrom.Value:=TTxtFrm(Owner).StartPage;  
end;

procedure TfrmRVPageSetup.btnOkClick(Sender: TObject);
begin
  Apply;
end;

procedure TfrmRVPageSetup.FormCreate(Sender: TObject);
begin
  FHeaderFont:=TFont.Create;
  FFooterFont:=TFont.Create;
end;

procedure TfrmRVPageSetup.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  FHeaderFont.Free;
  FFooterFont.Free; 
end;

procedure TfrmRVPageSetup.btnHFontClick(Sender: TObject);
begin
  fd.Font := FHeaderFont;
  if fd.Execute then
  begin
    FHeaderFont.Assign(fd.Font);
  end;
end;

procedure TfrmRVPageSetup.btnFFontClick(Sender: TObject);
begin
  fd.Font := FFooterFont;
  if fd.Execute then
  begin
    FFooterFont.Assign(fd.Font);
  end;
end;

end.