让你的DBGrid竖着站（1）

【 tulaoshi.com - 编程语言 】

　　
　　  For a long time till a few months, i was trying to find a solution for
　　  vertical grid. I found a few grid components that claimed to be vertical, but
　　  this was far from tue.
　　  So one day i decided to have a better look at the DBGrids.pas in Borland VCL source.
　　  "Bit by bit" as we say in Greece i started changing the code and finally
　　  a TRUE VERTICAL DBGRID component is what we have here.

　　  I wonder why Borland did't think about this. After all it seems so SIMPLE!!!

　　  NEW PROPERTIES
　　  Vertical: Boolean, set to True and and the grid becomes VERTICAL
　　  OnlyOne: Boolean, set to true if you want the grid to display only one record
　　           at a time (the curent record).
　　  TitlesWidth: integer, set the vertical column title's width.

　　  NOTE: because all the code is duplicated from the VCL, all the classes are
　　  redefined (TColumn, TDBGridColumns, TGridDatalink e.t.c).
　　  The columns editor works fine except that it does not bring the fields list.
　　  This is something that i may do in future versions but if someone find's a
　　  way to solve it or even has property editor for the columns please drop me
　　  an E-Mail.

　　
　　Free to use and redistribute, but my name must
　　appear somewhere in the source code, or in the software.
　　No warranty is given by the author, expressed or implied.

　　WARNING! THE CODE IS PROVIDED AS IS WITH NO GUARANTEES OF ANY KIND!
　　USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE FOR
　　ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!

　　}
　　{**********************************************************************************}

　　unit DBVGrids;

　　{$R-}

　　interface

　　uses Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
　　  Graphics, Grids, DBCtrls, Db, Menus, DBGrids, Variants;

　　type
　　  TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
　　    cvTitleCaption, cvTitleAlignment, cvTitleFont, cvImeMode, cvImeName);
　　  TColumnValues = set of TColumnValue;

　　const
　　  ColumnTitleValues = [cvTitleColor..cvTitleFont];
　　  cm_DeferLayout = WM_USER + 100;

　　{ TColumn defines internal storage for column attributes.  Values assigned
　　  to properties are stored in this object, the grid- or field-based default
　　  sources are not modified.  Values read from properties are the previously
　　  assigned value, if any, or the grid- or field-based default values if
　　  nothing has been assigned to that property. This class also publishes the
　　  column attribute properties for persistent storage.  }
　　type
　　  TColumn = class;
　　  TCustomVDBGrid = class;

　　  TColumnTitle = class(TPersistent)
　　  private
　　    FColumn: TColumn;
　　    FCaption: string;
　　    FFont: TFont;
　　    FColor: TColor;
　　    FAlignment: TAlignment;
　　    procedure FontChanged(Sender: TObject);
　　    function GetAlignment: TAlignment;
　　    function GetColor: TColor;
　　    function GetCaption: string;
　　    function GetFont: TFont;
　　    function IsAlignmentStored: Boolean;
　　    function IsColorStored: Boolean;
　　    function IsFontStored: Boolean;
　　    function IsCaptionStored: Boolean;
　　    procedure SetAlignment(Value: TAlignment);
　　    procedure SetColor(Value: TColor);
　　    procedure SetFont(Value: TFont);
　　    procedure SetCaption(const Value: string); virtual;
　　  protected
　　    procedure RefreshDefaultFont;
　　  public
　　    constructor Create(Column: TColumn);
　　    destructor Destroy; override;
　　    procedure Assign(Source: TPersistent); override;
　　    function DefaultAlignment: TAlignment;
　　    function DefaultColor: TColor;
　　    function DefaultFont: TFont;
　　    function DefaultCaption: string;
　　    procedure RestoreDefaults; virtual;
　　  published
　　    property Alignment: TAlignment read GetAlignment write SetAlignment
　　      stored IsAlignmentStored;
　　    property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
　　    property Color: TColor read GetColor write SetColor stored IsColorStored;
　　    property Font: TFont read GetFont write SetFont stored IsFontStored;
　　  end;

　　  TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);

