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

📄 gmpreview.pas

📁 GmPrintSuite 2.96.7] a
💻 PAS
📖 第 1 页 / 共 4 页
字号:
{******************************************************************************}
{                                                                              }
{                               GmPreview.pas                                  }
{                                                                              }
{           Copyright (c) 2003 Graham Murt  - www.MurtSoft.co.uk               }
{                                                                              }
{   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
{                                                                              }
{                           graham@murtsoft.co.uk                              }
{                                                                              }
{******************************************************************************}

unit GmPreview;

interface

uses Windows, Classes, Forms, StdCtrls, GmClasses, GmTypes, GmCanvas, Controls,
  Messages, Graphics, GmPrinter, GmPageList, GmConst, GmResource;

{$I GMPS.INC}

const
  // cursor values...
  crZoomIn   = 101;
  crZoomOut  = 102;

type
  TGmDrawHeaderFooterEvent    = procedure(Sender: TObject; ARect: TGmValueRect; ACanvas: TGmCanvas) of object;

  // *** TGmPreview ***

  TGmPreview = class(TGmScrollingPageControl)
  private
    FDragObjectRect: TRect;
    FDragObjectStart: TGmPoint;
    FDrawSelectedBorder: Boolean;
    FLastObjectRect: TRect;
    FMaxZoom: integer;
    FMinZoom: integer;
    FMouseDownPoint: TPoint;
    FMousePosInch: TGmPoint;
    FObjectDragging: Boolean;
    FPages: TGmPageList;
    FPanning: Boolean;
    FPanningOrigin: TPoint;
    FPageGrid: TGmPageGrid;
    FPaper: TGmPaperImage;
    FRegisteredComponents: TList;
    FPanningScrollOrigin: TPoint;
    FScrollPos: TGmPoint;
    FSelectionPen: TPen;
    FSelectedObject: TGmVisibleObject;
    FShadow: TGmShadow;
    FUpdating: Boolean;
    FZoomIncrement: integer;
    FZoomStyle: TGmZoomStyle;
    // events...
    FAfterPrint: TNotifyEvent;
    FBeforeLoad: TGmBeforeLoadEvent;
    FBeforePrint: TNotifyEvent;
    FOnAbortPrint: TNotifyEvent;
    FOnClear: TNotifyEvent;
    FOnDrawHeader: TGmDrawHeaderFooterEvent;
    FOnDrawFooter: TGmDrawHeaderFooterEvent;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnNeedRichEdit: TGmNeedRichEditEvent;
    FOnNewPage: TNotifyEvent;
    FOnObjectMouseDown: TGmObjectMouseEvent;
    FOnOrientationChanged: TNotifyEvent;
    FOnPageChanged: TNotifyEvent;
    FOnPageDragDrop: TGmPageDragDropEvent;
    FOnPageDragOver: TGmPageDragOverEvent;
    FOnPageMouseDown: TGmPageMouseEvent;
    FOnPageMouseMove: TGmPageMouseMoveEvent;
    FOnPageMouseUp: TGmPageMouseEvent;
    FOnPrintProgress: TGmPrintProgressEvent;
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    function GetAvailablePageRect: TGmValueRect;
    function GetAvailablePageGmRect(Measurement: TGmMeasurement): TGmRect;
    function GetAvailablePageHeight(Measurement: TGmMeasurement): Extended;
    function GetAvailablePageWidth(Measurement: TGmMeasurement): Extended;
    function GetCurrentPage: TGmPage;
    function GetCurrentPageNum: integer;
    function GetDateFormat: string;
    function GetDragDrawShape: TGmDragDrawing;
    function GetFitHeightScale: Extended;
    function GetFitWidthScale: Extended;
    function GetFooter: TGmFooter;
    function GetGmPrinter: TGmPrinter;
    function GetGutter: integer;
    function GetHeader: TGmHeader;
    function GetIsUpdating: Boolean;
    function GetMargins: TGmMargins;
    function GetNumPages: integer;
    function GetPagesPerSheet: TGmPagesPerSheet;
    function GetPaperSize: TGmPaperSize;
    function GetOrientation: TGmOrientation;
    function GetPage(index: integer): TGmPage;
    function GetPageHeight(Measurement: TGmMeasurement): Extended;
    function GetPageWidth(Measurement: TGmMeasurement): Extended;
    function GetResourceTable: TObject;
    function GetScratchCanvas: TCanvas;
    function GetTimeFormat: string;
    function GetZoom: integer;
    procedure DoAbortPrint(Sender: TObject);
    procedure DoAfterPrint(Sender: TObject);
    procedure DoBeforeLoad(Sender: TObject; Version: Extended; var LoadFile: Boolean);
    procedure DoBeforePrint(Sender: TObject);
    procedure DoClear(Sender: TObject);
    procedure DoPrintProgress(Sender: TObject; Printed, Total: integer);
    procedure DoMouseEnter(Sender: TObject);
    procedure DoMouseLeave(Sender: TObject);
    procedure DragGmObjectEnd;
    procedure NewPageEvents(Sender: TObject);
    procedure EnablePaperMouseEvents;
    procedure HeaderFooterChanged(Sender: TObject);
    procedure LoadScrollPos;
    procedure MessageToControls(AMessage: integer; Param1, Param2: integer);
    procedure NeedRichEdit(Sender: TObject; var ARichEdit: TCustomMemo);
    procedure SaveScrollPos;
    procedure SetCurrentPageNum(Value: integer);
    procedure SetDateFormat(Value: string);
    procedure SetDragDrawShape(Value: TGmDragDrawing);
    procedure SetFooter(Value: TGmFooter);
    procedure SetGutter(Value: integer);
    procedure SetHeader(Value: TGmHeader);
    procedure SetMargins(Value: TGmMargins);
    procedure SetMaxZoom(Value: integer);
    procedure SetMinZoom(Value: integer);
    procedure SetOrientation(Value: TGmOrientation);
    procedure SetPagesPerSheet(Value: TGmPagesPerSheet);
    procedure SetPaperSize(Value: TGmPaperSize);
    procedure SetShadow(Value: TGmShadow);
    procedure SetTimeFormat(Value: string);
    procedure SetZoom(Value: integer);
    procedure UpdateScrollBars;
    procedure ZoomToArea(ARect: TRect);
  protected
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoDragDrop(Sender: TObject; Source: TObject; X, Y: integer);
    procedure DoDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState; var Accept: Boolean);
    procedure DoMarginsChanged(Sender: TObject);
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure DoOrientationChanged(Sender: TObject);
    procedure DoPageContentChanged(Sender: TObject);
    procedure DoPageCountChanged(Sender: TObject);
    procedure DoPageNumChanged(Sender: TObject);
    procedure DoPageDragDrop(Sender: TObject; Source: TObject; X, Y: TGmValue);
    procedure DoPageDragOver(Sender, Source: TObject; X, Y: TGmValue; State: TDragState; var Accept: Boolean);
    procedure DoPageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
    procedure DoPageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: TGmValue);
    procedure DoPageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
    procedure DoPaperSizeChanged(Sender: TObject);
    procedure DoPrinterChanged(Sender: TObject);
    procedure PaintPage(Sender: TObject);
    procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
    procedure WMSize(var Message: TMessage); message WM_SIZE;
    {$IFDEF D4+}
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
    {$ENDIF}
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function FooterRect: TGmValueRect;
    function GetFileVersion(AFileName: string): Extended;
    function GetPageSize(Measurement: TGmMeasurement): TGmSize;
    function HeaderRect: TGmValueRect;
    function InsertPage(index: integer): TGmPage;
    function NewPage: TGmPage;
    function GmObjectAtPos(x, y: Extended; Measurement: TGmMeasurement): TGmVisibleObject;
    function GmObjectRect(AObject: TGmVisibleObject): TRect;
    function Tokenize(AText: string; APage: integer): string;
    procedure AddAssociatedComponent(AComponent: TComponent);
    procedure RemoveAssociatedComponent(AComponent: TComponent);
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure CenterOnClick(x, y: integer);
    procedure Clear;
    procedure DeleteCurrentPage;
    procedure DeletePage(index: integer);
    procedure DeleteSelectedGmObject;
    procedure DragDrawCancel;
    procedure DragDrawStart;
    procedure DragDrawToCanvas;
    procedure DragDrawZoom;
    procedure DragGmObjectStart(AObject: TGmVisibleObject);
    procedure EndUpdate;
    procedure FindText(AText: string; CaseSensative: Boolean; AList: TList);
    procedure FirstPage;
    procedure FitHeight;
    procedure FitWholePage;
    procedure FitWidth;
    procedure LastPage;
    procedure LoadFromFile(AFilename: string);
    procedure LoadFromStream(Stream: TStream);
    procedure NextPage;
    procedure PaperSizes(AStrings: TStrings);
    procedure PrevPage;
    procedure Print;
    procedure PrintCurrentPage;
    procedure PrintRange(APageFrom, APageTo: integer);
    procedure PrintToFile(AFileName: string);
    procedure SaveToFile(AFileName: string);
    procedure SaveToStream(Stream: TStream);
    procedure ScrollToPosition(xPercent, yPercent: Extended);
    procedure SelectGmObject(AObject: TGmVisibleObject);
    procedure SetCursor(ACursor: TGmCursor);
    procedure SetCustomPageSize(AWidth, AHeight: Extended; Measurement: TGmMeasurement);
    procedure StartPanning;
    procedure StopPanning;
    procedure UsePrinterPageSize;
    procedure ZoomIn;
    procedure ZoomOut;
    // properties...
    property AvailablePageHeight[Measurement: TGmMeasurement]: Extended read GetAvailablePageHeight;
    property AvailablePageRect[Measurement: TGmMeasurement]: TGmRect read GetAvailablePageGmRect;
    property AvailablePageWidth[Measurement: TGmMeasurement]: Extended read GetAvailablePageWidth;
    property CurrentPage: TGmPage read GetCurrentPage;
    property CurrentPageNum: integer read GetCurrentPageNum write SetCurrentPageNum;
    property DateTokenFormat: string read GetDateFormat write SetDateFormat;
    property DragDrawShape: TGmDragDrawing read GetDragDrawShape write SetDragDrawShape;
    property DrawSelectedBorder: Boolean read FDrawSelectedBorder write FDrawSelectedBorder default True;
    property IsUpdating: Boolean read GetIsUpdating;
    property NumPages: integer read GetNumPages;
    property PageHeight[Measurement: TGmMeasurement]: Extended read GetPageHeight;
    property Pages[index: integer]: TGmPage read GetPage;
    property PageWidth[Measurement: TGmMeasurement]: Extended read GetPageWidth;
    property Panning: Boolean read FPanning;
    property ResourceTable: TObject read GetResourceTable;
    property ScratchCanvas: TCanvas read GetScratchCanvas;
    property TimeTokenFormat: string read GetTimeFormat write SetTimeFormat;
  published
    property Canvas;
    property Footer: TGmFooter read GetFooter write SetFooter;
    property GmPrinter: TGmPrinter read GetGmPrinter;
    property Gutter: integer read GetGutter write SetGutter default 30;
    property Header: TGmHeader read GetHeader write SetHeader;
    property Margins: TGmMargins read GetMargins write SetMargins;
    property MaxZoom: integer read FMaxZoom write SetMaxZoom default DEFAULT_MAX_ZOOM;
    property MinZoom: integer read FMinZoom write SetMinZoom default DEFAULT_MIN_ZOOM;
    property Orientation: TGmOrientation read GetOrientation write SetOrientation default gmPortrait;
    property PageGrid: TGmPageGrid read FPageGrid write FPageGrid;
    property PagesPerSheet: TGmPagesPerSheet read GetPagesPerSheet write SetPagesPerSheet;
    property PaperSize: TGmPaperSize read GetPaperSize write SetPaperSize default A4;
    property Shadow: TGmShadow read FShadow write SetShadow;
    property Zoom: integer read GetZoom write SetZoom default 20;
    property ZoomIncrement: integer read FZoomIncrement write FZoomIncrement default DEFAULT_ZOOM_INC;
    property ZoomStyle: TGmZoomStyle read FZoomStyle write FZoomStyle default gmVariableZoom;
    // events...
    property AfterPrint: TNotifyEvent read FAfterPrint write FAfterPrint;
    property BeforeLoad: TGmBeforeLoadEvent read FBeforeLoad write FBeforeLoad;
    property BeforePrint: TNotifyEvent read FBeforePrint write FBeforePrint;
    property OnAbortPrint: TNotifyEvent read FOnAbortPrint write FOnAbortPrint;
    property OnClear: TNotifyEvent read FOnClear write FOnClear;
    property OnDragOver;
    property OnDragDrop;
    property OnDrawHeader: TGmDrawHeaderFooterEvent read FOnDrawHeader write FOnDrawHeader;
    property OnDrawFooter: TGmDrawHeaderFooterEvent read FOnDrawFooter write FOnDrawFooter;
    property OnEnter;
    property OnExit;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    {$IFDEF D4+}
    property OnMouseWheel;
    property OnMouseWheelUp;
    property OnMouseWheelDown;
    {$ENDIF}
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnNeedRichEdit: TGmNeedRichEditEvent read FOnNeedRichEdit write FOnNeedRichEdit;
    property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
    property OnObjectMouseDown: TGmObjectMouseEvent read FOnObjectMouseDown write FOnObjectMouseDown;
    property OnOrientationChanged: TNotifyEvent read FOnOrientationChanged write FOnOrientationChanged;
    property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
    property OnPageDragDrop: TGmPageDragDropEvent read FOnPageDragDrop write FOnPageDragDrop;
    property OnPageDragOver: TGmPageDragOverEvent read FOnPageDragOver write FOnPageDragOver;
    property OnPageMouseDown: TGmPageMouseEvent read FOnPageMouseDown write FOnPageMouseDown;
    property OnPageMouseMove: TGmPageMouseMoveEvent read FOnPageMouseMove write FOnPageMouseMove;
    property OnPageMouseUp: TGmPageMouseEvent read FOnPageMouseUp write FOnPageMouseUp;
    property OnPrintProgress: TGmPrintProgressEvent read FOnPrintProgress write FOnPrintProgress;
  end;

