dbgrideh.pas

很COOL的GRID控件

    function  DefaultAlignment: TAlignment;
    function  DefaultColor: TColor;
    function  DefaultFont: TFont;
    function  DefaultImeMode: TImeMode;
    function  DefaultImeName: TImeName;
    function  DefaultReadOnly: Boolean;
    function  DefaultWidth: Integer;
    procedure RestoreDefaults; virtual;
    //ddd
    function  DisplayText: String;
    function  GetColumnType: TColumnEhType;
    function  UsedFooter(Index: Integer): TColumnFooterEh;
    //\\\
    property  Grid: TCustomDBGridEh read GetGrid;
    property  AssignedValues: TColumnEhValues read FAssignedValues;
    property  Field: TField read GetField write SetField;
    property  CheckboxState: TCheckBoxState read GetCheckboxState write SetCheckboxState;
  published
    property Currency: Boolean read FCurrency;// write fcurrency default false;
    property  Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property  ButtonStyle: TColumnButtonStyleEh read FButtonStyle write SetButtonStyle default cbsAuto;
    property  Color: TColor read GetColor write SetColor stored IsColorStored;
    property  DropDownRows: Cardinal read FDropDownRows write FDropDownRows default 7;
    property  FieldName: String read FFieldName write SetFieldName;
    property  Font: TFont read GetFont write SetFont stored IsFontStored;
    property  ImeMode: TImeMode read GetImeMode write SetImeMode stored IsImeModeStored;
    property  ImeName: TImeName read GetImeName write SetImeName stored IsImeNameStored;
    property  PickList: TStrings read GetPickList write SetPickList;
    property  PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property  ReadOnly: Boolean read GetReadOnly write SetReadOnly stored IsReadOnlyStored;
    property  Title: TColumnTitleEh read FTitle write SetTitle;
    property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    //ddd
    property  AlwaysShowEditButton: Boolean read FAlwaysShowEditButton write SetAlwaysShowEditButton default False;
    property  AutoFitColWidth: Boolean read GetAutoFitColWidth write SetAutoFitColWidth default True;
    property  WordWrap: Boolean read GetWordWrap write SetWordWrap stored IsWordWrapStored;
    property  EndEllipsis: Boolean read FEndEllipsis write SetEndEllipsis default False;
    property  DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth  default 0;
    property  LookupDisplayFields: String read GetLookupDisplayFields write SetLookupDisplayFields stored IsLookupDisplayFieldsStored;
    property  AutoDropDown: Boolean read FAutoDropDown write SetAutoDropDown  default False;
    property  Footer: TColumnFooterEh read FFooter write SetFooter;
    property  Visible: Boolean read FVisible write SetVisible default True;
    property  KeyList: TStrings read GetKeykList write SetKeykList;
    property  ImageList: {$IFDEF EH_LIB_4}TCustomImageList{$ELSE}TImageList{$ENDIF} read FImageList write SetImageList;
    property  NotInKeyListIndex: Integer read FNotInKeyListIndex write SetNotInKeyListIndex default -1;
    property  MinWidth: Integer read FMinWidth write SetMinWidth default 0;
    property  MaxWidth: Integer read FMaxWidth write SetMaxWidth default 0;
    property  DblClickNextVal: Boolean read FDblClickNextVal write FDblClickNextVal default False;
    property  Checkboxes: Boolean read GetCheckboxes write SetCheckboxes stored IsCheckboxesStored;
    property  Increment: Extended read FIncrement write FIncrement stored IsIncrementStored;
    property  ToolTips: Boolean read GetToolTips write SetToolTips default False;
    property  Footers:TColumnFootersEh read FFooters write SetFooters;
    //\\\
  end;

  TColumnEhClass = class of TColumnEh;


  TDBGridColumnsEh = class(TCollection)
  private
    FGrid: TCustomDBGridEh;
    function GetColumn(Index: Integer): TColumnEh;
    function GetState: TDBGridColumnsState;
    procedure SetColumn(Index: Integer; Value: TColumnEh);
    procedure SetState(NewState: TDBGridColumnsState);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Grid: TCustomDBGridEh; ColumnClass: TColumnEhClass);
    function  Add: TColumnEh;
    procedure LoadFromFile(const Filename: string);
    procedure LoadFromStream(S: TStream);
    procedure RestoreDefaults;
    procedure RebuildColumns;
    procedure SaveToFile(const Filename: string);
    procedure SaveToStream(S: TStream);
    property State: TDBGridColumnsState read GetState write SetState;
    property Grid: TCustomDBGridEh read FGrid;
    property Items[Index: Integer]: TColumnEh read GetColumn write SetColumn; default;
    //ddd
    function  ExistFooterValueType(AFooterValueType:TFooterValueType):Boolean;
    //\\\
  end;

  //ddd
  TColumnsEhList = class(TList)
  private
    function GetColumn(Index: Integer): TColumnEh;
    procedure SetColumn(Index: Integer; const Value: TColumnEh);
  public
    property Items[Index: Integer]: TColumnEh read GetColumn write SetColumn; default;
  end;
  //\\\

  TGridDataLinkEh = class(TDataLink)
  private
    FGrid: TCustomDBGridEh;
    FFieldCount: Integer;
    FFieldMapSize: Integer;
    FFieldMap: Pointer;
    FModified: Boolean;
    FInUpdateData: Boolean;
    FSparseMap: Boolean;
    function GetDefaultFields: Boolean;
    function GetFields(I: Integer): TField;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure FocusControl(Field: TFieldRef); override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
    function  GetMappedIndex(ColIndex: Integer): Integer;
  public
    constructor Create(AGrid: TCustomDBGridEh);
    destructor Destroy; override;
    function AddMapping(const FieldName: string): Boolean;
    procedure ClearMapping;
    procedure Modified;
    procedure Reset;
    property DefaultFields: Boolean read GetDefaultFields;
    property FieldCount: Integer read FFieldCount;
    property Fields[I: Integer]: TField read GetFields;
    property SparseMap: Boolean read FSparseMap write FSparseMap;
  end;

  TBookmarkListEh = class
  private
    FList: TStringList;
    FGrid: TCustomDBGridEh;
    FCache: TBookmarkStr;
    FCacheIndex: Integer;
    FCacheFind: Boolean;
    FLinkActive: Boolean;
    function GetCount: Integer;
    function GetCurrentRowSelected: Boolean;
    function GetItem(Index: Integer): TBookmarkStr;
    procedure SetCurrentRowSelected(Value: Boolean);
    procedure StringsChanged(Sender: TObject);
  protected
    function CurrentRow: TBookmarkStr;
    function Compare(const Item1, Item2: TBookmarkStr): Integer;
    procedure LinkActive(Value: Boolean);
  public
    constructor Create(AGrid: TCustomDBGridEh);
    destructor Destroy; override;
    procedure Clear;           // free all bookmarks
    procedure Delete;          // delete all selected rows from dataset
    function  Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
    function  IndexOf(const Item: TBookmarkStr): Integer;
    function  Refresh: Boolean;// drop orphaned bookmarks; True = orphans found
    //d
    procedure SelectAll;
    //d\
    property Count: Integer read GetCount;
    property CurrentRowSelected: Boolean read GetCurrentRowSelected
      write SetCurrentRowSelected;
    property Items[Index: Integer]: TBookmarkStr read GetItem; default;
  end;