　　  TColumn = class(TCollectionItem)
　　  private
　　    FField: TField;
　　    FFieldName: string;
　　    FColor: TColor;
　　    FWidth: Integer;
　　    FTitle: TColumnTitle;
　　    FFont: TFont;
　　    FImeMode: TImeMode;
　　    FImeName: TImeName;
　　    FPickList: TStrings;
　　    FPopupMenu: TPopupMenu;
　　    FDropDownRows: Cardinal;
　　    FButtonStyle: TColumnButtonStyle;
　　    FAlignment: TAlignment;
　　    FReadonly: Boolean;
　　    FAssignedValues: TColumnValues;
　　    procedure FontChanged(Sender: TObject);
　　    function  GetAlignment: TAlignment;
　　    function  GetColor: TColor;
　　    function  GetField: TField;
　　    function  GetFont: TFont;
　　    function  GetImeMode: TImeMode;
　　    function  GetImeName: TImeName;
　　    function  GetPickList: TStrings;
　　    function  GetReadOnly: Boolean;
　　    function  GetWidth: Integer;
　　    function  IsAlignmentStored: Boolean;
　　    function  IsColorStored: Boolean;
　　    function  IsFontStored: Boolean;
　　    function  IsImeModeStored: Boolean;
　　    function  IsImeNameStored: Boolean;
　　    function  IsReadOnlyStored: Boolean;
　　    function  IsWidthStored: Boolean;
　　    procedure SetAlignment(Value: TAlignment); virtual;
　　    procedure SetButtonStyle(Value: TColumnButtonStyle);
　　    procedure SetColor(Value: TColor);
　　    procedure SetField(Value: TField); virtual;
　　    procedure SetFieldName(const Value: String);
　　    procedure SetFont(Value: TFont);
　　    procedure SetImeMode(Value: TImeMode); virtual;
　　    procedure SetImeName(Value: TImeName); virtual;
　　    procedure SetPickList(Value: TStrings);
　　    procedure SetPopupMenu(Value: TPopupMenu);
　　    procedure SetReadOnly(Value: Boolean); virtual;
　　    procedure SetTitle(Value: TColumnTitle);
　　    procedure SetWidth(Value: Integer); virtual;
　　  protected
　　    function  CreateTitle: TColumnTitle; virtual;
　　    function  GetGrid: TCustomVDBGrid;
　　    function GetDisplayName: string; override;
　　    procedure RefreshDefaultFont;
　　  public
　　    constructor Create(Collection: TCollection); override;
　　    destructor Destroy; override;
　　    procedure Assign(Source: TPersistent); override;
　　    function  DefaultAlignment: TAlignment;
　　    function  DefaultColor: TColor;
　　    function  DefaultFont: TFont;
　　    function  DefaultImeMode: TImeMode;
　　    function  DefaultImeName: TImeName;
　　    function  DefaultReadOnly: Boolean;
　　    function  DefaultWidth: Integer;
　　    procedure RestoreDefaults; virtual;
　　    property  Grid: TCustomVDBGrid read GetGrid;
　　    property  AssignedValues: TColumnValues read FAssignedValues;
　　    property  Field: TField read GetField write SetField;
　　  published
　　    property  Alignment: TAlignment read GetAlignment write SetAlignment
　　      stored IsAlignmentStored;
　　    property  ButtonStyle: TColumnButtonStyle 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: TColumnTitle read FTitle write SetTitle;
　　    property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
　　  end;

　　  TColumnClass = class of TColumn;

　　  TDBGridColumnsState = (csDefault, csCustomized);

　　  TDBGridColumns = class(TCollection)
　　  private
　　    FGrid: TCustomVDBGrid;
　　    function GetColumn(Index: Integer): TColumn;
　　    function GetState: TDBGridColumnsState;
　　    procedure SetColumn(Index: Integer; Value: TColumn);
　　    procedure SetState(NewState: TDBGridColumnsState);
　　  protected
　　    function GetOwner: TPersistent; override;
　　    procedure Update(Item: TCollectionItem); override;
　　  public
　　    constructor Create(Grid: TCustomVDBGrid; ColumnClass: TColumnClass);
　　    function  Add: TColumn;
　　    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: TCustomVDBGrid read FGrid;
　　    property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
　　  end;

　　  TGridDataLink = class(TDataLink)
　　  private
　　    FGrid: TCustomVDBGrid;
　　    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: TCustomVDBGrid);
　　    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;

　　  TBookmarkList = class
　　  private
　　    FList: TStringList;
　　    FGrid: TCustomVDBGrid;
　　    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: TCustomVDBGrid);
　　    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
　　    property Count: Integer read GetCount;
　　    property CurrentRowSelected: Boolean read GetCurrentRowSelected
　　      write SetCurrentRowSelected;
　　    property Items[Index: Integer]: TBookmarkStr read GetItem; default;
　　  end;

　　  TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
　　    dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
　　    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect);
　　  TDBGridOptions = set of TDBGridOption;

　　  { The VDBGrid'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
　　    possibility that a column's field may be nil, which would break existing
　　    DrawDataCell code.   DrawDataCell, OnDrawDataCell, and DefaultDrawDataCell
　　    are obsolete, retained for compatibility purposes. }
　　  TDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
　　    State: TGridDrawState) of object;

　　  { The VDBGrid's DrawColumnCell virtual method and OnDrawColumnCell event are
　　    always called, when the grid has defined column attributes as well as when
　　    it is in default mode.  These new routines provide the additional
　　    information needed to access the column attributes for the cell being
　　    drawn, and must support nil fields.  }

