⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_pagesetup.pas

📁 这是一个功能强大
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  PaperChange;
end;

procedure TRMPageSetupForm.PaperChange;
begin
  if FUpdating then Exit;

  FUpdating := True;
  try
    rdbPortrait.Checked := (FPageSetting.PageOr = rmpoPortrait);
    rdbLandscape.Checked := (FPageSetting.PageOr = rmpoLandscape);
    imgPortrait.Visible := rdbPortrait.Checked;
    imgLandScape.Visible := not rdbPortrait.Checked;

    FSpinPaperWidth.Value := FPageSetting.PageWidth / 100;
    FSpinPaperHeight.Value := FPageSetting.PageHeight / 100;

    lstBinNames.ItemIndex := FPrinterInfo.GetBinIndex(FPageSetting.PageBin);
    cmbPaperNames.ItemIndex := FPrinterInfo.GetPaperSizeIndex(FPageSetting.PageSize);

    RMEnableControls([FSpinPaperWidth, FSpinPaperHeight],
      cmbPaperNames.ItemIndex = cmbPaperNames.Items.Count - 1);
    if FSpinPaperWidth.Enabled then
    begin
      OnPagerWidthExitEvent(nil);
    end;

    FPreviewPage.DrawPage;
  finally
    FUpdating := False;
  end;
end;

procedure TRMPageSetupForm.FormCreate(Sender: TObject);
begin
	FCurReport := nil;
  Localize;
  FPageSetting := TRMPageSetting.Create;

  FSpinPaperWidth := TRMSpinEdit.Create(Self);
  with FSpinPaperWidth do
  begin
    Parent := TabSheet1;
    SetBounds(lblPaperWidth.BoundsRect.Right + 2, lblPaperWidth.Top, 86, 21);
    ValueType := rmvtFloat;
    OnExit := OnPagerWidthExitEvent;
    OnTopClick := OnPagerWidthExitEvent;
    OnBottomClick := OnPagerWidthExitEvent;
  end;
  FSpinPaperHeight := TRMSpinEdit.Create(Self);
  with FSpinPaperHeight do
  begin
    Parent := TabSheet1;
    SetBounds(FSpinPaperWidth.Left, lblPaperHeight.Top, 86, 21);
    ValueType := rmvtFloat;
    OnExit := OnPagerWidthExitEvent;
    OnTopClick := OnPagerWidthExitEvent;
    OnBottomClick := OnPagerWidthExitEvent;
  end;

  FSpinMarginTop := TRMSpinEdit.Create(Self);
  with FSpinMarginTop do
  begin
    Parent := GroupBox3;
    SetBounds(120, lblMarginTop.Top, GroupBox3.Width - 120 -4, 21);
    ValueType := rmvtFloat;
    MinValue := -MaxInt;
    Increment := 0.1;
    OnBottomClick := OnMarginExitEvent;
    OnTopClick := OnMarginExitEvent;
    OnExit := OnMarginExitEvent;
  end;
  FSpinMarginBottom := TRMSpinEdit.Create(Self);
  with FSpinMarginBottom do
  begin
    Parent := GroupBox3;
    SetBounds(FSpinMarginTop.Left, lblMarginBottom.Top, FSpinMarginTop.Width, 21);
    ValueType := rmvtFloat;
    MinValue := -MaxInt;
    Increment := 0.1;
    OnBottomClick := OnMarginExitEvent;
    OnTopClick := OnMarginExitEvent;
    OnExit := OnMarginExitEvent;
  end;
  FSpinMarginLeft := TRMSpinEdit.Create(Self);
  with FSpinMarginLeft do
  begin
    Parent := GroupBox3;
    SetBounds(FSpinMarginTop.Left, lblMarginLeft.Top, FSpinMarginTop.Width, 21);
    ValueType := rmvtFloat;
    MinValue := -MaxInt;
    Increment := 0.1;
    OnBottomClick := OnMarginExitEvent;
    OnTopClick := OnMarginExitEvent;
    OnExit := OnMarginExitEvent;
  end;
  FSpinMarginRight := TRMSpinEdit.Create(Self);
  with FSpinMarginRight do
  begin
    Parent := GroupBox3;
    SetBounds(FSpinMarginTop.Left, lblMarginRight.Top, FSpinMarginTop.Width, 21);
    ValueType := rmvtFloat;
    MinValue := -MaxInt;
    Increment := 0.1;
    OnBottomClick := OnMarginExitEvent;
    OnTopClick := OnMarginExitEvent;
    OnExit := OnMarginExitEvent;
  end;

  FSpinColCount := TRMSpinEdit.Create(Self);
  with FSpinColCount do
  begin
    Parent := GroupBox5;
    SetBounds(FSpinMarginTop.Left, lblColCount.Top,
       FSpinMarginTop.Width, 21);
    MinValue := 1;
    OnExit := OnMarginExitEvent;
  end;
  FSpinColGap := TRMSpinEdit.Create(Self);
  with FSpinColGap do
  begin
    Parent := GroupBox5;
    SetBounds(FSpinColCount.Left, lblColGap.Top, FSpinColCount.Width, 21);
    ValueType := rmvtFloat;
    MinValue := -MaxInt;
    Increment := 0.1;
    OnExit := OnMarginExitEvent;
  end;

  FForm := Self;
  FPreviewPage := TRMPageImage.Create(Self);
  grbPreview.InsertControl(FPreviewPage);
  with FPreviewPage do
  begin
    Left := 5;
    Top := 20;
    Width := grbPreview.Width - 10;
    Height := grbPreview.Height - 30;
  end;

  PageControl1.ActivePage := TabSheet1;
