easygrid.~pas

一个非常好用的中国式表格控件（源码),对需在程序中插入格式复杂的表格非常有用

  TCustomEasyGrid = class(TCustomControl)
  private
    FAnchor: TGridCoord;            // 鼠标释放坐标
    FSelStart, FSelEnd: TGridCoord; // 选择区域起止坐标
    FBorderStyle: TBorderStyle;     // 边框风格
    FCanEditModify: Boolean;
    FColCount: Longint;
    FColWidths: Pointer;
    FTabStops: Pointer;
    FColCanSizes: Pointer;
    FRowCanSizes: Pointer;
    FCurrent: TGridCoord;            // 当前网格坐标
    FDefaultColWidth: Integer;
    FDefaultRowHeight: Integer;
    FFixedCols: Integer;
    FFixedRows: Integer;
    FFixedLineColor: TColor;         // 固定区线条颜色
    FClientLineColor: TColor;        // 活动区线条颜色
    FGridLineWidth: Integer;
    FOptions: TEasyGridOptions;
    FRowCount: Longint;
    FRowHeights: Pointer;
    FScrollBars: TScrollStyle;
    FTopLeft: TGridCoord;             // 当前左上角网格坐标
    FSizingIndex: Longint;            // 被 Sizing 的行(列)号
    FSizingPos, FSizingOfs: Integer;  // Sizing前鼠标位置与偏移量
    FHitTest: TPoint;                 // 鼠标点击位置
    FInplaceEdit: TInplaceEdit;
    FInplaceCol, FInplaceRow: Longint;// InplaceEditor 所在行列( -1 隐藏)
    FColOffset: Integer;              // 只有一个活动列时,该列左边被隐藏部分的宽度
    FDefaultDrawing: Boolean;
    FEditorMode: Boolean;             // InplaceEditor 是否可见

    //User Define
    FCells: TCells;                   // TList(TList1,TList2,...)
    FShowColTitle: Boolean;           // 是否显示行列标题
    FShowRowTitle: Boolean;
    FTitleColor: TColor;              // 标题栏颜色
    FHighLightColor: TColor;          // 高亮度背景颜色
    FHighLightTextColor: TColor;      // 高亮度文本颜色
    FFocusedTitleColor: TColor;       // 当前标题栏文本颜色

    FDataStyle : TDataStyle;
    FAlignMode : TAlignMode;
    FShowForeText : Boolean;
    FReadOnly : Boolean;
    FAutoWordBreak : Boolean;
    FCellLineWidth : Integer;
    FCellPenStyle : TPenStyle; 
    FAllowNegative : Boolean;
    FTrailingZero : Boolean;
    FZeroNull : Boolean;
    FThousandSep : Boolean;
    FMaxLength : Integer;
    FIntLength : Integer;
    FDecLength : Integer;
    FColor : TColor;

    FFontName  : string;
    FFontSize  : Integer;
    FFontColor : TColor;
    FFontStyle : TFontStyles;

    FEditUpdate: Integer;
    FAlwaysDrawFocus: Boolean;        // 是否总是显示粗焦点框
    FClientSizeable: Boolean;         // 活动区域能否 Size
    FCopyMoveRect: TGridRect;         // CopyMove 的范围
    FCopyMoveCell: TGridCoord;        // CopyMove 开始 Cell
    FCopyMoveOffset: TGridCoord;      // CopyMove 偏移量
    FFillStyle: TFillStyle;           // Fill 的方式
    FFillRect: TGridRect;             // Fill 的范围
    FFillCell: TGridCoord;            // Fill 开始 Cell
    FFillOffset: TGridCoord;          // Fill 偏移量

    FGridCanCopyMove: Boolean;        // 网格是否可以拖动
    FGridCanFill: Boolean;            // 网格是否可以填充
    FShowPopup: Boolean;              // 是否显示右键菜单
    FAutoUpdate: Boolean;             // 修改数据时是否自动更新
    FCellPropPageIndex: Integer;      // 属性设置窗口的页号
    FPageSetupPageIndex: Integer;     // 页面设置窗口的页号
    FPreviewZoomIndex: Integer;       // 预览窗口的缩放比例编号

    // *************************************************************************
    NewRgn, OldRgn: HRGN;             // 剪裁区域
    HaveClip: Integer;                // 剪裁标志
    MainBuffer: array of Char;        // 剪贴缓冲区
    // *************************************************************************

    FOnDrawCell: TDrawCellEvent;
    FOnGetEditMask: TGetEditEvent;
    FOnGetEditText: TGetEditEvent;
    FOnSelectCell: TSelectCellEvent;
    FOnSetEditText: TSetEditEvent;
    FOnHideEdit: TSetEditEvent;
    FOnSetForeText: TSetCellTextEvent;
    FOnSetBackText: TSetCellTextEvent;
    FBeforeSetCellProp: TBeforeSetCellPropEvent;
    FAfterSetCellProp: TAfterSetCellPropEvent;
    FOnTopLeftChanged: TNotifyEvent;
    FOnInsertCol: TInsertColEvent;
    FOnInsertRow: TInsertRowEvent;
    FOnDeleteCol: TDeleteColEvent;
    FOnDeleteRow: TDeleteRowEvent;
    FOnInsertCellRight: TInsertCellRightEvent;
    FOnInsertCellDown: TInsertCellDownEvent;
    FOnDeleteCellRight: TDeleteCellRightEvent;
    FOnDeleteCellDown: TDeleteCellDownEvent;
    FOnPasteCells: TPasteCellsEvent;
    FOnCutCells: TCutCellsEvent;
    FOnCopyMoveCells: TCopyMoveCellsEvent;
    FOnFillCells: TFillCellsEvent;

    // 转换屏幕绝对坐标到 Cell 坐标
    function CalcCoordFromPoint(X, Y: Integer;
      const DrawInfo: TEasyGridDrawInfo): TGridCoord;
    // 计算 DrawInfo 数据结构(调用 CalcDrawInfoXY )
    procedure CalcDrawInfo(var DrawInfo: TEasyGridDrawInfo);
    // 计算 DrawInfo 数据结构
    procedure CalcDrawInfoXY(var DrawInfo: TEasyGridDrawInfo;
      UseWidth, UseHeight: Integer);
    // 计算固定行(列)信息
    procedure CalcFixedInfo(var DrawInfo: TEasyGridDrawInfo);
    // 计算页面绘画信息
    procedure CalcPageDrawInfo(var APageDrawInfoList: TPageDrawInfoList);
    // 计算对应某一 Cell 最大的 TopLeft 值(Fixed 区外)
    function CalcMaxTopLeft(const Coord: TGridCoord;
      const DrawInfo: TEasyGridDrawInfo): TGridCoord;
    // 计算新的选择范围
    function CalcMaxRange(StartCell, EnteredCell: TGridCoord) : TGridRect;
    // 恢复 Grid 模式到 gsNormal
    procedure CancelMode;
    // 判断能否画 Sizing 线
    function CanDrawSizingLine(AAxisDrawInfo:TEasyGridAxisDrawInfo;
             SizingPos: Integer; State: TEasyGridState): Boolean;
    // 修改 Grid 行列个数
    procedure ChangeSize(NewColCount, NewRowCount: Longint);
    // 把当前选中的 Cell 完全放入视口中
    procedure ClampInView(const Coord: TGridCoord; IsMouseMove: Boolean);
    // 画 Sizing 虚线
    procedure DrawSizingLine(const DrawInfo: TEasyGridDrawInfo);
    // 画 CopyMove 虚框
    procedure DrawCopyMoveRect(const DrawInfo: TEasyGridDrawInfo);
    // 画 Fill 虚框
    procedure DrawFillRect(const DrawInfo: TEasyGridDrawInfo);
    // 使某个 Cell 成为当前 Cell
    procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
    // 转换 Grid 坐标到 Screen 坐标
    procedure GridRectToScreenRect(GridRect: TGridRect;
      var ScreenRect: TRect; IncludeLine: Boolean);
    // 保存 InplaceEditor 的值并隐藏之
    procedure HideEdit;
    // 移动 Anchor
    procedure MoveAnchor(const NewAnchor: TGridCoord; MoveSel: Boolean = True);
    // 将当前 Cell 焦点移动到新的位置
    procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show, TopLeftChange: Boolean);
    // 设置新的 TopLeft
    procedure MoveTopLeft(ALeft, ATop: Longint);
    // 立即刷新第 Index 列右边的所有区域(列宽改变时被调用)
    procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
    // 立即刷新第 Index 行下面的所有区域(行高改变时被调用)
    procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
    // 选择区域移动后(拖动边框),重绘非重叠区域
    procedure SelectionMoved(OldSel: TGridRect);
    // 平滑滚动窗体
    procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TEasyGridDrawInfo);
    // 在 TopLeft 改变后对窗体进行平滑滚动,必要时刷新整个客户区
    procedure TopLeftMoved(const OldTopLeft: TGridCoord);
    // 修改滚动条位置
    procedure UpdateScrollPos;
    // 修改滚动条范围
    procedure UpdateScrollRange;
    // 判断滚动条是否可见
    function ScrollBarVisible(Code: Word): Boolean;
    // 取得列宽( Index 从 1 开始)
    function GetColWidths(Index: Longint): Integer;
    // 取得行高( Index 从 1 开始)
    function GetRowHeights(Index: Longint): Integer;
    // 取得选择区域(Grid 坐标)
    function GetSelection: TGridRect;
    // 取得 ColCanSizes ( Index 从 1 开始)
    function GetColCanSizes(Index: Longint): Boolean;
    // 取得 RowCanSizes ( Index 从 1 开始)
    function GetRowCanSizes(Index: Longint): Boolean;
    // 取得 TabStop ( Index 从 1 开始)
    function GetTabStops(Index: Longint): Boolean;
    // 取得可完整显示的非固定列数 ( Index 从 1 开始)
    function GetVisibleColCount: Integer;
    // 取得可完整显示的非固定行数 ( Index 从 1 开始)
    function GetVisibleRowCount: Integer;
    // 判断 Grid 是否为当前的活动控件(拥有焦点)
    function IsActiveControl: Boolean;
    procedure ReadColWidths(Reader: TReader);
    procedure ReadRowHeights(Reader: TReader);
    // 设置 BorderStyle 后重新创建控件窗口
    procedure SetBorderStyle(Value: TBorderStyle);
    // 设置当前 Cell 列坐标,产生 Click 事件
    procedure SetCol(Value: Longint);
    // 设置列数
    procedure SetColCount(Value: Longint);
    // 设置列宽并刷新 Index 列右边的窗口部分
    procedure SetColWidths(Index: Longint; Value: Integer);
    // 设置缺省列宽并刷新整个窗口
    procedure SetDefaultColWidth(Value: Integer);
    // 设置缺省行高并刷新整个窗口
    procedure SetDefaultRowHeight(Value: Integer);
    // 隐藏/显示 InplaceEditor
    procedure SetEditorMode(Value: Boolean);
    // 设置固定行(列)颜色并刷新窗口
    procedure SetFixedLineColor(Value: TColor);
    // 设置固定行(列)颜色并刷新窗口
    procedure SetClientLineColor(Value: TColor);
    // 设置标题栏颜色并刷新窗口
    procedure SetTitleColor(Value: TColor);
    // 设置高亮度背景颜色并刷新窗口
    procedure SetHighLightColor(Value: TColor);
    // 设置高亮度文本颜色并刷新窗口
    procedure SetHighLightTextColor(Value: TColor);
    // 设置焦点标题文本颜色并刷新窗口
    procedure SetFocusedTitleColor(Value: TColor);
    // 设置固定列个数并刷新窗口
    procedure SetFixedCols(Value: Integer);
    // 设置固定行个数并刷新窗口
    procedure SetFixedRows(Value: Integer);
    // 设置线宽并刷新窗口
    procedure SetGridLineWidth(Value: Integer);
    // 设置当前左上角网格列坐标
    procedure SetLeftCol(Value: Longint);
    // 设置 GridOptions
    procedure SetOptions(Value: TEasyGridOptions);
    // 设置当前 Cell 行坐标,产生 Click 事件
    procedure SetRow(Value: Longint);
    // 设置行数
    procedure SetRowCount(Value: Longint);
    // 设置行高并刷新 Index 行下面的窗口部分
    procedure SetRowHeights(Index: Longint; Value: Integer);
    // 设置 Grid 滚动条类型
    procedure SetScrollBars(Value: TScrollStyle);
    // 设置选择区域
    procedure SetSelection(Value: TGridRect);
    // 设置 ColCanSizes 数组
    procedure SetColCanSizes(Index: Longint; Value: Boolean);
    // 设置 RowCanSizes 数组
    procedure SetRowCanSizes(Index: Longint; Value: Boolean);
    // 设置 TabStops 数组
    procedure SetTabStops(Index: Longint; Value: Boolean);
    // 设置当前左上角网格行坐标
    procedure SetTopRow(Value: Longint);
    // 决定是否显示当前网格的 Editor
    procedure UpdateEdit;
    // 调用 SetEditText 向 Cell 回传 Editor 的内容
    procedure UpdateText;
    procedure InitializeGrid;
    procedure DisableEditUpdate;
    procedure EnableEditUpdate;

    procedure WriteColWidths(Writer: TWriter);
    procedure WriteRowHeights(Writer: TWriter);

    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 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 WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;

    function MouseCoord(X, Y: Integer): TGridCoord;
    procedure SetAutoUpdate(Value: Boolean);
    procedure DrawLine(ACanvas: TCanvas; X1, Y1, X2, Y2: Integer);
    function  GetColors(ACol, ARow: Integer): TColor;
    procedure SetColors(ACol, ARow: Integer; Value: TColor);
    function  GetMerges(ACol, ARow: Integer): PGridRect;
    procedure SetColTitle(Value: Boolean);
    procedure SetRowTitle(Value: Boolean);
    function  GetAlignMode(ACol, ARow: Integer): TAlignMode;
    procedure SetAlignMode(ACol, ARow: Integer; AlignMode: TAlignMode);
    function  GetForeText(ACol, ARow: Integer): string;
    procedure SetForeText(ACol, ARow: Integer; Value: string);
    function  GetBackText(ACol, ARow: Integer): string;
    procedure SetBackText(ACol, ARow: Integer; Value: string);
    procedure SetCellDataStyle(Value: TDataStyle);
    procedure SetCellAlignMode(Value: TAlignMode);
    procedure SetCellShowForeText(Value: Boolean);
    procedure SetCellReadOnly(Value: Boolean);
    procedure SetCellAutoWordBreak(Value: Boolean);
    procedure SetCellLineWidth(Value: Integer);
    procedure SetCellPenStyle(Value: TPenStyle);
    procedure SetCellAllowNegative(Value: Boolean);
    procedure SetCellTrailingZero(Value: Boolean);
    procedure SetCellZeroNull(Value: Boolean);
    procedure SetCellThousandSep(Value: Boolean);
    procedure SetCellMaxLength(Value: Integer);
    procedure SetCellIntLength(Value: Integer);
    procedure SetCellDecLength(Value: Integer);
    procedure SetCellColor(Value: TColor);
    procedure SetCellFontSize(Value: Integer);
    procedure SetCellFontColor(Value: TColor);
    procedure SetCellFontStyle(Value: TFontStyles);

    function  RegularRange(ASel: TGridRect) : Boolean;
    // 判断一个范围内是否包含有合并区域