　　  TDrawColumnCellEvent = procedure (Sender: TObject; const Rect: TRect;
　　    DataCol: Integer; Column: TColumn; State: TGridDrawState) of object;
　　  TDBGridClickEvent = procedure (Column: TColumn) of object;

　　  TCustomVDBGrid = class(TCustomGrid)
　　  private
　　    FIndicators: TImageList;
　　    FTitleFont: TFont;
　　    FReadOnly: Boolean;
　　    FOriginalImeName: TImeName;
　　    FOriginalImeMode: TImeMode;
　　    FUserChange: Boolean;
　　    FLayoutFromDataset: Boolean;
　　    FOptions: TDBGridOptions;
　　    FTitleOffset, FIndicatorOffset: Byte;
　　    FUpdateLock: Byte;
　　    FLayoutLock: Byte;
　　    FInColExit: Boolean;
　　    FDefaultDrawing: Boolean;
　　    FSelfChangingTitleFont: Boolean;
　　    FSelecting: Boolean;
　　    FSelRow: Integer;
　　    FDataLink: TGridDataLink;
　　    FOnColEnter: TNotifyEvent;
　　    FOnColExit: TNotifyEvent;
　　    FOnDrawDataCell: TDrawDataCellEvent;
　　    FOnDrawColumnCell: TDrawColumnCellEvent;
　　    FEditText: string;
　　    FColumns: TDBGridColumns;
　　    FOnEditButtonClick: TNotifyEvent;
　　    FOnColumnMoved: TMovedEvent;
　　    FBookmarks: TBookmarkList;
　　    FSelectionAnchor: TBookmarkStr;
　　    FVertical: Boolean;
　　    FOnlyOne: Boolean;
　　    FTitlesWidth: integer;
　　    FOnCellClick: TDBGridClickEvent;
　　    FOnTitleClick:TDBGridClickEvent;
　　    function AcquireFocus: Boolean;
　　    procedure DataChanged;
　　    procedure EditingChanged;
　　    function GetDataSource: TDataSource;
　　    function GetFieldCount: Integer;
　　    function GetFields(FieldIndex: Integer): TField;
　　    function GetSelectedField: TField;
　　    function GetSelectedIndex: Integer;
　　    procedure InternalLayout;
　　    procedure MoveCol(RawCol: Integer);
　　    procedure ReadColumns(Reader: TReader);
　　    procedure RecordChanged(Field: TField);
　　    procedure SetIme;
　　    procedure SetColumns(Value: TDBGridColumns);
　　    procedure SetDataSource(Value: TDataSource);
　　    procedure SetOptions(Value: TDBGridOptions);
　　    procedure SetSelectedField(Value: TField);
　　    procedure SetSelectedIndex(Value: Integer);
　　    procedure SetTitleFont(Value: TFont);
　　    procedure TitleFontChanged(Sender: TObject);
　　    procedure UpdateData;
　　    procedure UpdateActive;
　　    procedure UpdateIme;
　　    procedure UpdateScrollBar;
　　    procedure UpdateRowCount;
　　    procedure WriteColumns(Writer: TWriter);
　　    procedure SetVertical(Value: Boolean);
　　    procedure SetOnlyOne(Value: Boolean);
　　    procedure SetTitlesWidth(Value: integer);
　　    function TabStopRow(Arow: integer): Boolean;
　　    procedure CMExit(var Message: TMessage); message CM_EXIT;
　　    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
　　    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
　　    procedure CMDeferLayout(var Message); message cm_DeferLayout;
　　    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
　　    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
　　    procedure WMSize(var Message: TWMSize); message WM_SIZE;
　　    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
　　    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
　　    procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
　　    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SetFOCUS;
　　    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
　　  protected
　　    FUpdateFields: Boolean;
　　    FAcquireFocus: Boolean;
　　    FUpdatingEditor: Boolean;
　　    function  RawToDataColumn(ACol: Integer): Integer;
　　    function  DataToRawColumn(ACol: Integer): Integer;
　　    function  AcquireLayoutLock: Boolean;
　　    procedure BeginLayout;
　　    procedure BeginUpdate;
　　    procedure CancelLayout;
　　    function  CanEditAcceptKey(Key: Char): Boolean; override;
　　    function  CanEditModify: Boolean; override;
　　    function  CanEditShow: Boolean; override;
　　    procedure CellClick(Column: TColumn); dynamic;
　　    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
　　    procedure RowMoved(FromIndex, ToIndex: Longint); override;
　　    procedure ColEnter; dynamic;
　　    procedure ColExit; dynamic;
　　    procedure ColWidthsChanged; override;
　　    function  CreateColumns: TDBGridColumns; dynamic;
　　    function  CreateEditor: TInplaceEdit; override;
　　    procedure CreateWnd; override;
　　    procedure DeferLayout;
　　    procedure DefaultHandler(var Msg); override;
　　    procedure DefineFieldMap; virtual;
　　    procedure DefineProperties(Filer: TFiler); override;
　　    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
　　    procedure DrawDataCell(const Rect: TRect; Field: TField;
　　      State: TGridDrawState); dynamic; { obsolete }
　　    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
　　      Column: TColumn; State: TGridDrawState); dynamic;
　　    procedure EditButtonClick; dynamic;
　　    procedure EndLayout;
　　    procedure EndUpdate;
　　    function  GetColField(DataCol: Integer): TField;
　　    function  GetEditLimit: Integer; override;
　　    function  GetEditMask(ACol, ARow: Longint): string; override;
　　    function  GetEditText(ACol, ARow: Longint): string; override;
　　    function  GetFieldValue(ACol: Integer): string;
　　    function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
　　      AState: TGridDrawState): Boolean; virtual;
　　    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
　　    procedure KeyPress(var Key: Char); override;
　　    procedure LayoutChanged; virtual;
　　    procedure LinkActive(Value: Boolean); virtual;
　　    procedure Loaded; override;
　　    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
　　      X, Y: Integer); override;
　　    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
　　      X, Y: Integer); override;
　　    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
　　    procedure Scroll(Distance: Integer); virtual;
　　    procedure SetColumnAttributes; virtual;
　　    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
　　    function  StoreColumns: Boolean;
　　    procedure TimedScroll(Direction: TGridScrollDirection); override;
　　    procedure TitleClick(Column: TColumn); dynamic;
　　    property Columns: TDBGridColumns read FColumns write SetColumns;
　　    property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
　　    property DataSource: TDataSource read GetDataSource write SetDataSource;
　　    property DataLink: TGridDataLink read FDataLink;
　　    property IndicatorOffset: Byte read FIndicatorOffset;
　　    property LayoutLock: Byte read FLayoutLock;
　　    property Options: TDBGridOptions read FOptions write SetOptions
　　      default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
　　      dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
　　    property ParentColor default False;
　　    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
　　    property SelectedRows: TBookmarkList read FBookmarks;
　　    property TitleFont: TFont read FTitleFont write SetTitleFont;
　　    property UpdateLock: Byte read FUpdateLock;
　　    property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
　　    property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
　　    property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell
　　      write FOnDrawDataCell; { obsolete }
　　    property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell
　　      write FOnDrawColumnCell;
　　    property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
　　      write FOnEditButtonClick;
　　    property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
　　    property OnCellClick: TDBGridClickEvent read FOnCellClick write FOnCellClick;
　　    property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
　　  public
　　    constructor Create(AOwner: TComponent); override;
　　    destructor Destroy; override;
　　    procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
　　      State: TGridDrawState); { obsolete }
　　    procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
　　      Column: TColumn; State: TGridDrawState);
　　    function ValidFieldIndex(FieldIndex: Integer): Boolean;
　　    property EditorMode;
　　    property FieldCount: Integer read GetFieldCount;
　　    property Fields[FieldIndex: Integer]: TField read GetFields;
　　    property SelectedField: TField read GetSelectedField write SetSelectedField;
　　    property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
　　    property Vertical: Boolean read FVertical write SetVertical default False;
　　    property OnlyOne: Boolean read FOnlyOne write SetOnlyOne default False;
　　    property TitlesWidth: integer read FTitlesWidth write SetTitlesWidth;
　　  end;

