rm_grid.pas

这是一个功能强大

unit RM_Grid;

{$I RM.INC}

interface

uses Messages, Windows, SysUtils, Classes, Graphics, Menus, Controls, Forms,
  StdCtrls, Mask, Clipbrd, RM_Common, RM_Class;

const
  MaxCustomExtents = MaxListSize;
  MaxShortInt = High(ShortInt);

type
  ERMInvalidGridOperation = class(Exception);

  { Internal grid types }
  TRMGridEx = class;
  TRMCellInfo = class;
  TRMGetExtentsFunc = function(Index: Longint): Integer of object;
  TRMAfterInsertRowEvent = procedure(aGrid: TRMGridEx; aRow: Integer) of object;
  TRMAfterDeleteRowEvent = procedure(aGrid: TRMGridEx; aRow: Integer) of object;
  TRMAfterChangeRowCountEvent = procedure(aGrid: TRMGridEx; aOldCount, aNewCount: Integer) of object;
  TRMBeforeChangeCellEvent = procedure(aGrid: TRMGridEx; aCell: TRMCellInfo) of object;
  TRMFRowHeaderClickEvent = procedure(Sender: TObject; X, Y: Integer) of object;
  TRMDropDownFieldEvent = procedure(aCol, aRow: Integer) of object;
  TRMDropDownFieldClickEvent = procedure(aDropDown: Boolean; X, Y: Integer) of object;

  TRMGridAxisDrawInfo = record
    EffectiveLineWidth: Integer;
    TitleBoundary: Integer; // (行列)标题栏边界(像素单位)
    FixedBoundary: Integer;
    GridBoundary: Integer;
    GridExtent: Integer;
    LastFullVisibleCell: Longint;
    FullVisBoundary: Integer;
    FixedCellCount: Integer;
    FirstGridCell: Integer;
    GridCellCount: Integer;
    GetExtent: TRMGetExtentsFunc;
  end;

  TRMGridDrawInfo = record
    Horz, Vert: TRMGridAxisDrawInfo;
  end;

  TRMGridState = (rmgsNormal, rmgsSelecting, rmgsRowSizing, rmgsColSizing,
    rmgsRowMoving, rmgsColMoving, rmgsRowHeaderDblClick);
  TRMGridMovement = rmgsRowMoving..rmgsColMoving;

  TRMGridOption = (rmgoFixedVertLine, rmgoFixedHorzLine, rmgoVertLine, rmgoHorzLine,
    rmgoRangeSelect, rmgoDrawFocusSelected, rmgoRowSizing, rmgoColSizing, rmgoRowMoving,
    rmgoColMoving, rmgoEditing, rmgoTabs, rmgoRowSelect,
    rmgoAlwaysShowEditor, rmgoThumbTracking);
  TRMGridOptions = set of TRMGridOption;
  TRMGridDrawState = set of (rmgdSelected, rmgdFocused, rmgdFixed, rmgdTitled);
  TRMGridScrollDirection = set of (rmsdLeft, rmsdRight, rmsdUp, rmsdDown);

  TRMSelectCellEvent = procedure(Sender: TObject; ACol, ARow: Longint; var CanSelect: Boolean) of object;
  TRMDrawCellEvent = procedure(Sender: TObject; ACol, ARow: Longint;
    Rect: TRect; State: TRMGridDrawState) of object;

  { TRMCellInfo }
  TRMCellInfo = class(TRMPersistent)
  private
    FMutilCell: Boolean;
    FFont: TFont;
    FAutoWordBreak: Boolean;
    FHorizAlign: TRMHAlign;
    FVertAlign: TRMVAlign;
    FView: TRMView;
    FParentReport: TRMReport;

    function GetText: string;
    procedure SetText(const Value: string);
    function GetFillColor: TColor;
    procedure SetFillColor(Value: TColor);
    function GetFont: TFont;
    procedure SetFont(Value: TFont);
    function GetAutoWordBreak: Boolean;
    procedure SetAutowordBreak(Value: Boolean);
    function GetHorizAlign: TRMHAlign;
    procedure SetHorizAlign(Value: TRMHAlign);
    function GetVertAlign: TRMVAlign;
    procedure SetVertAlign(Value: TRMVAlign);
    procedure SetParentReport(Value: TRMReport);
  protected
    FStartCol: Integer;
    FStartRow: Integer;
    FEndCol: Integer;
    FEndRow: Integer;

    function CanEdit: Boolean;
    property ParentReport: TRMReport read FParentReport write SetParentReport;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure AssignFromCell(Source: TRMCellInfo);
    procedure ReCreateView(aObjectType: Byte; const aClassName: string);
  published
    property StartCol: Integer read FStartCol;
    property StartRow: Integer read FStartRow;
    property EndCol: Integer read FEndCol;
    property EndRow: Integer read FendRow;
    property MutilCell: Boolean read FMutilCell write FMutilCell;
    property FillColor: TColor read GetFillColor write SetFillColor;
    property Text: string read GetText write SetText;
    property Font: TFont read GetFont write SetFont;
    property AutoWordBreak: Boolean read GetAutoWordBreak write SetAutoWordBreak;
    property HAlign: TRMHAlign read GetHorizAlign write SetHorizAlign;
    property VAlign: TRMVAlign read GetVertAlign write SetVertAlign;
    property View: TRMView read FView;
  end;

  TRMRowCell = class
  private
    FList: TList;
    function GetItem(Index: Integer): TRMCellInfo;
  public
    constructor Create(ARow, AColCount: Integer; AGrid: TRMGridEx);
    destructor Destroy; override;
    procedure Clear;
    procedure Add(ARow, ACol: Integer; AGrid: TRMGridEx);
    procedure Delete(Index: Integer);
    property Items[Index: Integer]: TRMCellInfo read GetItem;
  end;

  { TRMCells }
  TRMCells = class
  private
    FList: TList;
    FGrid: TRMGridEx;
    function GetItem(Index: Integer): TRMRowCell;
  protected
  public
    constructor Create(AColCount, ARowCount: Integer; AGrid: TRMGridEx);
    destructor Destroy; override;
    procedure Clear;
    procedure Add(AIndex: Integer);
    procedure Insert(AIndex: Integer);
    procedure Delete(AIndex: Integer);

    property Items[Index: Integer]: TRMRowCell read GetItem;
  end;

  TRMInplaceEdit = class(TCustomMaskEdit)
  private
    FTempText: string;
    FGrid: TRMGridEx;
    FCell: TRMCellInfo;
    FClickTime: Longint;
    procedure InternalMove(const Loc: TRect; Redraw: Boolean);
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMPaste(var Message); message WM_PASTE;
    procedure WMCut(var Message); message WM_CUT;
    procedure WMClear(var Message); message WM_CLEAR;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DblClick; override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    function EditCanModify: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure ValidateError; override;
    procedure BoundsChanged; virtual;
    procedure UpdateContents; virtual;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Deselect;
    procedure Hide;
    procedure Invalidate; reintroduce;
    procedure Move(const Loc: TRect);
    function PosEqual(const Rect: TRect): Boolean;
    procedure SetFocus; reintroduce;
    procedure UpdateLoc(const Loc: TRect);
    function Visible: Boolean;
    property Grid: TRMGridEx read FGrid write FGrid;
    property Cell: TRMCellInfo read FCell write FCell;
  end;

  { TRMGridEx }
  TRMGridEx = class(TCustomControl)
  private
    FEditorMode: Boolean;
    FSaveLastNameIndex: Integer;
    FAutoDraw: Boolean;
    FAnchor: TPoint;
    FBorderStyle: TBorderStyle;
    FCanEditModify: Boolean;
    FColCount: Longint;
    FColWidths: Pointer;
    FCurrent: TPoint;
    FmmDefaultColWidth: Integer;
    FmmDefaultRowHeight: Integer;
    FFixedCols: Integer;
    FFixedRows: Integer;
    FFixedColor: TColor;
    FGridLineWidth: Integer;
    FOptions: TRMGridOptions;
    FRowCount: Longint;
    FRowHeights: Pointer;
    FScrollBars: TScrollStyle;
    FTopLeft: TPoint;
    FSizingIndex: Longint;
    FSizingPos, FSizingOfs: Integer;
    FMoveIndex, FMovePos: Longint;
    FHitTest: TPoint;
    FColOffset: Integer;
    FDefaultDrawing: Boolean;
    FPressed: Boolean;
    FPressedCell: TPoint;
    FCells: TRMCells;

    FTitleColor: TColor;
    FHighLightColor: TColor;
    FHighLightTextColor: TColor;
    FFocusedTitleColor: TColor;
    FFixedLineColor: TColor;
    FClientLineColor: TColor;
    FInLoadSaveMode: Boolean;
    FAutoCreateName: Boolean;
    FFocusedFillColor: TColor;
    FDrawPicture: Boolean;

    FInplaceEdit: TRMInplaceEdit;
    FInplaceCol, FInplaceRow: Longint;
    FEditUpdate: Integer;

    FGridCanCopyMove: Boolean;
    FGridCanFill: Boolean;
    FAutoUpdate: Boolean;
    FParentReport: TRMReport;
    FParentPage: TRMReportPage;
    FHeaderClick: Boolean;
    //    FAlwaysDrawFocus: Boolean;

    FNewRgn, FOldRgn: HRGN;
    FHaveClip: Integer;
    FOnAfterInsertRow: TRMAfterInsertRowEvent;
    FOnAfterDeleteRow: TRMAfterDeleteRowEvent;
    FOnAfterChangeRowCount: TRMAfterChangeRowCountEvent;

    FOnSelectCell: TRMSelectCellEvent;
    FOnChange: TNotifyEvent;
    FOnRowHeaderClick: TRMFRowHeaderClickEvent;
    FOnRowHeaderDblClick: TNotifyEvent;
    FOnBeginSizingCell: TNotifyEvent;
    FOnBeforeChangeCell: TRMBeforeChangeCellEvent;
    FOnDropDownField: TRMDropDownFieldEvent;
    FOnDropDownFieldClick: TRMDropDownFieldClickEvent;

    procedure ClearGrid;
    procedure ShowFrame(t: TRMView; aCanvas: TCanvas; x, y, x1, y1: Integer; aDrawSubReport: Boolean);
    function CalcCoordFromPoint(X, Y: Integer; const DrawInfo: TRMGridDrawInfo): TPoint;
    procedure CalcDrawInfoXY(var DrawInfo: TRMGridDrawInfo; UseWidth, UseHeight: Integer);
    function CalcMaxTopLeft(const Coord: TPoint; const DrawInfo: TRMGridDrawInfo): TPoint;
    procedure CancelMode;
    procedure ChangeSize(NewColCount, NewRowCount: Longint);
    procedure ClampInView(const Coord: TPoint);
    procedure DrawSizingLine(const DrawInfo: TRMGridDrawInfo);
    procedure DrawMove;
    procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
    procedure GridRectToScreenRect(GridRect: TRect; var ScreenRect: TRect; IncludeLine: Boolean);
    procedure Initialize;
    procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal; UseRightToLeft: Boolean);
    procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
    procedure MoveAnchor(const NewAnchor: TPoint);
    procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
    procedure MoveTopLeft(ALeft, ATop: Longint);
    procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
    procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
    procedure MoveColumn(FromIndex, ToIndex: Longint);
    procedure MoveRow(FromIndex, ToIndex: Longint);
    procedure SelectionMoved(const OldSel: TRect);
    procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TRMGridDrawInfo);
    procedure TopLeftMoved(const OldTopLeft: TPoint);
    procedure UpdateScrollPos;
    procedure UpdateScrollRange;
    function GetRowHeights(Index: Longint): Integer;
    procedure SetRowHeights(Index: Longint; Value: Integer);
    function GetmmRowHeights(Index: Longint): Integer;
    procedure SetmmRowHeights(Index: Longint; Value: Integer);
    function GetSelection: TRect;
    function GetVisibleColCount: Integer;
    function GetVisibleRowCount: Integer;
    function IsActiveControl: Boolean;
    procedure SetBorderStyle(Value: TBorderStyle);
    function GetCol: Longint;
    procedure SetCol(Value: Longint);
    procedure SetColCount(Value: Longint);
    function GetColWidths(Index: Longint): Integer;
    procedure SetColWidths(Index: Longint; Value: Integer);
    function GetmmColWidths(Index: Longint): Integer;
    procedure SetmmColWidths(Index: Longint; Value: Integer);
    procedure SetFixedColor(Value: TColor);
    function GetLeftCol: LongInt;
    procedure SetLeftCol(Value: Longint);
    function GetRow: Longint;
    procedure SetRow(Value: Longint);
    procedure SetRowCount(Value: Longint);
    procedure SetSelection(Value: TRect);
    function GetTopRow: Longint;
    procedure SetTopRow(Value: Longint);
    function GetComAdapter: IUnknown;

    procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure WMCancelMode(var Msg: TWMCancelMode); message WM_CANCELMODE;
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
    procedure WMEraseBkGnd(var Message: TWMCommand); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;

    procedure TrackButton(X, Y: Integer);
    function GetDefaultColWidth: Integer;
    procedure SetDefaultColWidth(Value: Integer);
    function GetDefaultRowHeight: Integer;
    procedure SetDefaultRowHeight(Value: Integer);

    procedure ColCountChange(Value: Integer);
    procedure RowCountChange(Value: Integer);
    procedure SetClipRect(ACanvas: TCanvas; ClipR: TRect);
    procedure RestoreClipRect(ACanvas: TCanvas);
    function CellInMerge(ACol, ARow: Integer): Boolean;
    function GetCell(ACol, ARow: Integer): TRMCellInfo;
    function GetMerges(ACol, ARow: Integer): TRect;
    procedure InitCell(AGrid: TRMGridEx; ACell: TRMCellInfo; ACol, ARow: Integer);
    procedure SetParentReport(Value: TRMReport);

    procedure RestoreCells(aDestRestoreRect: TRect);
    procedure ReadCellFromBuffer(aCell: TRMCellInfo; aStream: TStream; aXOffset, aYOffset: Integer);
    procedure WriteCellToBuffer(aCell: TRMCellInfo; aStream: TStream);
  protected
    FGridState: TRMGridState;
    FSaveCellExtents: Boolean;
    VirtualView: Boolean;
    RightClickRowHeader: Boolean;
    RightClickColHeader: Boolean;
    FComAdapter: IUnknown;

    FCurrentCol, FCurrentRow: Integer;

    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); 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;
    function CellRect(ACol, ARow: Longint): TRect;
{$IFDEF COMPILER4_UP}
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
{$ENDIF}

    procedure CalcDrawInfo(var DrawInfo: TRMGridDrawInfo);
    procedure CalcFixedInfo(var DrawInfo: TRMGridDrawInfo);
    procedure CalcSizingState(X, Y: Integer; var State: TRMGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer; var FixedInfo: TRMGridDrawInfo); virtual;
    function GetGridWidth: Integer;
    function GetGridHeight: Integer;
    procedure DrawCell(ACol, ARow: Longint; ARect, AClipRect: TRect; AState: TRMGridDrawState);
    procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
    function SelectCell(ACol, ARow: Longint): Boolean; virtual;
    procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
    function Sizing(X, Y: Integer): Boolean;
    procedure ScrollData(DX, DY: Integer);
    procedure InvalidateCol(ACol: Longint);
    procedure InvalidateRow(ARow: Longint);
    procedure TopLeftChanged; dynamic;
    procedure TimedScroll(Direction: TRMGridScrollDirection); dynamic;
    procedure Paint; override;
    procedure ColWidthsChanged; dynamic;
    procedure RowHeightsChanged; dynamic;

    procedure DisableEditUpdate;
    procedure EnableEditUpdate;
    procedure SetEditText(ACol, ARow: Longint; Value: string);
    function CreateEditor: TRMInplaceEdit;
    procedure InvalidateEditor;
    procedure HideEdit;
    procedure HideEditor;
    procedure ShowEditor;
    procedure UpdateText;
    procedure UpdateEdit;
    procedure ShowEditorChar(Ch: Char);
    procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); reintroduce; dynamic;
    function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
    procedure DoExit; override;
    function CanEditAcceptKey(Key: Char): Boolean; dynamic;
    function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
    function CanEditModify: Boolean; dynamic;
    function CanEditShow: Boolean; virtual;

    procedure CopyCellsToBuffer(aRect: TRect; aStream: TStream); // 从缓冲区中粘贴 Cells 内容
    procedure PasteCellsFromBuffer(aRect: TRect; aStream: TStream);
    procedure GetClipBoardInfo(aStream: TStream; var aStartCell, aSize: TPoint);
    function CanPasteToRect(aDestRect: TRect): Boolean;
    function MergeRectIntersects(aDestRect: TRect): Boolean;