// For MultiTigtle

  THeadTreeNode = class;
  TDBGridEh = class;

  LeafCol = record
    FLeaf:THeadTreeNode;
    FColumn:TColumnEh;
  end;

  PLeafCol = ^LeafCol;
  TLeafCol = array[0..MaxListSize - 1] of LeafCol;
  PTLeafCol = ^TLeafCol;


{  THeadTreeNode }

  THeadTreeProc = procedure (node:THeadTreeNode) of object;
  THeadTreeNode = class(TObject)
  public
    Host:THeadTreeNode;
    Child:THeadTreeNode;
    Next:THeadTreeNode;
    Text:String;
    Height:Integer;
    Width:Integer;
    WIndent:Integer;
    VLineWidth:Integer;
    Drawed:Boolean;
    HeightPrn:Integer;
    WidthPrn:Integer;
    Column:TColumnEh;
    constructor Create;
    constructor CreateText(AText:String;AHeight,AWidth:Integer);
    destructor Destroy; override;
    function Add(AAfter:THeadTreeNode;AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
    function AddChild(ANode:THeadTreeNode;AText:String;AHeight,AWidth:Integer):THeadTreeNode ;
    function Find(ANode:THeadTreeNode):Boolean;
    procedure Union(AFrom,ATo :THeadTreeNode; AText:String;AHeight:Integer);
    procedure FreeAllChild;
    procedure CreateFieldTree(AGrid:TCustomDBGridEh);
    procedure DoForAllNode(proc:THeadTreeProc);
  end;

  TDBGridEhSumList = class(TDBSumListProducer)
  private
    function GetActive: Boolean;
    procedure SetActive(const Value: Boolean);
  public
    constructor Create(AOwner:TComponent);
  published
    property Active: Boolean read GetActive write SetActive default False;
    property ExternalRecalc default False;
    property VirtualRecords default False;
    property SumListChanged;
    property OnRecalcAll;
  end;

  TDBGridEhScrollBar = class(TPersistent)
  private
    FDBGridEh: TCustomDBGridEh;
    FKind: TScrollBarKind;
    FVisible: Boolean;
    FTracking: Boolean;
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(AGrid: TCustomDBGridEh; AKind: TScrollBarKind);
    procedure Assign(Source: TPersistent); override;
    property Kind: TScrollBarKind read FKind;
    function IsScrollBarVisible: Boolean;
  published
    property Tracking: Boolean read FTracking write FTracking default False;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;


// For TCustomDBGridEh

  TDBGridEhOption = (dghFixed3D, dghFrozen3D, dghFooter3D, dghData3D, dghResizeWholeRightPart,
                     dghHighlightFocus, dghClearSelection, dghFitRowHeightToText, dghAutoSortMarking,
                     dghMultiSortMarking, dghEnterAsTab);
  TDBGridEhOptions = set of TDBGridEhOption;

  TDBGridEhSelectionType = (gstNon, gstRecordBookmarks, gstRectangle, gstColumns, gstAll);

  TDBCell = record
    Col : Longint;
    Row : TBookmarkStr;
  end;

  TDBGridEhSelectionRect = class(TObject)
  private
    FGrid:TCustomDBGridEh;
    FAnchor:TDBCell;
    FShiftCell:TDBCell;
    function CheckState:Boolean;
    function GetBottomRow: TBookmarkStr;
    function GetLeftCol: Longint;
    function GetRightCol: Longint;
    function GetTopRow: TBookmarkStr;
    function BoxRect(ALeft:Longint; ATop:TBookmarkStr; ARight:Longint; ABottom:TBookmarkStr): TRect;
  public
    constructor Create(AGrid:TCustomDBGridEh);
    procedure Clear;
    procedure Select(ACol :Longint; ARow :TBookmarkStr; AddSel:Boolean);
    function DataCellSelected(DataCol :Longint; DataRow :TBookmarkStr):Boolean;
    property LeftCol : Longint read GetLeftCol;
    property RightCol: Longint read GetRightCol;
    property TopRow   : TBookmarkStr read GetTopRow;
    property BottomRow: TBookmarkStr read GetBottomRow;
  end;

  TDBGridEhSelectionCols = class(TColumnsEhList)
  private
    FGrid:TCustomDBGridEh;
    FAnchor:TColumnEh;
    FShiftCol:TColumnEh;
    FShiftSelectedCols:TColumnsEhList;
//    function Get(Index: Integer): TColumnEh;
//    procedure Put(Index: Integer; const Value: TColumnEh);
    procedure Add(ACol: TColumnEh);
  public
    constructor Create(AGrid:TCustomDBGridEh);
    destructor Destroy; override;
    procedure InvertSelect(ACol: TColumnEh);
    procedure Select(ACol: TColumnEh; AddSel:Boolean);
    procedure SelectShift(ACol: TColumnEh{; Clear:Boolean});
{$IFDEF EH_LIB_4}
    procedure Clear; override;
{$ELSE}
    procedure Clear;
{$ENDIF}
    procedure Refresh;
//    property Items[Index: Integer]: TColumnEh read Get write Put; default;
  end;

  TDBGridEhSelection = class
  private
    FGrid:TCustomDBGridEh;
    FRect:TDBGridEhSelectionRect;
    FColumns:TDBGridEhSelectionCols;
    FSelectionType:TDBGridEhSelectionType;
    function GetRows: TBookmarkListEh;
    procedure LinkActive(Value: Boolean);
    procedure SetSelectionType(ASelType:TDBGridEhSelectionType);
  public
    constructor Create(AGrid:TCustomDBGridEh);
    destructor Destroy; override;
    function DataCellSelected(DataCol :Longint; DataRow :TBookmarkStr):Boolean;
//    function CellSelected(ACol :Longint; ARow :Longint):Boolean;
    procedure Clear;
    procedure SelectAll;
    procedure Refresh;
    procedure UpdateState;
    property Columns: TDBGridEhSelectionCols read FColumns;
    property SelectionType:TDBGridEhSelectionType read FSelectionType;
    property Rect: TDBGridEhSelectionRect read FRect;
    property Rows: TBookmarkListEh read GetRows;
  end;

  TDBGridEhState = (dgsNormal, dgsRowSelecting, dgsColSelecting, dgsRectSelecting,
                    dgsPosTracing, dgsTitleDown, dgsColSizing);

  TDBGridEhAllowedOperation = (alopInsertEh, alopUpdateEh, alopDeleteEh, alopAppendEh);
  TDBGridEhAllowedOperations = set of TDBGridEhAllowedOperation;

  { The DBGridEh's DrawDataCell virtual method and OnDrawDataCell event are only
    called when the grid's Columns.State is csDefault.  This is for compatibility
    with existing code. These routines don't provide sufficient information to
    determine which column is being drawn, so the column attributes aren't
    easily accessible in these routines.  Column attributes also introduce the