　　  TVDBGrid = class(TCustomVDBGrid)
　　  public
　　    property Canvas;
　　    property SelectedRows;
　　  published
　　    property Align;
　　    property BorderStyle;
　　    property Color;
　　    property Columns stored False; //StoreColumns;
　　    property Ctl3D;
　　    property DataSource;
　　    property DefaultDrawing;
　　    property DragCursor;
　　    property DragMode;
　　    property Enabled;
　　    property FixedColor;
　　    property Font;
　　    property ImeMode;
　　    property ImeName;
　　    property Options;
　　    property ParentColor;
　　    property ParentCtl3D;
　　    property ParentFont;
　　    property ParentShowHint;
　　    property PopupMenu;
　　    property ReadOnly;
　　    property ShowHint;
　　    property TabOrder;
　　    property TabStop;
　　    property TitleFont;
　　    property Visible;
　　    property Vertical;
　　    property OnlyOne;
　　    property DefaultColWidth;
　　    property TitlesWidth;
　　    property OnCellClick;
　　    property OnColEnter;
　　    property OnColExit;
　　    property OnColumnMoved;
　　    property OnDrawDataCell;  { obsolete }
　　    property OnDrawColumnCell;
　　    property OnDblClick;
　　    property OnDragDrop;
　　    property OnDragOver;
　　    property OnEditButtonClick;
　　    property OnEndDrag;
　　    property OnEnter;
　　    property OnExit;
　　    property OnKeyDown;
　　    property OnKeyPress;
　　    property OnKeyUp;
　　    property OnStartDrag;
　　    property OnTitleClick;
　　  end;

