rm_preview.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,231 行 · 第 1/5 页

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

unit RM_Preview;

interface

{$I RM.inc}
{$R RMACHINE.RES}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, Buttons, ComCtrls, RM_Common, RM_Ctrls
  {$IFDEF Delphi4}, ImgList{$ENDIF};

type
  TRMPreview = class;
  TRMBeforeShowReport = procedure(aReport: TObject) of object;

  { TRMDrawPanel }
  TRMDrawPanel = class(TPanel)
  private
    FSaveEndPage: TObject;
    FSaveFoundView: TObject;
    FSavePageNo: Integer;

    FPreview: TRMPreview;
    FDown, FDoubleClickFlag: Boolean;
    FLastX, FLastY: Integer;
    FInPainting: Boolean;
    FHRulerOffset, FVRulerOffset: Integer;
    FVisiblePages: array of Integer;
    FBusy: Boolean;

    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure DblClick; override;
  end;

  PRMPreviewNodeDataInfo = ^TRMPreviewNodeDataInfo;
  TRMPreviewNodeDataInfo = record
    PageNo: Integer;
    Position: Integer;
  end;

  { TRMPreview }
  TRMPreview = class(TRMCustomPreview)
  private
    FReport: TObject;
    FCurPage: Integer;
    FOffsetLeft, FOffsetTop, FOldVPos, FOldHPos: Integer;
    FScale: Double;
    FZoomMode: TRMScaleMode;
    FPaintAllowed: Boolean;
    FLastScale: Double;
    FSaveReportInfo: TRMReportInfo;

    FScrollBox: TRMScrollBox;
    FStatusBar: TStatusBar;
    FTopPanel1: TPanel;
    FLeftTopPanel: TPanel;
    FLeftPanel: TPanel;
    FTopPanel: TPanel;
    FHRuler, FVRuler: TRMDesignerRuler;
    FDrawPanel: TRMDrawPanel;
    FSplitter: TSplitter;
    FOutlineTreeView: TTreeView;

    FKWheel: Integer;
    FParentForm: TForm;
    FInitialDir: string;

    FOnStatusChange: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    FOnAfterPageSetup: TNotifyEvent;
    FOnBeforeShowReport: TRMBeforeShowReport;

    FStrFound: Boolean;
    FStrBounds: TRect;
    FFindStr: string;
    FCaseSensitive: Boolean;
    FWholewords: Boolean;
    FLastFoundPage, FLastFoundObject: Integer;

    procedure DoStatusChange;
    procedure Connect_1(aReport: TObject);
    procedure SetPage(Value: Integer);
    function GetZoom: Double;
    procedure SetZoom(Value: Double);
    function GetTotalPages: Integer;
    function GetHScrollBar: TRMScrollBar;
    function GetVScrollBar: TRMScrollBar;

    procedure ClearOutLine;
    procedure OnOutlineClickEvent(Sender: TObject);

    procedure FindInEMF(lEmf: TMetafile);
    procedure ShowPageNum;
    procedure SetToCurPage;
    procedure OnResizeEvent(Sender: TObject);
    procedure OnScrollBoxScroll(Sender: TObject; Kind: TRMScrollBarKind);

    {$IFDEF Delphi4}
    procedure OnMouseWheelUpEvent(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure OnMouseWheelDownEvent(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    {$ENDIF}
  protected
    procedure Disconnect;
    function GetEndPages: TObject;
    property OnAfterPageSetup: TNotifyEvent read FOnAfterPageSetup write FOnAfterPageSetup;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function CanModify: Boolean;
    procedure ShowReport(aReport: TObject); override;
    procedure Connect(aReport: TObject); override;

    procedure RedrawAll(ResetPage: Boolean);
    procedure OnePage;
    procedure TwoPages;
    procedure PageWidth;
    procedure PrinterZoom;
    procedure First;
    procedure Next;
    procedure Prev;
    procedure Last;
    procedure LoadFromFile(aFileName: string);
    procedure LoadFromFiles(aFileNames: TStrings);
    procedure SaveToFile(aFileName: string; aIndex: Integer);
    procedure ExportToFile(aExport: TComponent; aFileName: string);
    procedure ExportToXlsFile;
    procedure Print; override;
    procedure PrintCurrentPage;
    procedure DlgPageSetup;
    procedure InsertPageBefore;
    procedure InsertPageAfter;
    procedure AddPage;
    procedure DeletePage(PageNo: Integer);
    function EditPage(PageNo: Integer): Boolean;
    procedure DesignReport;
    procedure Find;
    procedure FindNext;
    procedure ShowOutline(aVisible: Boolean);

    property ParentForm: TForm read FParentForm write FParentForm;
    property KWheel: Integer read FKWheel write FKWheel;
    property Report: TObject read FReport;
    property TotalPages: Integer read GetTotalPages;
    property Zoom: Double read GetZoom write SetZoom;
    property ZoomMode: TRMScaleMode read FZoomMode write FZoomMode;
    property LastScale: Double read FLastScale write FLastScale;
    property ScrollBox: TRMScrollBox read FScrollBox;
    property HScrollBar: TRMScrollBar read GetHScrollBar;
    property VScrollBar: TRMScrollBar read GetVScrollBar;
    property CurPage: Integer read FCurPage write SetPage;
    //    property OutlineTreeView: TTreeView read FOutlineTreeView;

    property FindStr: string read FFindStr write FFindstr;
    property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
    property Wholewords: Boolean read FWholewords write FWholewords;
    property LastFoundPage: Integer read FLastFoundPage write FLastFoundPage;
    property LastFoundObject: Integer read FLastFoundObject write FLastFoundObject;
    property StrFound: Boolean read FStrFound write FStrFound;
    property StrBounds: TRect read FStrBounds write FStrBounds;
  published
    property InitialDir: string read FInitialDir write FInitialDir;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
    property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
    property OnBeforeShowReport: TRMBeforeShowReport read FOnBeforeShowReport write FOnBeforeShowReport;
  end;

  { TRMPreviewForm }
  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;
    N1: TMenuItem;
    itmNewPage: TMenuItem;
    itmDeletePage: TMenuItem;
    itmEditPage: TMenuItem;
    N4: TMenuItem;
    itmPrint: TMenuItem;
    itmPrintCurrentPage: TMenuItem;
    InsertBefore1: TMenuItem;
    InsertAfter1: TMenuItem;
    N2: TMenuItem;
    Append1: TMenuItem;
    ImageList1: TImageList;
    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);
    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 btnShowOutlineClick(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 FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FDoc: Pointer;
    FViewer: TRMPreview;

    Dock971: TRMDock;
    ToolbarStand: TRMToolbar;
    btnOnePage: TRMToolbarButton;
    BtnExit: TRMToolbarButton;
    btn100: TRMToolbarButton;
    ToolbarSep1: TRMToolbarSep;
    btnPageSetup: TRMToolbarButton;
    btnShowOutline: 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: TRMComboBox97;
    edtPageNo: TRMEdit;

    FBtnShowBorder: TRMToolbarButton;
    FBtnBackColor: TRMColorPickerButton;
    tbSep1: TRMToolbarSep;

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

implementation

{$R *.DFM}

uses
  ShellAPI, Registry, RM_Const, RM_Const1, RM_Class, RM_Printer, RM_PrintDlg,
  RM_Utils, RM_PageSetup, RM_DlgFind;

type
  THackReport = class(TRMReport)
  end;

  THackEndPages = class(TRMEndPages)
  end;

  THackEndPage = class(TRMEndPage)
  end;

  THackReportView = class(TRMReportView)
  end;

var
  //  FcrMagnifier: Integer = 0;
  FCurPreview: TRMPreview;
  FRecordNum: Integer;
  FLastExportIndex: Integer = 1;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  { TRMDrawPanel }

constructor TRMDrawPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSaveFoundView := nil;
  FBusy := False;
  FInPainting := False;
  FHRulerOffset := 0;
  FVRulerOffset := 0;
  SetLength(FVisiblePages, 0);
end;

procedure TRMDrawPanel.WMEraseBackground(var Message: TMessage);
begin
end;

const
  PenStyles: array[Low(TPenStyle)..High(TPenStyle)] of DWORD =
  (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME);

procedure TRMDrawPanel.Paint;
var
  i: Integer;
  lRect, lRect1: TRect;
  lPages: TRMEndPages;
  lPage: TRMEndPage;
  lhRgn: HRGN;
  lScale: Double;
  ltb, lbr: {$IFDEF Delphi4}tagLOGBRUSH{$ELSE}TLogBrush{$ENDIF};
  lNewH, lOldH: HGDIOBJ;
  lnbr, lobr: HBRUSH;
  //  lSavePages: array of Integer;

  procedure _SetPS;
  begin
    ltb.lbStyle := BS_SOLID;
    ltb.lbColor := Canvas.Pen.Color;
    lNewH := ExtCreatePen(PS_GEOMETRIC + PS_ENDCAP_SQUARE + PenStyles[Canvas.Pen.Style], Canvas.Pen.Width, ltb, 0, nil);
    lOldH := SelectObject(Canvas.Handle, lNewH);
  end;

  procedure _SetRuler(aPageNo: Integer);
  var
    lRect: TRect;
  begin
    if not FPreview.Options.RulerVisible then Exit;

    lRect := lPages[aPageNo - 1].PageRect;
    OffsetRect(lRect, FPreview.FOffsetLeft, FPreview.FOffsetTop);

    FPreview.FHRuler.Scale := lScale;
    FPreview.FVRuler.Scale := lScale;
    FPreview.FHRuler.Left := lRect.Left;
    FPreview.FVRuler.Top := lRect.Top;
    FPreview.FHRuler.Width := lRect.Right - lRect.Left;
    FPreview.FVRuler.Height := lRect.Bottom - lRect.Top;

    FPreview.FHRuler.ScrollOffset := 0;
    FPreview.FVRuler.ScrollOffset := 0;
    FHRulerOffset := 10 - lRect.Left;
    FVRulerOffset := 10 - lRect.Top;
  end;

  procedure _DrawMargins;
  begin
    with lPage, lPage.PrinterInfo do
    begin
      lRect1.Left := RMToScreenPixels(mmMarginLeft * lScale, rmutMMThousandths);
      lRect1.Top := RMToScreenPixels(mmMarginTop * lScale, rmutMMThousandths);
      lRect1.Right := Round((PageWidth - RMToScreenPixels(mmMarginRight, rmutMMThousandths)) * lScale);
      lRect1.Bottom := Round((PageHeight - RMToScreenPixels(mmMarginBottom, rmutMMThousandths)) * lScale);

      OffsetRect(lRect1, lRect.Left, lRect.Top);
    end;

    with Canvas do
    begin
      Pen.Width := 1;
      Pen.Color := clGray;
      Pen.Style := psSolid;
      MoveTo(lRect1.Left, lRect1.Top);
      LineTo(lRect1.Left, lRect1.Top - Round(20 * lScale)); //左上
      MoveTo(lRect1.Left, lRect1.Top);
      LineTo(lRect1.Left - Round(20 * lScale), lRect1.Top);
      MoveTo(lRect1.Right, lRect1.Top);
      LineTo(lRect1.Right, lRect1.Top - Round(20 * lScale)); //右上
      MoveTo(lRect1.Right, lRect1.Top);
      LineTo(lRect1.Right + Round(20 * lScale), lRect1.Top);
      MoveTo(lRect1.Left, lRect1.Bottom);
      LineTo(lRect1.Left, lRect1.Bottom + Round(20 * lScale)); //左下
      MoveTo(lRect1.Left, lRect1.Bottom);
      LineTo(lRect1.Left - Round(20 * lScale), lRect1.Bottom);
      MoveTo(lRect1.Right, lRect1.Bottom);
      LineTo(lRect1.Right, lRect1.Bottom + Round(20 * lScale)); //右下
      MoveTo(lRect1.Right, lRect1.Bottom);
      LineTo(lRect1.Right + Round(20 * lScale), lRect1.Bottom);
    end;

    if FPreview.Options.DrawBorder then
    begin
      Canvas.Pen.Width := FPreview.Options.BorderPen.Width;
      Canvas.Pen.Color := FPreview.Options.BorderPen.Color;
      Canvas.Pen.Style := FPreview.Options.BorderPen.Style;
      if Canvas.Pen.Width = 1 then
        Canvas.Rectangle(lRect1.Left, lRect1.Top, lRect1.Right + 1, lRect1.Bottom + 1)
      else
      begin
        lRect1.Left := lRect1.Left - Canvas.Pen.Width div 2;
        lRect1.Right := lRect1.Right + Canvas.Pen.Width div 2;
        lRect1.Top := lRect1.Top - Canvas.Pen.Width div 2;
        lRect1.Bottom := lRect1.Bottom + Canvas.Pen.Width div 2;

        _SetPS;
        lbr.lbStyle := BS_NULL;
        lnbr := CreateBrushIndirect(lbr);
        lobr := SelectObject(Canvas.Handle, lnbr);

        Windows.MoveToEx(Canvas.Handle, lRect1.Left, lRect1.Top, nil); // Left
        Windows.LineTo(Canvas.Handle, lRect1.Left, lRect1.Bottom);

        Windows.MoveToEx(Canvas.Handle, lRect1.Left, lRect1.Top, nil); // Top
        Windows.LineTo(Canvas.Handle, lRect1.Right, lRect1.Top);