end;

procedure TRMPageSetupForm.FormShow(Sender: TObject);
begin
  if FPageSetting.ColCount < 1 then
    FPageSetting.ColCount := 1;

  cmbPrinterNames.Items.Assign(RMPrinters.Printers);
  cmbPrinterNames.ItemIndex := FCurPrinter{RMPrinter}.PrinterIndex;
  edtTitle.Text := FPageSetting.Title;
  PrinterChange;
end;

procedure TRMPageSetupForm.cmbPrinterNamesChange(Sender: TObject);
begin
  PrinterChange;
end;

procedure TRMPageSetupForm.cmbPaperNamesChange(Sender: TObject);
var
  index: Integer;
begin
  index := cmbPaperNames.ItemIndex;
  if Index < 0 then
    Exit;
  FPageSetting.PageSize := FPrinterInfo.PaperSizes[index];
  if Index <> cmbPaperNames.Items.Count - 1 then
  begin
    with FPrinterInfo do
    begin
      if FPageSetting.PageOr = rmpoPortrait then
      begin
        FPageSetting.PageWidth := PaperWidths[index];
        FPageSetting.PageHeight := PaperHeights[index];
      end
      else
      begin
        FPageSetting.PageWidth := PaperHeights[index];
        FPageSetting.PageHeight := PaperWidths[index];
      end;
    end;
  end;

  PaperChange;
end;

procedure TRMPageSetupForm.rdbPortraitClick(Sender: TObject);
begin
  if rdbPortrait.Checked then
    FPageSetting.PageOr := rmpoPortrait
  else
    FPageSetting.PageOr := rmpoLandscape;

  PaperChange;
end;

procedure TRMPageSetupForm.OnPagerWidthExitEvent(Sender: TObject);
begin
  if ActiveControl <> btnCancel then
  begin
    FPageSetting.PageWidth := Round(FSpinPaperWidth.Value * 100);
    FPageSetting.PageHeight := Round(FSpinPaperHeight.Value * 100);
    PaperChange;
  end;
end;

procedure TRMPageSetupForm.OnMarginExitEvent(Sender: TObject);
begin
  if ActiveControl <> btnCancel then
  begin
    if FUpdating then Exit;

    FUpdating := True;
    try
      FPreviewPage.DrawPage;
    finally
      FUpdating := False;
    end;
  end;
end;

procedure TRMPageSetupForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  liLeft, liTop, liRight, liBottom: Double;
  liPrnInfo: TRMPageInfo;

  function dm(pxls: integer; mmInInch: integer): Double;
  begin
    Result := Round((pxls / RMInchPerMM / mmInInch) * 10) / 10;
  end;