　　const
　　  IndicatorWidth = 11;

　　procedure Register;

　　implementation

　　uses DBConsts, Dialogs;

　　{$R dbvgrids.res}

　　procedure Register;
　　begin
　　  RegisterComponents('Data Controls',  [ TVDBGrid ]);
　　//  RegisterPropertyEditor(TypeInfo(TDBGridColumns), TCustomVDBGrid,
　　//                        'Columns', TDBGridColumnsEditor);
　　end;

　　const
　　  bmArrow = 'DBVGARROW';
　　  bmEdit = 'DBVEDIT';
　　  bmInsert = 'DBVINSERT';
　　  bmMultiDot = 'DBVMULTIDOT';
　　  bmMultiArrow = 'DBVMULTIARROW';

　　  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }

　　{ Error reporting }

　　procedure RaiseGridError(const S: string);
　　begin
　　  raise EInvalidGridOperation.Create(S);
　　end;

　　procedure KillMessage(Wnd: HWnd; Msg: Integer);
　　// Delete the requested message from the queue, but throw back
　　// any WM_QUIT msgs that PeekMessage may also return
　　var
　　  M: TMsg;
　　begin
　　  M.Message := 0;
　　  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
　　    PostQuitMessage(M.wparam);
　　end;

　　{ TVDBGridInplaceEdit }

　　{ TVDBGridInplaceEdit adds support for a button on the in-place editor,
　　  which can be used to drop down a table-based lookup list, a stringlist-based
　　  pick list, or (if button style is esEllipsis) fire the grid event
　　  OnEditButtonClick.  }

　　type
　　  TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
　　  TPopupListbox = class;

　　  TVDBGridInplaceEdit = class(TInplaceEdit)
　　  private
　　    FButtonWidth: Integer;
　　    FDataList: TDBLookupListBox;
　　    FPickList: TPopupListbox;
　　    FActiveList: TWinControl;
　　    FLookupSource: TDatasource;
　　    FEditStyle: TEditStyle;
　　    FListVisible: Boolean;
　　    FTracking: Boolean;
　　    FPressed: Boolean;
　　    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
　　      Shift: TShiftState; X, Y: Integer);
　　    procedure SetEditStyle(Value: TEditStyle);
　　    procedure StopTracking;
　　    procedure TrackButton(X,Y: Integer);
　　    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
　　    procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
　　    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
　　    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
　　    procedure WMPaint(var Message: TWMPaint); message wm_Paint;
　　    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
　　  protected
　　    procedure BoundsChanged; override;
　　    procedure CloseUp(Accept: Boolean);
　　    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
　　    procedure DropDown;
　　    procedure KeyDown(var Key: Word; Shift: TShiftState); 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;
　　    procedure PaintWindow(DC: HDC); override;
　　    procedure UpdateContents; override;
　　    procedure WndProc(var Message: TMessage); override;
　　    property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
　　    property  ActiveList: TWinControl read FActiveList write FActiveList;
　　    property  DataList: TDBLookupListBox read FDataList;
　　    property  PickList: TPopupListbox read FPickList;
　　  public
　　    constructor Create(Owner: TComponent); override;
　　  end;

　　{ TPopupListbox }

　　  TPopupListbox = class(TCustomListbox)
　　  private
　　    FSearchText: String;
　　    FSearchTickCount: Longint;
　　  protected
　　    procedure CreateParams(var Params: TCreateParams); override;
　　    procedure CreateWnd; override;
　　    procedure KeyPress(var Key: Char); override;
　　    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
　　  end;

　　procedure TPopupListBox.CreateParams(var Params: TCreateParams);
　　begin
　　  inherited CreateParams(Params);
　　  with Params do
　　  begin
　　    Style := Style or WS_BORDER;
　　    ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
　　    WindowClass.Style := CS_SAVEBITS;
　　  end;
　　end;

　　procedure TPopupListbox.CreateWnd;
　　begin
　　  inherited CreateWnd;
　　  Windows.SetParent(Handle, 0);
　　  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
　　end;

　　procedure TPopupListbox.Keypress(var Key: Char);
　　var
　　  TickCount: Integer;
　　begin
　　  case Key of
　　    #8, #27: FSearchText := '';
　　    #32..#255:
　　      begin
　　        TickCount := GetTickCount;
　　        if TickCount - FSearchTickCount 2000 then FSearchText := '';
　　        FSearchTickCount := TickCount;
　　        if Length(FSearchText) 32 then FSearchText := FSearchText + Key;
　　        SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
　　        Key := #0;
　　      end;
　　  end;
　　  inherited Keypress(Key);
　　end;

　　procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
　　  X, Y: Integer);
　　begin
　　  inherited MouseUp(Button, Shift, X, Y);
　　  TVDBGridInPlaceEdit(Owner).CloseUp((X = 0) and (Y = 0) and
　　      (X Width) and (Y Height));
　　end;

　　
　　constructor TVDBGridInplaceEdit.Create(Owner: TComponent);
　　begin
　　  inherited Create(Owner);
　　  FLookupSource := TDataSource.Create(Self);
　　  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
　　  FEditStyle := esSimple;
　　end;

　　procedure TVDBGridInplaceEdit.BoundsChanged;
　　var
　　  R: TRect;
　　begin
　　  SetRect(R, 2, 2, Width - 2, Height);
　　  if FEditStyle esSimple then Dec(R.Right, FButtonWidth);
　　  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
　　  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
　　  if SysLocale.Fareast then
　　    SetImeCompositionWindow(Font, R.Left, R.Top);
　　end;

　　procedure TVDBGridInplaceEdit.CloseUp(Accept: Boolean);
　　var
　　  MasterField: TField;
　　  ListValue: Variant;
　　begin
　　  if FListVisible then
　　  begin
　　    if GetCapture 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
　　    if FActiveList = FDataList then
　　      ListValue := FDataList.KeyValue
　　    else
　　      if FPickList.ItemIndex -1 then
　　        ListValue := FPickList.Items[FPicklist.ItemIndex];
　　    SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
　　      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
　　    FListVisible := False;
　　    if Assigned(FDataList) then
　　      FDataList.ListSource := nil;
　　    FLookupSource.Dataset := nil;
　　    Invalidate;
　　    if Accept then
　　      if FActiveList = FDataList then
　　        with TCustomVDBGrid(Grid), Columns[SelectedIndex].Field do
　　        begin
　　          MasterField := DataSet.FieldByName(KeyFields);
　　          if MasterField.CanModify then
　　          begin
　　            DataSet.Edit;
　　            MasterField.Value := ListValue;
　　          end;
　　        end
　　      else
　　        if (not VarIsNull(ListValue)) and EditCanModify then
　　          with TCustomVDBGrid(Grid), Columns[SelectedIndex].Field do
　　            Text := ListValue;
　　  end;
　　end;

　　procedure TVDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
　　begin
　　  case Key of
　　    VK_UP, VK_DOWN:
　　      if ssAlt in Shift then
　　      begin
　　        if FListVisible then CloseUp(True) else DropDown;
　　        Key := 0;
　　      end;
　　    VK_RETURN, VK_ESCAPE:
　　      if FListVisible and not (ssAlt in Shift) then
　　      begin
　　        CloseUp(Key = VK_RETURN);
　　        Key := 0;
　　      end;
　　  end;
　　end;

　　procedure TVDBGridInplaceEdit.DropDown;
　　var
　　  P: TPoint;
　　  I,J,Y: Integer;
　　  Column: TColumn;
　　begin
　　  if not FListVisible and Assigned(FActiveList) then
　　  begin
　　    FActiveList.Width := Width;
　　    with TCustomVDBGrid(Grid) do
　　      Column := Columns[SelectedIndex];
　　    if FActiveList = FDataList then
　　    with Column.Field do
　　    begin
　　      FDataList.Color := Color;
　　      FDataList.Font := Font;
　　      FDataList.RowCount := Column.DropDownRows;
　　      FLookupSource.DataSet := LookupDataSet;
　　      FDataList.KeyField := LookupKeyFields;
　　      FDataList.ListField := LookupResultField;
　　      FDataList.ListSource := FLookupSource;
　　      FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
　　{      J := Column.DefaultWidth;
　　      if J FDataList.ClientWidth then
　　        FDataList.ClientWidth := J;
　　}    end
　　    else
　　    begin
　　      FPickList.Color := Color;
　　      FPickList.Font := Font;
　　      FPickList.Items := Column.Picklist;
　　      if FPickList.Items.Count = Column.DropDownRows then
　　        FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
　　      else
　　        FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
　　      if Column.Field.IsNull then
　　        FPickList.ItemIndex := -1
　　      else
　　        FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
　　      J := FPickList.ClientWidth;
　　      for I := 0 to FPickList.Items.Count - 1 do
　　      begin
　　        Y := FPickList.Canvas.TextWidth(FPickList.Items[I]);
　　        if Y J then J := Y;
　　      end;
　　      FPickList.ClientWidth := J;
　　    end;
　　    P := Parent.ClientToScreen(Point(Left, Top));
　　    Y := P.Y + Height;
　　    if Y + FActiveList.Height Screen.Height then Y := P.Y - FActiveList.Height;
　　    SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
　　      SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
　　    FListVisible := True;
　　    Invalidate;
　　    Windows.SetFocus(Handle);
　　  end;
　　end;

