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

📄 rm_prvdlg.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 2 页
字号:

{*****************************************}
{                                         }
{             Report Machine v2.0         }
{             Report preview Dlg          }
{                                         }
{*****************************************}

unit RM_PrvDlg;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, RM_Const, RM_View, RM_Class, RM_common, RM_e_xls
{$IFDEF Delphi4}, ImgList{$ENDIF}
{$IFDEF USE_TB2K}
  , TB2Item, TB2Dock, TB2Toolbar
{$ELSE}
{$IFDEF USE_INTERNALTB97}
  , RM_TB97Ctls, RM_TB97Tlbr, RM_TB97
{$ELSE}
  , TB97Ctls, TB97Tlbr, TB97
{$ENDIF}
{$ENDIF};

type
  TRMPreviewForm = class(TForm)
    ProcMenu: TPopupMenu;
    itmScale200: TMenuItem;
    itmScale150: TMenuItem;
    itmScale100: TMenuItem;
    itmScaale75: TMenuItem;
    itmScale50: TMenuItem;
    itmScale25: TMenuItem;
    itmScale10: TMenuItem;
    itmPageWidth: TMenuItem;
    itmOnePage: TMenuItem;
    itmDoublePage: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    ImageList1: TImageList;
    N1: TMenuItem;
    itmNewPage: TMenuItem;
    itmDeletePage: TMenuItem;
    itmEditPage: TMenuItem;
    N4: TMenuItem;
    itmPrint: TMenuItem;
    itmPrintCurrentPage: TMenuItem;
    InsertBefore1: TMenuItem;
    InsertAfter1: TMenuItem;
    N2: TMenuItem;
    Append1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure itmScale10Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure itmDeletePageClick(Sender: TObject);
    procedure itmEditPageClick(Sender: TObject);
    procedure ProcMenuPopup(Sender: TObject);
    procedure itmPrintCurrentPageClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Append1Click(Sender: TObject);
    procedure InsertBefore1Click(Sender: TObject);
    procedure InsertAfter1Click(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
  private
    { Private declarations }
    Dock971: TRMDock;
    Dock972: TRMDock;
    ToolbarStand: TRMToolbar;
    btnAutoScale: TRMToolbarButton;
    btnOnePage: TRMToolbarButton;
    BtnExit: TRMToolbarButton;
    btn100: TRMToolbarButton;
    btnPageSetup: TRMToolbarButton;
    btnPageWidth: TRMToolbarButton;
    ToolbarSep972: TRMToolbarSep;
    btnPrint: TRMToolbarButton;
    ToolbarSep973: TRMToolbarSep;
    btnTop: TRMToolbarButton;
    btnSave: TRMToolbarButton;
    btnPrev: TRMToolbarButton;
    btnOpen: TRMToolbarButton;
    btnNext: TRMToolbarButton;
    btnLast: TRMToolbarButton;
    btnFind: TRMToolbarButton;
    btnSaveToXLS: TRMToolbarButton;
    btnDesign: TRMToolbarButton;
    ToolbarSep974: TRMToolbarSep;
    ToolbarSep975: TRMToolbarSep;
    tbLine: TRMToolbarSep;
    ToolbarSep971: TRMToolbarSep;
    cmbZoom: TComboBox;
    edtPageNo: TRMEdit;

    FDoc: Pointer;
    FViewer: TRMPreview;
    FXLSExport: TRMXLSExport;

    procedure btnTopClick(Sender: TObject);
    procedure btnPrevClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure btn100Click(Sender: TObject);
    procedure btnOnePageClick(Sender: TObject);
    procedure btnPageWidthClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure btnPageSetupClick(Sender: TObject);
    procedure btnAutoScaleClick(Sender: TObject);
    procedure BtnExitClick(Sender: TObject);
    procedure btnDesignClick(Sender: TObject);
    procedure CmbZoomKeyPress(Sender: TObject; var Key: Char);
    procedure CmbZoomClick(Sender: TObject);
    procedure edtPageNoKeyPress(Sender: TObject; var Key: Char);
    procedure btnSaveToXLSClick(Sender: TObject);

    procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
    procedure OnStatusChange(Sender: TObject);
    procedure OnPageChanged(Sender: TObject);
    procedure Localize;
  public
    { Public declarations }
    procedure Show_Modal(ADoc: Pointer);
    property Viewer: TRMPreview read FViewer;
    property Report: Pointer read FDoc;
  end;

implementation

{$R *.DFM}

uses Printers, RM_Prntr, RM_PrDlg, RM_Utils, RM_CmpReg;

var
  LastScale: Double = 1;
  LastScaleMode: TRMScaleMode = mdNone;
  LastAutoScale: Boolean = False;

procedure TRMPreviewForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(itmPageWidth, 'Caption', rmRes + 020);
  RMSetStrProp(itmOnePage, 'Caption', rmRes + 021);
  RMSetStrProp(itmDoublePage, 'Caption', rmRes + 022);
  RMSetStrProp(itmNewPage, 'Caption', rmRes + 030);
  RMSetStrProp(itmDeletePage, 'Caption', rmRes + 031);
  RMSetStrProp(itmEditPage, 'Caption', rmRes + 029);
  RMSetStrProp(itmPrint, 'Caption', rmRes + 1866);
  RMSetStrProp(itmPrintCurrentPage, 'Caption', rmRes + 376);
  RMSetStrProp(InsertBefore1, 'Caption', rmRes + 1867);
  RMSetStrProp(InsertAfter1, 'Caption', rmRes + 1868);
  RMSetStrProp(Append1, 'Caption', rmRes + 1869);

  RMSetStrProp(btnOpen, 'Hint', rmRes + 025);
  RMSetStrProp(btnSave, 'Hint', rmRes + 026);
  RMSetStrProp(btnPrint, 'Hint', rmRes + 027);
  RMSetStrProp(btnFind, 'Hint', rmRes + 028);
  RMSetStrProp(btnOnePage, 'Hint', rmRes + 1858);
  RMSetStrProp(btnPageWidth, 'Hint', rmRes + 1857);
  RMSetStrProp(btnTop, 'Hint', rmRes + 32);
  RMSetStrProp(btnPrev, 'Hint', rmRes + 33);
  RMSetStrProp(btnNext, 'Hint', rmRes + 34);
  RMSetStrProp(btnLast, 'Hint', rmRes + 35);
  RMSetStrProp(btnPageSetup, 'Hint', rmRes + 24);
  RMSetStrProp(btnExit, 'Hint', rmRes + 23);
  RMSetStrProp(cmbZoom, 'Hint', rmRes + 7);
  RMSetStrProp(btnAutoScale, 'Hint', rmRes + 8);
  RMSetStrProp(btnSaveToXLS, 'Hint', rmRes + 9);
  RMSetStrProp(btnDesign, 'Hint', rmRes + 10);
  RMSetStrProp(ToolbarStand, 'Caption', rmRes + 11);
end;

procedure TRMPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FormStyle <> fsMDIChild then
  begin
    RMSaveFormPosition(Self);
    RMSaveToolbars([ToolbarStand]);
  end;
  Action := caFree;
end;

procedure TRMPreviewForm.Show_Modal(ADoc: Pointer);
begin
  FDoc := ADoc;
  FViewer.Connect(ADoc);

  OpenDialog.InitialDir := FViewer.InitialDir;
  SaveDialog.InitialDir := FViewer.InitialDir;
  N4.Visible := RMDesignerClass <> nil;
  itmNewPage.Visible := N4.Visible;
  itmDeletePage.Visible := N4.Visible;
  itmEditPage.Visible := N4.Visible;

  if not (csDesigning in TRMReport(ADoc).ComponentState) then
  begin
    cmbZoom.Visible := pbZoom in TRMReport(ADoc).PreviewButtons;
    if not cmbZoom.Visible then tbLine.Free;

    btnFind.Visible := pbFind in TRMReport(ADoc).PreviewButtons;
    ToolbarSep972.Visible := btnFind.Visible;

    btnOpen.Visible := pbLoad in TRMReport(ADoc).PreviewButtons;
    btnSave.Visible := pbSave in TRMReport(ADoc).PreviewButtons;
    btnSaveToXLS.Visible := pbSavetoXLS in TRMReport(ADoc).PreviewButtons;
    btnPrint.Visible := pbPrint in TRMReport(ADoc).PreviewButtons;
    btnPageSetup.Visible := pbPageSetup in TRMReport(ADoc).PreviewButtons;
    ToolbarSep975.Visible := btnOpen.Visible or btnSave.Visible or btnPrint.Visible or
      btnPageSetup.Visible or btnSaveToXLS.Visible;

    btnDesign.Visible := pbDesign in TRMReport(FDoc).PreviewButtons;
    ToolbarSep971.Visible := btnDesign.Visible;

    btnExit.Visible := pbExit in TRMReport(ADoc).PreviewButtons;
    ToolbarSep973.Visible := btnExit.Visible;

    itmPrint.Visible := btnPrint.Visible;
    itmPrintCurrentPage.Visible := btnPrint.Visible;
  end;

  case TRMReport(ADoc).InitialZoom of
    pzPageWidth: btnPageWidth.Down := TRUE;
    pzOnePage: btnOnePage.Down := TRUE;
  else
    FViewer.LastScale := LastScale;
    FViewer.ZoomMode := LastScaleMode;
//    btn100.Down := TRUE;
  end;

  FViewer.AutoScale := LastAutoScale;
  btnAutoScale.Down := FViewer.AutoScale;
  btnPrint.Enabled := RMPrinters.Count > 2; // Printer.Printers.Count > 0;

  if btnPageWidth.Down then
    cmbZoom.ItemIndex := 7
  else if btnOnePage.Down then
    cmbZoom.ItemIndex := 8
  else if btn100.Down then
    cmbZoom.ItemIndex := 2
  else
    cmbZoom.Text := IntToStr(Round(FViewer.Zoom)) + '%';

  if TRMReport(ADoc).ModalPreview and (not TRMReport(ADoc).MDIPreview) then
    ShowModal
  else
    Show;
end;

procedure TRMPreviewForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
  with Msg.MinMaxInfo^ do
  begin
    ptMaxSize.x := Screen.Width;
    ptMaxSize.y := Screen.Height;
    ptMaxPosition.x := 0;
    ptMaxPosition.y := 0;
  end;
end;

procedure TRMPreviewForm.btnTopClick(Sender: TObject);
begin
  FViewer.First;
end;

procedure TRMPreviewForm.btnPrevClick(Sender: TObject);
begin
  FViewer.Prev;
end;

procedure TRMPreviewForm.btnNextClick(Sender: TObject);
begin
  FViewer.Next;
end;

procedure TRMPreviewForm.btnLastClick(Sender: TObject);
begin
  FViewer.Last;
end;

procedure TRMPreviewForm.btn100Click(Sender: TObject);
begin
  FViewer.Zoom := 100;
  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.btnOnePageClick(Sender: TObject);
begin
  FViewer.OnePage;
  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.btnPageWidthClick(Sender: TObject);
begin
  FViewer.PageWidth;
  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.itmScale10Click(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    case Tag of
      1: FViewer.PageWidth;
      2: FViewer.OnePage;
      3: FViewer.TwoPages;
    else
      FViewer.Zoom := Tag;
    end;
    Checked := True;
  end;

  if btnPageWidth.Down then
    cmbZoom.ItemIndex := 7
  else if btnOnePage.Down then
    cmbZoom.ItemIndex := 8
  else if btn100.Down then
    cmbZoom.ItemIndex := 2
  else
    cmbZoom.Text := IntToStr(Round(FViewer.Zoom)) + '%';

  LastScale := FViewer.LastScale;
  LastScaleMode := FViewer.ZoomMode;
end;

procedure TRMPreviewForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if FViewer.Doc = nil then Exit;
  if Key in [vk_Up, vk_Down, vk_Prior, vk_Next] then
    if FViewer.VScrollBar.Enabled then FViewer.VScrollBar.SetFocus;
  if Key in [vk_Left, vk_Right] then
    if FViewer.HScrollBar.Enabled then FViewer.HScrollBar.SetFocus;
  if Key = vk_Up then
    FViewer.VScrollBar.Position := FViewer.VScrollBar.Position - FViewer.VScrollBar.SmallChange
  else if Key = vk_Down then
    FViewer.VScrollBar.Position := FViewer.VScrollBar.Position + FViewer.VScrollBar.SmallChange
  else if Key = vk_Left then
    FViewer.HScrollBar.Position := FViewer.HScrollBar.Position - FViewer.HScrollBar.SmallChange
  else if Key = vk_Right then
    FViewer.HScrollBar.Position := FViewer.HScrollBar.Position + FViewer.HScrollBar.SmallChange
  else if Key = vk_Prior then
  begin
    if ssCtrl in Shift then
      btnPrev.Click
    else
      FViewer.VScrollBar.Position := FViewer.VScrollBar.Position - FViewer.VScrollBar.LargeChange;
  end
  else if Key = vk_Next then
  begin
    if ssCtrl in Shift then
      btnNext.Click
    else
      FViewer.VScrollBar.Position := FViewer.VScrollBar.Position + FViewer.VScrollBar.LargeChange;
  end
  else if Key = vk_Escape then
    btnExit.Click
  else if Key = vk_Home then
  begin
    if ssCtrl in Shift then
      FViewer.VScrollBar.Position := 0
    else
      Exit;
  end
  else if Key = vk_End then
  begin
    if ssCtrl in Shift then
      btnLast.Click
    else
      Exit;
  end
  else if ssCtrl in Shift then
  begin
    if (ssAlt in Shift) and (Chr(Key) = 'P') and btnPrint.Enabled then
      FViewer.PrintCurrentPage
    else if Chr(Key) = 'O' then btnOpen.Click
    else if Chr(Key) = 'S' then btnSave.Click
    else if (Chr(Key) = 'P') and btnPrint.Enabled then btnPrint.Click
    else if Chr(Key) = 'F' then btnFind.Click
    else if (Chr(Key) = 'E') and itmEditPage.Visible then itmEditPage.Click;
  end
  else if Key = vk_F3 then
  begin
    if FViewer.FindStr <> '' then
    begin
      if FViewer.LastFoundPage <> FViewer.CurPage - 1 then
      begin
        FViewer.LastFoundPage := FViewer.CurPage - 1;
        FViewer.LastFoundObject := 0;
      end;
      FViewer.FindNext;
    end;
  end
  else
    Exit;

  Key := 0;
end;

procedure TRMPreviewForm.btnOpenClick(Sender: TObject);
begin
  if FViewer.Doc = nil then
    Exit;

  OpenDialog.Filter := RMLoadStr(SRepFile) + ' (*.rmp)|*.rmp';
  with OpenDialog do
  begin
    if Execute then
    begin
      FViewer.LoadFromFiles(OpenDialog.Files{FileName});
      Self.Caption := RMLoadStr(SPreview) + ' - ' + ExtractFileName(FileName);
    end;
  end;
end;

procedure TRMPreviewForm.btnSaveClick(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  if FViewer.Doc = nil then
    Exit;

  s := RMLoadStr(SRepFile) + ' (*.rmp)|*.rmp';
  for i := 0 to RMFiltersCount - 1 do
    s := s + '|' + RMFilters(i).FilterDesc + '|' + RMFilters(i).FilterExt;

  SaveDialog.Filter := s;
  SaveDialog.FilterIndex := 1;
  if SaveDialog.Execute then
  begin
    FViewer.SaveToFile(SaveDialog.FileName, SaveDialog.FilterIndex);
  end;
end;

procedure TRMPreviewForm.btnPrintClick(Sender: TObject);
begin
  FViewer.Print;
end;

procedure TRMPreviewForm.btnFindClick(Sender: TObject);
begin
  FViewer.Find;
end;

procedure TRMPreviewForm.itmDeletePageClick(Sender: TObject);
begin
  FViewer.DeletePage(FViewer.CurPage - 1);
end;

procedure TRMPreviewForm.itmEditPageClick(Sender: TObject);
begin
  FViewer.EditPage(FViewer.CurPage - 1);
end;

procedure TRMPreviewForm.btnPageSetupClick(Sender: TObject);
begin
  FViewer.DlgPageSetup;
end;

procedure TRMPreviewForm.ProcMenuPopup(Sender: TObject);
begin
  if cmbZoom.ItemIndex >= 0 then
    ProcMenu.Items[cmbZoom.ItemIndex].Checked := True
  else
    ProcMenu.Items[2].Checked := True;

  N4.Visible := FViewer.CanModify;
  itmNewPage.Visible := N4.Visible;
  itmDeletePage.Visible := N4.Visible;
  itmEditPage.Visible := N4.Visible;

  itmPrint.Enabled := btnPrint.Enabled;
  itmPrintCurrentPage.Enabled := btnPrint.Enabled;
end;

procedure TRMPreviewForm.btnAutoScaleClick(Sender: TObject);

⌨️ 快捷键说明

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