begin
  if ModalResult = mrOK then
  begin
    try
      FCurPrinter{RMPrinter}.PrinterIndex := cmbPrinterNames.ItemIndex;
      FCurPrinter{RMPrinter}.SetPrinterInfo(FPageSetting.PageSize, FPageSetting.PageWidth, FPageSetting.PageHeight,
        FPageSetting.PageBin, FPageSetting.PageOr, False);
      FCurPrinter{RMPrinter}.FillPrinterInfo(liPrnInfo);

      liLeft := dm(FCurPrinter{RMPrinter}.PageGutters.Left, FCurPrinter{RMPrinter}.PixelsPerInch.X);
      liTop := dm(RMPrinter.PageGutters.Top, FCurPrinter{RMPrinter}.PixelsPerInch.Y);
      liRight := dm(FCurPrinter{RMPrinter}.PageGutters.Right, FCurPrinter{RMPrinter}.PixelsPerInch.X);
      liBottom := dm(FCurPrinter{RMPrinter}.PageGutters.Bottom, FCurPrinter{RMPrinter}.PixelsPerInch.Y);

      if (FPageSetting.MarginLeft < liLeft) or (FPageSetting.MarginTop < liTop) or
        (FPageSetting.MarginRight < liRight) or (FPageSetting.MarginBottom < liBottom) then
      begin
        if ((FPageSetting.MarginLeft - liLeft) < 0.01) or ((FPageSetting.MarginTop - liTop) < 0.01) or
          ((FPageSetting.MarginRight - liRight) < 0.01) or ((FPageSetting.MarginBottom - liBottom) < 0.01) then
        begin
          if Application.MessageBox(PChar(RMLoadStr(rmRes + 213)), PChar(RMLoadStr(SWarning)),
            MB_ICONEXCLAMATION + MB_YESNO) = IDYES then
          begin
            if FPageSetting.MarginLeft < liLeft then
              FPageSetting.MarginLeft := liLeft + 2.5;
            if FPageSetting.MarginTop < liTop then
              FPageSetting.MarginTop := liTop + 2.5;
            if FPageSetting.MarginRight < liRight then
              FPageSetting.MarginRight := liRight + 2.5;
            if FPageSetting.MarginBottom < liBottom then
              FPageSetting.MarginBottom := liBottom + 2.5;
          end;
        end;
      end;
    except
    end;
  end;
end;

procedure TRMPageSetupForm.edtTitleExit(Sender: TObject);
begin
  if ActiveControl <> btnCancel then
    FPageSetting.Title := edtTitle.Text;
end;

procedure TRMPageSetupForm.FormDestroy(Sender: TObject);
begin
  FPageSetting.Free;
end;

procedure TRMPageSetupForm.lstBinNamesClick(Sender: TObject);
begin
  if lstBinNames.ItemIndex >= 0 then
    FPageSetting.PageBin := FPrinterInfo.Bins[lstBinNames.ItemIndex];
end;

procedure TRMPageSetupForm.btnOKClick(Sender: TObject);
begin
  FPageSetting.PrintToPrevPage := chkPrintToPrevPage.Checked;
  FPageSetting.DoublePass := chkDoublePass.Checked;
  FPageSetting.PrintBackGroundPicture := chkTaoda.Checked;
  FPageSetting.ColorPrint := chkColorPrint.Checked;
  FPageSetting.NewPageAfterPrint := chkNewPage.Checked;
  FPageSetting.ConvertNulls := chkConvertNulls.Checked;
  FPageSetting.UnlimitedHeight := chkUnlimitedHeight.Checked;

  FPageSetting.MarginLeft := FSpinMarginLeft.Value * 10;
  FPageSetting.MarginTop := FSpinMarginTop.Value * 10;
  FPageSetting.MarginRight := FSpinMarginRight.Value * 10;
  FPageSetting.MarginBottom := FSpinMarginBottom.Value * 10;

  FPageSetting.ColCount := FSpinColCount.AsInteger;
  FPageSetting.ColGap := FSpinColGap.Value * 10;
end;

procedure TRMPageSetupForm.Init;
begin
  chkPrintToPrevPage.Checked := FPageSetting.PrintToPrevPage;
  chkDoublePass.Checked := FPageSetting.DoublePass;
  chkUnlimitedHeight.Checked := FPageSetting.UnlimitedHeight;
  chkTaoda.Checked := FPageSetting.PrintBackGroundPicture;
  chkColorPrint.Checked := FPageSetting.ColorPrint;
  chkNewPage.Checked := FPageSetting.NewPageAfterPrint;
  chkConvertNulls.Checked := FPageSetting.ConvertNulls;

  FSpinColCount.Value := FPageSetting.ColCount;
  FSpinColGap.Value := FPageSetting.ColGap / 10;

  FSpinMarginTop.Value := FPageSetting.MarginTop / 10;
  FSpinMarginBottom.Value := FPageSetting.MarginBottom / 10;
  FSpinMarginLeft.Value := FPageSetting.MarginLeft / 10;
  FSpinMarginRight.Value := FPageSetting.MarginRight / 10;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -