pagesetuprvfrm.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichViewActions                                 }
{       Page setup form                                 }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}


unit PageSetupRVFrm;

interface

{$I RichViewActions.inc}

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

type
  TfrmRVPageSetup = class(TfrmRVBase)
    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 btnHFontClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnFFontClick(Sender: TObject);
  private
    { Private declarations }
    FHeaderFont, FFooterFont: TFont;
    _cbMirrorMargins, _cbHOnFirstPage, _cbFOnFirstPage, _gbMargins,
    _cmbSize, _cmbSource,
    _txtHText, _txtFText: TControl;
    FInches: Boolean;
  protected
    {$IFDEF RVASKINNED}
    procedure OnCreateThemedControl(OldControl, NewControl: TControl); override;
    {$ENDIF}
  public
    { Public declarations }
    function Init: Boolean;
    procedure Apply;
    procedure Localize; override;
    procedure UseInches;
  end;

implementation
uses RichViewActions, PtblRV;

{$R *.dfm}

{------------------------------------------------------------------------------}
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;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.FormCreate(Sender: TObject);
begin
  _gbMargins      := gbMargins;
  _cbMirrorMargins := cbMirrorMargins;
  _cbHOnFirstPage := cbHOnFirstPage;
  _cbFOnFirstPage := cbFOnFirstPage;
  _cmbSize        := cmbSize;
  _cmbSource      := cmbSource;
  _txtHText       := txtHText;
  _txtFText       := txtFText;
  inherited;
  FHeaderFont := TFont.Create;
  FHeaderFont.Assign(RVA_HeaderInfo.Font);
  FFooterFont := TFont.Create;
  FFooterFont.Assign(RVA_FooterInfo.Font);
end;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.FormDestroy(Sender: TObject);
begin
  inherited;
  FHeaderFont.Free;
  FFooterFont.Free;