　　type
　　  TWinControlCracker = class(TWinControl) end;

　　procedure TVDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
　　begin
　　  if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
　　  begin
　　    TCustomVDBGrid(Grid).EditButtonClick;
　　    KillMessage(Handle, WM_CHAR);
　　  end
　　  else
　　    inherited KeyDown(Key, Shift);
　　end;

　　procedure TVDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
　　  Shift: TShiftState; X, Y: Integer);
　　begin
　　  if Button = mbLeft then
　　    CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
　　end;

　　procedure TVDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
　　  X, Y: Integer);
　　begin
　　  if (Button = mbLeft) and (FEditStyle esSimple) and
　　    PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
　　  begin
　　    if FListVisible then
　　      CloseUp(False)
　　    else
　　    begin
　　      MouseCapture := True;
　　      FTracking := True;
　　      TrackButton(X, Y);
　　      if Assigned(FActiveList) then
　　        DropDown;
　　    end;
　　  end;
　　  inherited MouseDown(Button, Shift, X, Y);
　　end;

　　procedure TVDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
　　var
　　  ListPos: TPoint;
　　  MousePos: TSmallPoint;
　　begin
　　  if FTracking then
　　  begin
　　    TrackButton(X, Y);
　　    if FListVisible then
　　    begin
　　      ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
　　      if PtInRect(FActiveList.ClientRect, ListPos) then
　　      begin
　　        StopTracking;
　　        MousePos := PointToSmallPoint(ListPos);
　　        SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
　　        Exit;
　　      end;
　　    end;
　　  end;
　　  inherited MouseMove(Shift, X, Y);
　　end;

　　procedure TVDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
　　  X, Y: Integer);
　　var
　　  WasPressed: Boolean;
　　begin
　　  WasPressed := FPressed;
　　  StopTracking;
　　  if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
　　    TCustomVDBGrid(Grid).EditButtonClick;
　　  inherited MouseUp(Button, Shift, X, Y);
　　end;

　　procedure TVDBGridInplaceEdit.PaintWindow(DC: HDC);
　　var
　　  R: TRect;
　　  Flags: Integer;
　　  W: Integer;
　　begin
　　  if FEditStyle esSimple then
　　  begin
　　    SetRect(R, Width - FButtonWidth, 0, Width, Height);
　　    Flags := 0;
　　    if FEditStyle in [esDataList, esPickList] then
　　    begin
　　      if FActiveList = nil then
　　        Flags := DFCS_INACTIVE
　　      else if FPressed then
　　        Flags := DFCS_FLAT or DFCS_PUSHED;
　　      DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
　　    end
　　    else   { esEllipsis }
　　    begin
　　      if FPressed then
　　        Flags := BF_FLAT;
　　      DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
　　      Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
　　      W := Height shr 3;
　　      if W = 0 then W := 1;
　　      PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
　　      PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
　　      PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
　　    end;
　　    ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
　　  end;
　　  inherited PaintWindow(DC);
　　end;

　　procedure TVDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
　　begin
　　  if Value = FEditStyle then Exit;
　　  FEditStyle := Value;
　　  case Value of
　　    esPickList:
　　      begin
　　        if FPickList = nil then
　　        begin
　　          FPickList := TPopupListbox.Create(Self);
　　          FPickList.Visible := False;
　　          FPickList.Parent := Self;
　　          FPickList.OnMouseUp := ListMouseUp;
　　          FPickList.IntegralHeight := True;
　　          FPickList.ItemHeight := 11;
　　        end;
　　        FActiveList := FPickList;
　　      end;
　　    esDataList:
　　      begin
　　        if FDataList = nil then
　　        begin
　　          FDataList := TPopupDataList.Create(Self);
　　          FDataList.Visible := False;
　　          FDataList.Parent := Self;
　　          FDataList.OnMouseUp := ListMouseUp;
　　        end;
　　        FActiveList := FDataList;
　　      end;
　　  else  { cbsNone, cbsEllipsis, or read only field }
　　    FActiveList := nil;
　　  end;
　　  with TCustomVDBGrid(Grid) do
　　    Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
　　  Repaint;
　　end;

　　procedure TVDBGridInplaceEdit.StopTracking;
　　begin
　　  if FTracking then
　　  begin
　　    TrackButton(-1, -1);
　　    FTracking := False;
　　    MouseCapture := False;
　　  end;
　　end;

　　procedure TVDBGridInplaceEdit.TrackButton(X,Y: Integer);
　　var
　　  NewState: Boolean;
　　  R: TRect;
　　begin
　　  SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
　　  NewState := PtInRect(R, Point(X, Y));
　　  if FPressed NewState then
　　  begin
　　    FPressed := NewState;
　　    InvalidateRect(Handle, @R, False);
　　  end;
　　end;

