rm_preview.pas

这是一个功能强大

{*****************************************}
{                                         }
{             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, Math,
  RM_Common, RM_Ctrls, ImgList
{$IFDEF COMPILER6_UP}, Variants{$ENDIF}
{$IFDEF USE_TB2K}
  , TB2Item, TB2Dock, TB2Toolbar
{$ENDIF};

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

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

    FPreview: TRMVirtualPreview;
    FDown, FDoubleClickFlag: Boolean;
    FLastX, FLastY: Integer;
    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;

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

    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;
    FTotalPages: Integer;

    procedure SetKWheel(Value: Integer);

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

    procedure ClearOutLine;
    procedure SetOutLineInfo;
    procedure OnOutlineClickEvent(Sender: TObject);
    procedure GotoPosition(aPageNo, aPosition: Integer);

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

    procedure OnMouseWheelUpEvent(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure OnMouseWheelDownEvent(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  protected
    procedure Connect_1(aReport: TRMCustomReport);
    procedure Disconnect;
    function GetEndPages: TObject;
    property OnAfterPageSetup: TNotifyEvent read FOnAfterPageSetup write FOnAfterPageSetup;

    procedure InternalOnProgress(aReport: TRMCustomReport; aPercent: Integer); override;
    procedure BeginPrepareReport(aReport: TRMCustomReport); override;
    procedure EndPrepareReport(aReport: TRMCustomReport); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

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

    procedure RedrawAll(aResetPage: 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 SetKWheel;
    property Report: TRMCustomReport read FReport;
    property TotalPages: Integer read FTotalPages;
    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;
    property PrepareReportFlag: Boolean read FPrepareReportFlag;
  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;

  { TRMPreview }
  TRMPreview = class(TRMVirtualPreview)
  private
    FShowToolbar: Boolean;
    FOnBtnExitClickEvent: TNotifyEvent;
    FOnSaveReportEvent: TRMPreviewSaveReportEvent;

    Dock971: TRMDock;
    ToolbarStand: TRMToolbar;
    BtnExit: TRMToolbarButton;
    btn100: TRMToolbarButton;
    btnOnePage: TRMToolbarButton;
    btnPageSetup: TRMToolbarButton;
    btnPageWidth: TRMToolbarButton;
    btnShowOutline: TRMToolbarButton;
    ToolbarSep972: TRMToolbarSep;
//{$IFDEF USE_TB2K}
//    btnPrint: TRMSubmenuItem;
//{$ELSE}
    btnPrint: TRMToolbarButton;
//{$ENDIF}
    ToolbarSep973: TRMToolbarSep;
    btnTop: TRMToolbarButton;
{$IFDEF USE_TB2K}
    btnSave: TRMSubmenuItem;
{$ELSE}
    btnSave: TRMToolbarButton;
{$ENDIF}
    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;

    ProcMenu: TPopupMenu;
    itmScale200: TMenuItem;
    itmScale150: TMenuItem;
    itmScale100: TMenuItem;
    itmScale75: TMenuItem;
    itmScale50: TMenuItem;
    itmScale25: TMenuItem;
    itmScale10: TMenuItem;
    itmPageWidth: TMenuItem;
    itmOnePage: TMenuItem;
    itmDoublePage: TMenuItem;
    N1: TMenuItem;
    itmNewPage: TMenuItem;
    itmDeletePage: TMenuItem;
    itmEditPage: TMenuItem;
    N4: TMenuItem;
    itmPrint: TMenuItem;
    itmPrintCurrentPage: TMenuItem;
    InsertBefore1: TMenuItem;
    InsertAfter1: TMenuItem;
    N2: TMenuItem;
    Append1: TMenuItem;

    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 OnmnuExportClick(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 btnShowBorderClick(Sender: TObject);
//    procedure btnBackColorClick(Sender: TObject);

    procedure itmScale10Click(Sender: TObject);
    procedure itmDeletePageClick(Sender: TObject);
    procedure itmEditPageClick(Sender: TObject);
    procedure itmPrintCurrentPageClick(Sender: TObject);
    procedure Append1Click(Sender: TObject);
    procedure InsertBefore1Click(Sender: TObject);
    procedure InsertAfter1Click(Sender: TObject);

    procedure OnPageChangedEvent(Sender: TObject);
    procedure OnStatusChangeEvent(Sender: TObject);

    procedure SetShowToolbar(Value: Boolean);
    procedure CreateButtons;
    procedure SetButtonsVisible;
    procedure Localize;
  protected
    IsStanderPreview: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoKeyDownEvent(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure LoadIni(aDefault: Boolean);
    procedure SaveIni(aDefault: Boolean);
    property OnBtnExitClickEvent: TNotifyEvent read FOnBtnExitClickEvent write FOnBtnExitClickEvent;
    property OnSaveReportEvent: TRMPreviewSaveReportEvent read FOnSaveReportEvent write FOnSaveReportEvent;
  published
    property ShowToolbar: Boolean read FShowToolbar write SetShowToolbar default False;
  end;

  { TRMPreviewForm }
  TRMPreviewForm = class(TForm)
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    FDoc: Pointer;
    FViewer: TRMPreview;
    FPopupMenu: TRMPopupMenu;
    FPopupMenuPrint: TRMPopupMenu;

    procedure Localize;
    procedure SaveIni;
    procedure LoadIni;
    procedure PopupMenuPrintOnPopup(Sender: TObject);
//    procedure ItmPopupPrintClick(Sender: TObject);
  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: TRMVirtualPreview;
  FRecordNum: Integer;
  FLastExportIndex: Integer = 1;
  FSaveLastScale: Double = 1;
  FSaveLastScaleMode: TRMScaleMode = mdNone;
  FSaveOpenDialogDir: string;
  FSaveSaveDialogDir: string;
  FWindow: TRMPreviewForm = nil;

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

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

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

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

procedure TRMDrawPanel.Paint;
var
  i, j: Integer;
  lRect, lRect1: TRect;
  lPages: TRMEndPages;
  lPage: TRMEndPage;
  lhRgn: HRGN;
  lScale: Double;
  ltb, lbr: tagLOGBRUSH;
  lNewH, lOldH: HGDIOBJ;
  lnbr, lobr: HBRUSH;
  //  lSavePages: array of Integer;
  lFlag: Boolean;

  procedure _SetPS;
  begin
    ltb.lbStyle := BS_SOLID;
    ltb.lbColor := Canvas.Pen.Color;
    lNewH := ExtCreatePen(PS_GEOMETRIC + PS_ENDCAP_SQUARE + RMPenStyles[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;
    if lPages[aPageNo - 1] = nil 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;