end;
{------------------------------------------------------------------------------}
function TfrmRVPageSetup.Init: Boolean;
var ADevice, ADriver, APort: array[0..79] of Char;
    ADeviceMode: THandle;
    DevMode: PDeviceMode;
    i, BinCount, PaperCount: 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
        XBoxItemsAddObject(_cmbSource, BinNames[i], TObject(BinCodes[i]), True);
      if (DevMode.dmFields and DM_DEFAULTSOURCE)<>0 then begin
        for i := 0 to BinCount-1 do
          if BinCodes[i]=Word(DevMode.dmDefaultSource) then
            SetXBoxItemIndex(_cmbSource, 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
        XBoxItemsAddObject(_cmbSize, PaperNames[i], TObject(PaperCodes[i]), True);
      if (DevMode.dmFields and DM_PAPERSIZE)<>0 then begin
        for i := 0 to PaperCount-1 do
          if PaperCodes[i]=Word(DevMode.dmPaperSize) then
            SetXBoxItemIndex(_cmbSize, i);
      end;
    finally
      FreeMem(PaperNames);
      FreeMem(PaperCodes);
    end;
  finally
    GlobalUnlock(ADeviceMode);
  end;

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

  if not FInches then begin
    seLeft.Value   := RVA_RVPrint.LeftMarginMM;
    seRight.Value  := RVA_RVPrint.RightMarginMM;
    seTop.Value    := RVA_RVPrint.TopMarginMM;
    seBottom.Value := RVA_RVPrint.BottomMarginMM;
    end
  else begin
    seLeft.Value   := RVA_RVPrint.LeftMarginMM*5/127;
    seRight.Value  := RVA_RVPrint.RightMarginMM*5/127;
    seTop.Value    := RVA_RVPrint.TopMarginMM*5/127;
    seBottom.Value := RVA_RVPrint.BottomMarginMM*5/127;
  end;
  SetCheckBoxChecked(_cbMirrorMargins, RVA_RVPrint.MirrorMargins);

  with RVA_HeaderInfo do begin
    SetControlCaption(_txtHText, Text);
    SetCheckBoxChecked(_cbHOnFirstPage, PrintOnFirstPage);
    case Alignment of
      taLeftJustify:
        rbHLeft.Checked := True;
      taRightJustify:
        rbHRight.Checked := True;
      taCenter:
        rbHCenter.Checked := True;
    end;
    GetEditFont(_txtHText).Assign(Font);
    GetEditFont(_txtHText).Size := 8;
  end;
  with RVA_FooterInfo do begin
    SetControlCaption(_txtFText, Text);
    SetCheckBoxChecked(_cbFOnFirstPage, PrintOnFirstPage);
    case Alignment of
      taLeftJustify:
        rbFLeft.Checked := True;
      taRightJustify:
        rbFRight.Checked := True;
      taCenter:
        rbFCenter.Checked := True;
    end;
    GetEditFont(_txtFText).Assign(Font);
    GetEditFont(_txtFText).Size := 8;
  end;
  seStartFrom.Value := RVA_FirstPageNumber;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.Apply;
var ADevice, ADriver, APort: array[0..79] of Char;
    ADeviceMode: THandle;
    DevMode: PDeviceMode;

    function GetSeValue(se: TRVSpinEdit): Integer;
    begin
      if FInches then
        Result := Round(se.Value*127/5)
      else
        Result := se.AsInteger
    end;
begin
  if not seLeft.Indeterminate then
    RVA_RVPrint.LeftMarginMM := GetSeValue(seLeft);
  if not seRight.Indeterminate then
    RVA_RVPrint.RightMarginMM := GetSeValue(seRight);
  if not seTop.Indeterminate then
    RVA_RVPrint.TopMarginMM := GetSeValue(seTop);
  if not seBottom.Indeterminate then
    RVA_RVPrint.BottomMarginMM := GetSeValue(seBottom);
  RVA_RVPrint.MirrorMargins := GetCheckBoxChecked(_cbMirrorMargins);

  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 GetXBoxItemIndex(_cmbSize)>=0 then begin
      DevMode.dmPaperSize := Integer(GetXBoxObject(_cmbSize, GetXBoxItemIndex(_cmbSize)));
      DevMode.dmFields := DevMode.dmFields or DM_PAPERSIZE;
    end;
    if GetXBoxItemIndex(_cmbSource)>=0 then begin
      DevMode.dmDefaultSource := Integer(GetXBoxObject(_cmbSource, GetXBoxItemIndex(_cmbSource)));
      DevMode.dmFields := DevMode.dmFields or DM_DEFAULTSOURCE;
    end;
  finally
    GlobalUnlock(ADeviceMode);
  end;
  Printer.SetPrinter(ADevice,ADriver,APort,ADeviceMode);

  with RVA_HeaderInfo do begin
    Text := GetEditText(_txtHText);
    PrintOnFirstPage := GetCheckBoxChecked(_cbHOnFirstPage);
    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 RVA_FooterInfo do begin
    Text := GetEditText(_txtFText);
    PrintOnFirstPage := GetCheckBoxChecked(_cbFOnFirstPage);
    if rbFLeft.Checked then
      Alignment := taLeftJustify
    else if rbFRight.Checked then
      Alignment := taRightJustify
    else if rbFCenter.Checked then
      Alignment := taCenter;
    Font.Assign(FFooterFont);
  end;
  RVA_FirstPageNumber := seStartFrom.AsInteger;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.btnHFontClick(Sender: TObject);
begin
  fd.Font := FHeaderFont;
  if fd.Execute then begin
    FHeaderFont.Assign(fd.Font);
    GetEditFont(_txtHText).Assign(fd.Font);
    GetEditFont(_txtHText).Size := 8;
  end;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.btnFFontClick(Sender: TObject);
begin
  fd.Font := FFooterFont;
  if fd.Execute then begin
    FFooterFont.Assign(fd.Font);
    GetEditFont(_txtFText).Assign(fd.Font);
    GetEditFont(_txtFText).Size := 8;
  end;
end;
{------------------------------------------------------------------------------}
procedure TfrmRVPageSetup.Localize;
begin
  inherited;
  btnOk.Caption     := RVA_GetS(rvam_btn_OK);
  btnCancel.Caption := RVA_GetS(rvam_btn_Cancel);
  Caption           := {$IFDEF USERVTNT}_GetWideString{$ENDIF}(RVA_GetS(rvam_pg_Title));
  tsPage.Caption    := RVA_GetSH(rvam_pg_PageTab);
  tsHF.Caption      := RVA_GetSH(rvam_pg_HFTab);

  gbMargins.Caption := RVA_GetSH(rvam_pg_MarginsMM);
  lblLeft.Caption   := RVA_GetS(rvam_pg_Left);
  lblTop.Caption    := RVA_GetS(rvam_pg_Top);
  lblRight.Caption  := RVA_GetS(rvam_pg_Right);
  lblBottom.Caption := RVA_GetS(rvam_pg_Bottom);
  cbMirrorMargins.Caption := RVA_GetS(rvam_pg_MirrorMargins);

  rgOrientation.Caption := RVA_GetSH(rvam_pg_Orientation);
  rgOrientation.Items[0].Caption := RVA_GetS(rvam_pg_Portrait);
  rgOrientation.Items[1].Caption := RVA_GetS(rvam_pg_Landscape);

  gbPaper.Caption   := RVA_GetSH(rvam_pg_Paper);
  lblSize.Caption   := RVA_GetS(rvam_pg_Size);
  lblSource.Caption := RVA_GetS(rvam_pg_Source);

  gbHeader.Caption  := RVA_GetSH(rvam_pg_Header);
  lblHText.Caption  := RVA_GetS(rvam_pg_HText);
  cbHOnFirstPage.Caption := RVA_GetS(rvam_pg_HOnFirstPage);
  btnHFont.Caption  := RVA_GetS(rvam_pg_HFont);
  rbHLeft.Caption   := RVA_GetS(rvam_pg_HLeft);
  rbHCenter.Caption := RVA_GetS(rvam_pg_HCenter);
  rbHRight.Caption  := RVA_GetS(rvam_pg_HRight);

  gbFooter.Caption  := RVA_GetSH(rvam_pg_Footer);
  lblFText.Caption  := RVA_GetS(rvam_pg_FText);
  cbFOnFirstPage.Caption := RVA_GetS(rvam_pg_FOnFirstPage);
  btnFFont.Caption  := RVA_GetS(rvam_pg_FFont);
  rbFLeft.Caption   := RVA_GetS(rvam_pg_FLeft);
  rbFCenter.Caption := RVA_GetS(rvam_pg_FCenter);
  rbFRight.Caption  := RVA_GetS(rvam_pg_FRight);

  gbNumbers.Caption := RVA_GetSH(rvam_pg_PageNumbers);
  lblStartFrom.Caption := RVA_GetS(rvam_pg_StartFrom);
  lblCodes.Caption  := RVA_GetS(rvam_pg_Codes);
end;

{$IFDEF RVASKINNED}
procedure TfrmRVPageSetup.OnCreateThemedControl(OldControl,
  NewControl: TControl);
begin
  if OldControl=_gbMargins then
    _gbMargins := NewControl
  else if OldControl=_cbMirrorMargins then
    _cbMirrorMargins := NewControl
  else if OldControl=_cbHOnFirstPage then
    _cbHOnFirstPage := NewControl
  else if OldControl=_cbFOnFirstPage then
    _cbFOnFirstPage := NewControl
  else if OldControl=_cmbSize then
    _cmbSize := NewControl
  else if OldControl=_cmbSource then
    _cmbSource := NewControl
  else if OldControl=_txtHText then
    _txtHText := NewControl
  else if OldControl=_txtFText then
    _txtFText := NewControl;
end;
{$ENDIF}

procedure TfrmRVPageSetup.UseInches;

  procedure ChSE(se: TRVSpinEdit);
  begin
    se.IntegerValue := False;
    se.MaxValue := 40;
    se.Increment := 0.01;
    se.Digits := 3;
  end;

begin
  SetControlCaption(_gbMargins, RVA_GetSH(rvam_pg_MarginsInch));
  ChSE(seTop);
  ChSE(seBottom);
  ChSE(seRight);
  ChSE(seLeft);
  FInches := True;
end;

end.