　　procedure TVDBGridInplaceEdit.UpdateContents;
　　var
　　  Column: TColumn;
　　  NewStyle: TEditStyle;
　　  MasterField: TField;
　　begin
　　  with TCustomVDBGrid(Grid) do
　　    Column := Columns[SelectedIndex];
　　  NewStyle := esSimple;
　　  case Column.ButtonStyle of
　　   cbsEllipsis: NewStyle := esEllipsis;
　　   cbsAuto:
　　     if Assigned(Column.Field) then
　　     with Column.Field do
　　     begin
　　       { Show the dropdown button only if the field is editable }
　　       if FieldKind = fkLookup then
　　       begin
　　         MasterField := Dataset.FieldByName(KeyFields);
　　         { Column.DefaultReadonly will always be True for a lookup field.
　　           Test if Column.ReadOnly has been assigned a value of True }
　　         if Assigned(MasterField) and MasterField.CanModify and
　　           not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
　　           with TCustomVDBGrid(Grid) do
　　             if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
　　               NewStyle := esDataList
　　       end
　　       else
　　       if Assigned(Column.Picklist) and (Column.PickList.Count 0) and
　　         not Column.Readonly then
　　         NewStyle := esPickList;
　　     end;
　　  end;
　　  EditStyle := NewStyle;
　　  inherited UpdateContents;
　　end;

　　procedure TVDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
　　begin
　　  if (Message.Sender Self) and (Message.Sender FActiveList) then
　　    CloseUp(False);
　　end;

　　procedure TVDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
　　begin
　　  StopTracking;
　　  inherited;
　　end;

　　procedure TVDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
　　begin
　　  if SysLocale.FarEast then
　　  begin
　　    ImeName := Screen.DefaultIme;
　　    ImeMode := imDontCare;
　　  end;
　　  inherited;
　　  CloseUp(False);
　　end;

　　procedure TVDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
　　begin
　　  with Message do
　　  if (FEditStyle esSimple) and
　　    PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
　　    Exit;
　　  inherited;
　　end;

　　procedure TVDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
　　begin
　　  PaintHandler(Message);
　　end;

　　procedure TVDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
　　var
　　  P: TPoint;
　　begin
　　  GetCursorPos(P);
　　  if (FEditStyle esSimple) and
　　    PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
　　    Windows.SetCursor(LoadCursor(0, idc_Arrow))
　　  else
　　    inherited;
　　end;

　　procedure TVDBGridInplaceEdit.WndProc(var Message: TMessage);
　　begin
　　  case Message.Msg of
　　    wm_KeyDown, wm_SysKeyDown, wm_Char:
　　      if EditStyle in [esPickList, esDataList] then
　　      with TWMKey(Message) do
　　      begin
　　        DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
　　        if (CharCode 0) and FListVisible then
　　        begin
　　          with TMessage(Message) do
　　            SendMessage(FActiveList.Handle, Msg, WParam, LParam);
　　          Exit;
　　        end;
　　      end
　　  end;
　　  inherited;
　　end;

　　
　　{ TGridDataLink }

　　type
　　  TIntArray = array[0..MaxMapSize] of Integer;
　　  PIntArray = ^TIntArray;

　　constructor TGridDataLink.Create(AGrid: TCustomVDBGrid);
　　begin
　　  inherited Create;
　　  FGrid := AGrid;
　　end;

　　destructor TGridDataLink.Destroy;
　　begin
　　  ClearMapping;
　　  inherited Destroy;
　　end;

　　function TGridDataLink.GetDefaultFields: Boolean;
　　var
　　  I: Integer;
　　begin
　　  Result := True;
　　  if DataSet nil then Result := DataSet.DefaultFields;
　　  if Result and SparseMap then
　　  for I := 0 to FFieldCount-1 do
　　    if PIntArray(FFieldMap)^[I] 0 then
　　    begin
　　      Result := False;
　　      Exit;
　　    end;
　　end;

　　function TGridDataLink.GetFields(I: Integer): TField;
　　begin
　　  if (0 = I) and (I FFieldCount) and (PIntArray(FFieldMap)^[I] = 0) then
　　    Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
　　  else
　　    Result := nil;
　　end;

　　function TGridDataLink.AddMapping(const FieldName: string): Boolean;
　　var
　　  Field: TField;
　　  NewSize: Integer;
　　begin
　　  Result := True;
　　  if FFieldCount = MaxMapSize then RaiseGridError(STooManyColumns);
　　  if SparseMap then
　　    Field := DataSet.FindField(FieldName)
　　  else
　　    Field := DataSet.FieldByName(FieldName);

　　  if FFieldCount = FFie