gridseh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{                TCustomGridEh component                }
{                    (Build 4.2.07)                     }
{                                                       }
{     This unit is a changed standard Grids.Pas unit    }
{     from Borland Delphi Visual Component Library      }
{ Copyright (c) 1995, 2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}

unit GridsEh;

//{$R-,T-,H+,X+}

interface

uses Messages, {$IFDEF LINUX} WinUtils, {$ENDIF} Windows, SysUtils, Classes,
{$IFDEF EH_LIB_6} Types, {$ENDIF}
{$IFDEF CIL}
  EhLibVCLNET,
{$ELSE}
  EhLibVCL,
{$ENDIF}
  Graphics, Menus, Controls, Forms, StdCtrls, Mask;

const
  MaxCustomExtentsEh = MaxListSize;
  MaxShortIntEh = High(ShortInt);

type
  EInvalidGridOperationEh = class(Exception);

  TIntegerArray = array of Integer;
  TPointArray = array of TPoint;
  TDWORDArray = array of DWORD;

  { Internal grid types }
  TGetExtentsFuncEh = function(Index: Longint): Integer of object;

  TGridAxisDrawInfoEh = record
    EffectiveLineWidth: Integer;          //Width of line
    FixedBoundary: Integer;               //Boundary of fixed area
    GridBoundary: Integer;                //Boundary of visible data grid area <= GridExtent
    GridExtent: Integer;                  //Boundary of data grid area = ClientArea - ContraExtent
    LastFullVisibleCell: Longint;         //Last full visible data cell
    FullVisBoundary: Integer;             //Boundary of full visible data grid area <= GridExtent
    FixedCellCount: Integer;              //Fixed cell count
    FirstGridCell: Integer;               //First visible data cell
    GridCellCount: Integer;               //DataFixedColCount or DataFixedRowCount
    GetExtent: TGetExtentsFuncEh;         //ColWidths or RowWidths

    NoFrozenBoundary: Integer;            //Boundary of fixed area - Frozen Boundary
    FrozenCelCount: Integer;

    ContraCelCount: Integer;
    ContraExtent: Integer;
    FullGridExtent: Integer;              //Boundary of data grid area = ClientArea
    FullGridBoundary: Integer;            //=FullGridExtent (ContraCelCount > 0) or =GridBoundary
    FullGridCellCount: Integer;           //ColCount or RowCount
    DataOffset: Integer;                  //Offset of smooth data
    VirtualGridBoundary: Integer;         //Boundary of visible data grid area <= GridExtent + DataOffset
  end;

  TGridDrawInfoEh = record
    Horz, Vert: TGridAxisDrawInfoEh;
  end;

  TDrawLinesInfoEh = record
    PointsList: TPointArray;
    StrokeList: TDWORDArray;
    MaxStroke: Integer;
    LastCol: Longint;
    LastRow: Longint;
    VertColor: TColor;
    HorzColor: TColor;
  end;

  TGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing,
    gsRowMoving, gsColMoving);
  TGridMovement = gsRowMoving..gsColMoving;

  TRCRRec = record
    Result: Integer;
    RectRgn: HRGN;
  end;

  { TInplaceEdit }
  { The inplace editor is not intended to be used outside the grid }

  TCustomGridEh = class;

  TInplaceEdit = class(TCustomMaskEdit)
  private
    FGrid: TCustomGridEh;
    FClickTime: Longint;
    procedure InternalMove(const Loc: TRect; Redraw: Boolean);
    procedure SetGrid(Value: TCustomGridEh);
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMClear(var Message: TMessage); 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 BoundsChanged; virtual;
    procedure UpdateContents; virtual;
    procedure WndProc(var Message: TMessage); override;
    property  Grid: TCustomGridEh read FGrid;
  public
    constructor Create(AOwner: TComponent); 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 MaxLength;
  end;

  { TGridLineColorsEh }

  TGridLineColorsEh = class(TPersistent)
  private
    FGrid: TCustomGridEh;
    FBrightColor: TColor;
    FDarkColor: TColor;
    FDataHorzColor: TColor;
    FDataVertColor: TColor;
    FFixedHorzColor: TColor;
    FFixedVertColor: TColor;
    FHorzAreaContraBorderColor: TColor;
    FHorzAreaContraHorzColor: TColor;
    FHorzAreaContraVertColor: TColor;
    FHorzAreaFrozenBorderColor: TColor;
    FHorzAreaFrozenHorzColor: TColor;
    FHorzAreaFrozenVertColor: TColor;
    FVertAreaContraBorderColor: TColor;
    FVertAreaContraHorzColor: TColor;
    FVertAreaContraVertColor: TColor;
    FVertAreaFrozenBorderColor: TColor;
    FVertAreaFrozenHorzColor: TColor;
    FVertAreaFrozenVertColor: TColor;
  protected
    property Grid: TCustomGridEh read FGrid;
  public
    constructor Create(AGrid: TCustomGridEh);

    function GetDarkColor: TColor; virtual;
    function GetBrightColor: TColor; virtual;

    function GetCellColor(ACol, ARow: Longint): TColor; virtual;
    function GetLeftBorderCellColor(ACol, ARow: Longint): TColor; virtual;
    function GetTopBorderCellColor(ACol, ARow: Longint): TColor; virtual;
    function GetRightBorderCellColor(ACol, ARow: Longint): TColor; virtual;
    function GetDownBorderCellColor(ACol, ARow: Longint): TColor; virtual;

    function GetFixedVertColor: TColor; virtual;
    function GetFixedHorzColor: TColor; virtual;
    function GetVertAreaFrozenVertColor: TColor; virtual;
    function GetVertAreaFrozenHorzColor: TColor; virtual;
    function GetHorzAreaFrozenVertColor: TColor; virtual;
    function GetHorzAreaFrozenHorzColor: TColor; virtual;
    function GetVertAreaFrozenBorderColor: TColor; virtual;
    function GetHorzAreaFrozenBorderColor: TColor; virtual;
    function GetDataVertColor: TColor; virtual;
    function GetDataHorzColor: TColor; virtual;
    function GetVertAreaContraVertColor: TColor; virtual;
    function GetVertAreaContraHorzColor: TColor; virtual;
    function GetHorzAreaContraVertColor: TColor; virtual;
    function GetHorzAreaContraHorzColor: TColor; virtual;
    function GetVertAreaContraBorderColor: TColor; virtual;
    function GetHorzAreaContraBorderColor: TColor; virtual;

    property DarkColor: TColor read FDarkColor write FDarkColor default clDefault;
    property BrightColor: TColor read FBrightColor write FBrightColor default clDefault;
    property FixedVertColor: TColor read FFixedVertColor write FFixedVertColor default clDefault;
    property FixedHorzColor: TColor read FFixedHorzColor write FFixedHorzColor default clDefault;
    property VertAreaFrozenVertColor: TColor read FVertAreaFrozenVertColor write FVertAreaFrozenVertColor default clDefault;
    property VertAreaFrozenHorzColor: TColor read FVertAreaFrozenHorzColor write FVertAreaFrozenHorzColor default clDefault;
    property HorzAreaFrozenVertColor: TColor read FHorzAreaFrozenVertColor write FHorzAreaFrozenVertColor default clDefault;
    property HorzAreaFrozenHorzColor: TColor read FHorzAreaFrozenHorzColor write FHorzAreaFrozenHorzColor default clDefault;
    property VertAreaFrozenBorderColor: TColor read FVertAreaFrozenBorderColor write FVertAreaFrozenBorderColor default clDefault;
    property HorzAreaFrozenBorderColor: TColor read FHorzAreaFrozenBorderColor write FHorzAreaFrozenBorderColor default clDefault;
    property DataVertColor: TColor read FDataVertColor write FDataVertColor default clDefault;
    property DataHorzColor: TColor read FDataHorzColor write FDataHorzColor default clDefault;
    property VertAreaContraVertColor: TColor read FVertAreaContraVertColor write FVertAreaContraVertColor default clDefault;
    property VertAreaContraHorzColor: TColor read FVertAreaContraHorzColor write FVertAreaContraHorzColor default clDefault;
    property HorzAreaContraVertColor: TColor read FHorzAreaContraVertColor write FHorzAreaContraVertColor default clDefault;
    property HorzAreaContraHorzColor: TColor read FHorzAreaContraHorzColor write FHorzAreaContraHorzColor default clDefault;
    property VertAreaContraBorderColor: TColor read FVertAreaContraBorderColor write FVertAreaContraBorderColor default clDefault;
    property HorzAreaContraBorderColor: TColor read FHorzAreaContraBorderColor write FHorzAreaContraBorderColor default clDefault;
  end;

  { TCustomGridEh }

  TGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
    goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
    goColMoving, goEditing, goTabs, goRowSelect,
    goAlwaysShowEditor, goThumbTracking);
  TGridOptions = set of TGridOption;
  TGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  TGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);

  TGridCoord = record
    X: Longint;
    Y: Longint;
  end;

  TGridRect = TRect;

  TEditStyle =  (esSimple, esEllipsis, esPickList);

  TSelectCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    var CanSelect: Boolean) of object;
  TDrawCellEvent = procedure (Sender: TObject; ACol, ARow: Longint;
    Rect: TRect; State: TGridDrawState) of object;
  TGridEhCellMouseEvent = procedure (Grid: TCustomGridEh; Cell: TGridCoord;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;

  TCustomGridEh = class(TCustomControl)
  private
    FAnchor: TGridCoord;
    FBorderStyle: TBorderStyle;
    FCanEditModify: Boolean;
    FColCount: Longint;
    FColOffset: Integer;
    FColWidths: TIntegerArray;
    FContraColCount: Longint;
    FContraRowCount: Longint;
    FCurrent: TGridCoord;
    FDefaultColWidth: Integer;
    FDefaultDrawing: Boolean;
    FDefaultRowHeight: Integer;
    FEditorMode: Boolean;
    FFixedColor: TColor;
    FFixedCols: Integer;
    FFixedRows: Integer;
    FFlat: Boolean;
    FFrozenColCount: Longint;
    FFrozenRowCount: Longint;
    FGridLineColors: TGridLineColorsEh;
    FGridLineWidth: Integer;
    FHitTest: TPoint;
    FInplaceCol, FInplaceRow: Longint;
    FInplaceEdit: TInplaceEdit;
    FMoveIndex, FMovePos: Longint;
    FOnCellMouseClick: TGridEhCellMouseEvent;
    FOptions: TGridOptions;
    FRowCount: Longint;
    FRowHeights: TIntegerArray;
    FScrollBars: TScrollStyle;
    FSizingIndex: Longint;
    FSizingPos, FSizingOfs: Integer;
    FTabStops: TIntegerArray;
    FTopLeft: TGridCoord;
    function CalcCoordFromPoint(X, Y: Integer;
      const DrawInfo: TGridDrawInfoEh): TGridCoord;
    procedure CalcDrawInfoXY(var DrawInfo: TGridDrawInfoEh;
      UseWidth, UseHeight: Integer);
    function CalcMaxTopLeft(const Coord: TGridCoord;
      const DrawInfo: TGridDrawInfoEh): TGridCoord;
    procedure CancelMode;
    procedure ChangeSize(NewColCount, NewRowCount: Longint);
    procedure ClampInView(const Coord: TGridCoord);
    procedure DrawSizingLine(const DrawInfo: TGridDrawInfoEh);
    procedure DrawMove;
    procedure GridRectToScreenRect(GridRect: TGridRect;
      var ScreenRect: TRect; IncludeLine: Boolean);
    procedure Initialize;
    procedure InvalidateRect(ARect: TGridRect);
    procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal;
      UseRightToLeft: Boolean);
    procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
    procedure MoveAnchor(const NewAnchor: TGridCoord);
    procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TGridDrawInfoEh;
      var Axis: TGridAxisDrawInfoEh; Scrollbar: Integer; const MousePt: 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 SelectionMoved(const OldSel: TGridRect);
    procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TGridDrawInfoEh);
    procedure TopLeftMoved(const OldTopLeft: TGridCoord);
    procedure UpdateScrollPos;
    procedure UpdateScrollRange;
    function GetColWidths(Index: Longint): Integer;
    function GetRowHeights(Index: Longint): Integer;
    function GetSelection: TGridRect;
    function GetTabStops(Index: Longint): Boolean;
    function GetVisibleColCount: Integer;
    function GetVisibleRowCount: Integer;
    function IsActiveControl: Boolean;
    procedure ReadColWidths(Reader: TReader);
    procedure ReadRowHeights(Reader: TReader);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetCol(Value: Longint);
    procedure SetColCount(Value: Longint);
    procedure SetColWidths(Index: Longint; Value: Integer);
    procedure SetDefaultColWidth(Value: Integer);
    procedure SetDefaultRowHeight(Value: Integer);
    procedure SetEditorMode(Value: Boolean);
    procedure SetFixedColor(Value: TColor);
    procedure SetFixedCols(Value: Integer);
    procedure SetFixedRows(Value: Integer);
    procedure SetGridLineWidth(Value: Integer);
    procedure SetLeftCol(Value: Longint);
    procedure SetOptions(Value: TGridOptions);
    procedure SetRow(Value: Longint);
    procedure SetRowCount(Value: Longint);
    procedure SetRowHeights(Index: Longint; Value: Integer);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetSelection(Value: TGridRect);
    procedure SetTabStops(Index: Longint; Value: Boolean);
    procedure SetTopRow(Value: Longint);
    procedure UpdateEdit;
    procedure UpdateText;
    procedure WriteColWidths(Writer: TWriter);
    procedure WriteRowHeights(Writer: TWriter);
    procedure CMCancelMode(var Msg: TCMCancelMode); 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 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: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    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;
    procedure SetContraColCount(const Value: Longint);
    procedure SetContraRowCount(const Value: Longint);
    function GetFullColCount: Longint;
    function GetFullRowCount: Longint;
    procedure SetFlat(const Value: Boolean);
    procedure SetFrozenColCount(const Value: Longint);
    procedure SetFrozenRowCount(const Value: Longint);
    function SetDataDrawOriginClipRegion(StartX, StartY, StopX, StopY: Integer): TRCRRec;
    procedure RestoreDataDrawOriginClipRegion(var RCR: TRCRRec);
  protected
    DesignOptionsBoost: TGridOptions;
    FColDataOffset: Integer;
    FFixedLineColor: TColor;
    FGridState: TGridState;
    FLockPaint: Integer;
    FMouseDownCell: TGridCoord;
    FSaveCellExtents: Boolean;
    VirtualView: Boolean;
    function CreateEditor: TInplaceEdit; virtual;
    function ResizeLine(const AxisInfo: TGridAxisDrawInfoEh): Integer;
    procedure CalcDrawInfo(var DrawInfo: TGridDrawInfoEh);
    procedure CalcContraInfo(var DrawInfo: TGridDrawInfoEh; UseWidth, UseHeight: Integer);
    procedure CalcFixedInfo(var DrawInfo: TGridDrawInfoEh);
    procedure CalcSizingState(X, Y: Integer; var State: TGridState;
      var Index: Longint; var SizingPos, SizingOfs: Integer;
      var FixedInfo: TGridDrawInfoEh); virtual;
    procedure ChangeGridOrientation(RightToLeftOrientation: Boolean);

    procedure CellMouseClick(Cell: TGridCoord; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure LockPaint;
    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;
    procedure AdjustSize(Index, Amount: Longint; Rows: Boolean); reintroduce; dynamic;