implementation

uses SysUtils, GmFuncs, GmObjects, GmStream;

{$R GmCursors.res}

//------------------------------------------------------------------------------

// *** TGmPreview ***

constructor TGmPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPages := TGmPageList.Create;
  FPaper := TGmPaperImage.Create(Self);
  FPageGrid := TGmPageGrid.Create;
  FShadow := TGmShadow.Create;
  FRegisteredComponents := TList.Create;
  FSelectionPen := TPen.Create;
  Screen.Cursors[crZoomIn]  := LoadCursor(HInstance, 'ZoomIn');
  Screen.Cursors[crZoomOut] := LoadCursor(HInstance, 'ZoomOut');
  Width := 240;
  Height := 300;
  FPaper.Align := alClient;
  FPaper.Shadow := FShadow;
  FPaper.Margins := FPages.Margins;
  FPaper.Grid := FPageGrid;
  FPaper.Parent := Self;
  FUpdating := False;
  FPanning := False;
  FDrawSelectedBorder := True;
  FSelectionPen.Width := 1;
  FSelectionPen.Color := clRed;
  FMinZoom := DEFAULT_MIN_ZOOM;
  FMaxZoom := DEFAULT_MAX_ZOOM;
  FObjectDragging := False;
  FZoomIncrement := DEFAULT_ZOOM_INC;
  FZoomStyle := gmVariableZoom;
  FPages.OnNeedRichEdit := NeedRichEdit;
  FPages.OnNewPage := NewPageEvents;
  FPaper.OnPaintPage := PaintPage;
  EnablePaperMouseEvents;
  FPages.AddPage;
  CurrentPageNum := 1;
  FPaper.Page := FPages[1];
  Canvas := FPages.Canvas;
  FPages.OnOrientationChanged := DoOrientationChanged;
  FPages.OnPageChanged := DoPageContentChanged;
  FPages.OnPageCountChanged := DoPageCountChanged;
  FPages.OnPageNumChanged := DoPageNumChanged;
  FPages.OnHeaderFooterChanged := HeaderFooterChanged;
  FPages.GmPrinter.OnAbortPrint := DoAbortPrint;
  FPages.GmPrinter.AfterPrint := DoAfterPrint;
  FPages.GmPrinter.BeforePrint := DoBeforePrint;
  FPages.BeforeLoad := DoBeforeLoad;
  FPages.OnClear := DoClear;
  FPages.OnPageMarginsChanged := DoMarginsChanged;
  FPages.OnPaperSizeChanged := DoPaperSizeChanged;
  FPages.OnPrintProgress := DoPrintProgress;
  FPages.GmPrinter.OnChangePrinter := DoPrinterChanged;
  FPaper.OnMouseEnter := DoMouseEnter;
  FPaper.OnMouseLeave := DoMouseLeave;
end;

destructor TGmPreview.Destroy;
begin
  FPages.Free;
  FPaper.Free;
  FShadow.Free;
  FRegisteredComponents.Free;
  FSelectionPen.Free;
  FPageGrid.Free;
  inherited Destroy;
end;

function TGmPreview.FooterRect: TGmValueRect;
begin
  Result := FPages.FooterRect;
end;

function TGmPreview.GetFileVersion(AFileName: string): Extended;

⌨️ 快捷键说明

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