home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Install / DATA.Z / DBGRIDS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-09  |  97.5 KB  |  3,559 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,96 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBGrids;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, SysUtils, Messages, Classes, Controls, Forms,
  17.   Graphics, DB, DBTables, Grids, DBCtrls;
  18.  
  19. type
  20.   TColumnValue = (cvColor, cvWidth, cvFont, cvAlignment, cvReadOnly, cvTitleColor,
  21.     cvTitleCaption, cvTitleAlignment, cvTitleFont);
  22.   TColumnValues = set of TColumnValue;
  23.  
  24. const
  25.   ColumnTitleValues = [cvTitleColor..cvTitleFont];
  26.   cm_DeferLayout = WM_USER + 100;
  27.  
  28. { TColumn defines internal storage for column attributes.  Values assigned
  29.   to properties are stored in this object, the grid- or field-based default
  30.   sources are not modified.  Values read from properties are the previously
  31.   assigned value, if any, or the grid- or field-based default values if
  32.   nothing has been assigned to that property. This class also publishes the
  33.   column attribute properties for persistent storage.  }
  34. type
  35.   TColumn = class;
  36.   TCustomDBGrid = class;
  37.  
  38.   TColumnTitle = class(TPersistent)
  39.   private
  40.     FColumn: TColumn;
  41.     FCaption: string;
  42.     FFont: TFont;
  43.     FColor: TColor;
  44.     FAlignment: TAlignment;
  45.     procedure FontChanged(Sender: TObject);
  46.     function GetAlignment: TAlignment;
  47.     function GetColor: TColor;
  48.     function GetCaption: string;
  49.     function GetFont: TFont;
  50.     function IsAlignmentStored: Boolean;
  51.     function IsColorStored: Boolean;
  52.     function IsFontStored: Boolean;
  53.     function IsCaptionStored: Boolean;
  54.     procedure SetAlignment(Value: TAlignment);
  55.     procedure SetColor(Value: TColor);
  56.     procedure SetFont(Value: TFont);
  57.     procedure SetCaption(const Value: string); virtual;
  58.   protected
  59.     procedure RefreshDefaultFont;
  60.   public
  61.     constructor Create(Column: TColumn);
  62.     destructor Destroy; override;
  63.     procedure Assign(Source: TPersistent); override;
  64.     function DefaultAlignment: TAlignment;
  65.     function DefaultColor: TColor;
  66.     function DefaultFont: TFont;
  67.     function DefaultCaption: string;
  68.     procedure RestoreDefaults; virtual;
  69.   published
  70.     property Alignment: TAlignment read GetAlignment write SetAlignment
  71.       stored IsAlignmentStored;
  72.     property Caption: string read GetCaption write SetCaption stored IsCaptionStored;
  73.     property Color: TColor read GetColor write SetColor stored IsColorStored;
  74.     property Font: TFont read GetFont write SetFont stored IsFontStored;
  75.   end;
  76.  
  77.   TColumnButtonStyle = (cbsAuto, cbsEllipsis, cbsNone);
  78.  
  79.   TColumn = class(TCollectionItem)
  80.   private
  81.     FField: TField;
  82.     FFieldName: string;
  83.     FColor: TColor;
  84.     FWidth: Integer;
  85.     FTitle: TColumnTitle;
  86.     FFont: TFont;
  87.     FPickList: TStrings;
  88.     FDropDownRows: Integer;
  89.     FButtonStyle: TColumnButtonStyle;
  90.     FAlignment: TAlignment;
  91.     FReadonly: Boolean;
  92.     FAssignedValues: TColumnValues;
  93.     procedure FontChanged(Sender: TObject);
  94.     function  GetAlignment: TAlignment;
  95.     function  GetColor: TColor;
  96.     function  GetField: TField;
  97.     function  GetFont: TFont;
  98.     function  GetPickList: TStrings;
  99.     function  GetReadOnly: Boolean;
  100.     function  GetWidth: Integer;
  101.     function  IsAlignmentStored: Boolean;
  102.     function  IsColorStored: Boolean;
  103.     function  IsFontStored: Boolean;
  104.     function  IsReadOnlyStored: Boolean;
  105.     function  IsWidthStored: Boolean;
  106.     procedure SetAlignment(Value: TAlignment); virtual;
  107.     procedure SetButtonStyle(Value: TColumnButtonStyle);
  108.     procedure SetColor(Value: TColor);
  109.     procedure SetField(Value: TField); virtual;
  110.     procedure SetFieldName(const Value: String);
  111.     procedure SetFont(Value: TFont);
  112.     procedure SetPickList(Value: TStrings);
  113.     procedure SetReadOnly(Value: Boolean); virtual;
  114.     procedure SetTitle(Value: TColumnTitle);
  115.     procedure SetWidth(Value: Integer); virtual;
  116.   protected
  117.     function  CreateTitle: TColumnTitle; virtual;
  118.     function  GetGrid: TCustomDBGrid;
  119.     procedure RefreshDefaultFont;
  120.   public
  121.     constructor Create(Collection: TCollection); override;
  122.     destructor Destroy; override;
  123.     procedure Assign(Source: TPersistent); override;
  124.     function  DefaultAlignment: TAlignment;
  125.     function  DefaultColor: TColor;
  126.     function  DefaultFont: TFont;
  127.     function  DefaultReadOnly: Boolean;
  128.     function  DefaultWidth: Integer;
  129.     procedure RestoreDefaults; virtual;
  130.     property  AssignedValues: TColumnValues read FAssignedValues;
  131.     property  Field: TField read GetField write SetField;
  132.   published
  133.     property  Alignment: TAlignment read GetAlignment write SetAlignment
  134.       stored IsAlignmentStored;
  135.     property  ButtonStyle: TColumnButtonStyle read FButtonStyle write SetButtonStyle
  136.       default cbsAuto;
  137.     property  Color: TColor read GetColor write SetColor stored IsColorStored;
  138.     property  DropDownRows: Integer read FDropDownRows write FDropDownRows default 7;
  139.     property  FieldName: String read FFieldName write SetFieldName;
  140.     property  Font: TFont read GetFont write SetFont stored IsFontStored;
  141.     property  PickList: TStrings read GetPickList write SetPickList;
  142.     property  ReadOnly: Boolean read GetReadOnly write SetReadOnly
  143.       stored IsReadOnlyStored;
  144.     property  Title: TColumnTitle read FTitle write SetTitle;
  145.     property  Width: Integer read GetWidth write SetWidth stored IsWidthStored;
  146.   end;
  147.  
  148.   TColumnClass = class of TColumn;
  149.  
  150.   TDBGridColumnsState = (csDefault, csCustomized);
  151.  
  152.   TDBGridColumns = class(TCollection)
  153.   private
  154.     FGrid: TCustomDBGrid;
  155.     function GetColumn(Index: Integer): TColumn;
  156.     function GetState: TDBGridColumnsState;
  157.     procedure SetColumn(Index: Integer; Value: TColumn);
  158.     procedure SetState(NewState: TDBGridColumnsState);
  159.   protected
  160.     procedure Update(Item: TCollectionItem); override;
  161.   public
  162.     constructor Create(Grid: TCustomDBGrid; ColumnClass: TColumnClass);
  163.     function  Add: TColumn;
  164.     procedure RestoreDefaults;
  165.     procedure RebuildColumns;
  166.     property State: TDBGridColumnsState read GetState write SetState;
  167.     property Grid: TCustomDBGrid read FGrid;
  168.     property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
  169.   end;
  170.  
  171.   TGridDataLink = class(TDataLink)
  172.   private
  173.     FGrid: TCustomDBGrid;
  174.     FFieldCount: Integer;
  175.     FFieldMapSize: Integer;
  176.     FFieldMap: Pointer;
  177.     FModified: Boolean;
  178.     FInUpdateData: Boolean;
  179.     FSparseMap: Boolean;
  180.     function GetDefaultFields: Boolean;
  181.     function GetFields(I: Integer): TField;
  182.   protected
  183.     procedure ActiveChanged; override;
  184.     procedure DataSetChanged; override;
  185.     procedure DataSetScrolled(Distance: Integer); override;
  186.     procedure FocusControl(Field: TFieldRef); override;
  187.     procedure EditingChanged; override;
  188.     procedure LayoutChanged; override;
  189.     procedure RecordChanged(Field: TField); override;
  190.     procedure UpdateData; override;
  191.     function  GetMappedIndex(ColIndex: Integer): Integer;
  192.   public
  193.     constructor Create(AGrid: TCustomDBGrid);
  194.     destructor Destroy; override;
  195.     function AddMapping(const FieldName: string): Boolean;
  196.     procedure ClearMapping;
  197.     procedure Modified;
  198.     procedure Reset;
  199.     property DefaultFields: Boolean read GetDefaultFields;
  200.     property FieldCount: Integer read FFieldCount;
  201.     property Fields[I: Integer]: TField read GetFields;
  202.     property SparseMap: Boolean read FSparseMap write FSparseMap;
  203.   end;
  204.  
  205.   TBookmarkList = class
  206.   private
  207.     FList: TStringList;
  208.     FGrid: TCustomDBGrid;
  209.     FCache: TBookmarkStr;
  210.     FCacheIndex: Integer;
  211.     FCacheFind: Boolean;
  212.     FLinkActive: Boolean;
  213.     function GetCount: Integer;
  214.     function GetCurrentRowSelected: Boolean;
  215.     function GetItem(Index: Integer): TBookmarkStr;
  216.     function Insert(const Item: TBookmarkStr): Integer;
  217.     procedure SetCurrentRowSelected(Value: Boolean);
  218.     procedure StringsChanged(Sender: TObject);
  219.   protected
  220.     function CurrentRow: TBookmarkStr;  // shortcut to grid.datasource...
  221.     function Compare(const Item1, Item2: TBookmarkStr): Integer;
  222.     procedure LinkActive(Value: Boolean);
  223.   public
  224.     constructor Create(AGrid: TCustomDBGrid);
  225.     destructor Destroy; override;
  226.     procedure Clear;           // free all bookmarks
  227.     procedure Delete;          // delete all selected rows from dataset
  228.     function  Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
  229.     function  IndexOf(const Item: TBookmarkStr): Integer;
  230.     function  Refresh: Boolean;// drop orphaned bookmarks; True = orphans found
  231.     property Count: Integer read GetCount;
  232.     property CurrentRowSelected: Boolean read GetCurrentRowSelected
  233.       write SetCurrentRowSelected;
  234.     property Items[Index: Integer]: TBookmarkStr read GetItem; default;
  235.   end;
  236.  
  237.   TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
  238.     dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
  239.     dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect);
  240.   TDBGridOptions = set of TDBGridOption;
  241.  
  242.   { The DBGrid's DrawDataCell virtual method and OnDrawDataCell event are only
  243.     called when the grid's Columns.State is csDefault.  This is for compatibility
  244.     with existing code. These routines don't provide sufficient information to
  245.     determine which column is being drawn, so the column attributes aren't
  246.     easily accessible in these routines.  Column attributes also introduce the
  247.     possibility that a column's field may be nil, which would break existing
  248.     DrawDataCell code.   DrawDataCell, OnDrawDataCell, and DefaultDrawDataCell
  249.     are obsolete, retained for compatibility purposes. }
  250.   TDrawDataCellEvent = procedure (Sender: TObject; const Rect: TRect; Field: TField;
  251.     State: TGridDrawState) of object;
  252.  
  253.   { The DBGrid's DrawColumnCell virtual method and OnDrawColumnCell event are
  254.     always called, when the grid has defined column attributes as well as when
  255.     it is in default mode.  These new routines provide the additional
  256.     information needed to access the column attributes for the cell being
  257.     drawn, and must support nil fields.  }
  258.  
  259.   TDrawColumnCellEvent = procedure (Sender: TObject; const Rect: TRect;
  260.     DataCol: Integer; Column: TColumn; State: TGridDrawState) of object;
  261.  
  262.   TCustomDBGrid = class(TCustomGrid)
  263.   private
  264.     FIndicators: TImageList;
  265.     FTitleFont: TFont;
  266.     FReadOnly: Boolean;
  267.     FConnected: Boolean;
  268.     FUserChange: Boolean;
  269.     FDataChanged: Boolean;
  270.     FEditRequest: Boolean;
  271.     FLayoutFromDataset: Boolean;
  272.     FOptions: TDBGridOptions;
  273.     FTitleOffset, FIndicatorOffset: Byte;
  274.     FUpdateLock: Byte;
  275.     FLayoutLock: Byte;
  276.     FInColExit: Boolean;
  277.     FDefaultDrawing: Boolean;
  278.     FSelfChangingTitleFont: Boolean;
  279.     FSelecting: Boolean;
  280.     FSelRow: Integer;
  281.     FDataLink: TGridDataLink;
  282.     FOnColEnter: TNotifyEvent;
  283.     FOnColExit: TNotifyEvent;
  284.     FOnDrawDataCell: TDrawDataCellEvent;
  285.     FOnDrawColumnCell: TDrawColumnCellEvent;
  286.     FEditText: string;
  287.     FColumns: TDBGridColumns;
  288.     FOnEditButtonClick: TNotifyEvent;
  289.     FOnColumnMoved: TMovedEvent;
  290.     FBookmarks: TBookmarkList;
  291.     FSelectionAnchor: TBookmarkStr;
  292.     function AcquireFocus: Boolean;
  293.     procedure DataChanged;
  294.     procedure EditingChanged;
  295.     function Edit: Boolean;
  296.     function GetDataSource: TDataSource;
  297.     function GetFieldCount: Integer;
  298.     function GetFields(FieldIndex: Integer): TField;
  299.     function GetSelectedField: TField;
  300.     function GetSelectedIndex: Integer;
  301.     procedure InternalLayout;
  302.     procedure MoveCol(RawCol: Integer);
  303.     procedure RecordChanged(Field: TField);
  304.     procedure SetColumns(Value: TDBGridColumns);
  305.     procedure SetDataSource(Value: TDataSource);
  306.     procedure SetOptions(Value: TDBGridOptions);
  307.     procedure SetSelectedField(Value: TField);
  308.     procedure SetSelectedIndex(Value: Integer);
  309.     procedure SetTitleFont(Value: TFont);
  310.     procedure TitleFontChanged(Sender: TObject);
  311.     procedure UpdateData;
  312.     procedure UpdateActive;
  313.     procedure UpdateScrollBar;
  314.     procedure UpdateRowCount;
  315.     procedure CMExit(var Message: TMessage); message CM_EXIT;
  316.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  317.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  318.     procedure CMDeferLayout(var Message); message cm_DeferLayout;
  319.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  320.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  321.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  322.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  323.   protected
  324.     FUpdateFields: Boolean;
  325.     FAcquireFocus: Boolean;
  326.     function  RawToDataColumn(ACol: Integer): Integer;
  327.     function  DataToRawColumn(ACol: Integer): Integer;
  328.     function  AcquireLayoutLock: Boolean;
  329.     procedure BeginLayout;
  330.     procedure BeginUpdate;
  331.     procedure CancelLayout;
  332.     function  CanEditAcceptKey(Key: Char): Boolean; override;
  333.     function  CanEditModify: Boolean; override;
  334.     function  CanEditShow: Boolean; override;
  335.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  336.     procedure ColEnter; dynamic;
  337.     procedure ColExit; dynamic;
  338.     procedure ColWidthsChanged; override;
  339.     function  CreateColumns: TDBGridColumns; dynamic;
  340.     function  CreateEditor: TInplaceEdit; override;
  341.     procedure CreateWnd; override;
  342.     procedure DeferLayout;
  343.     procedure DefineFieldMap; virtual;
  344.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  345.     procedure DrawDataCell(const Rect: TRect; Field: TField;
  346.       State: TGridDrawState); dynamic; { obsolete }
  347.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  348.       Column: TColumn; State: TGridDrawState); dynamic;
  349.     procedure EditButtonClick; dynamic;
  350.     procedure EndLayout;
  351.     procedure EndUpdate;
  352.     function  GetColField(DataCol: Integer): TField;
  353.     function  GetEditLimit: Integer; override;
  354.     function  GetEditMask(ACol, ARow: Longint): string; override;
  355.     function  GetEditText(ACol, ARow: Longint): string; override;
  356.     function  GetFieldValue(ACol: Integer): string;
  357.     function  HighlightCell(DataCol, DataRow: Integer; const Value: string;
  358.       AState: TGridDrawState): Boolean; virtual;
  359.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  360.     procedure KeyPress(var Key: Char); override;
  361.     procedure LayoutChanged; virtual;
  362.     procedure LinkActive(Value: Boolean); virtual;
  363.     procedure Loaded; override;
  364.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  365.       X, Y: Integer); override;
  366.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  367.     procedure Scroll(Distance: Integer); virtual;
  368.     procedure SetColumnAttributes; virtual;
  369.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  370.     function  StoreColumns: Boolean;
  371.     procedure TimedScroll(Direction: TGridScrollDirection); override;
  372.     property Columns: TDBGridColumns read FColumns write SetColumns;
  373.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  374.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  375.     property DataLink: TGridDataLink read FDataLink;
  376.     property IndicatorOffset: Byte read FIndicatorOffset;
  377.     property LayoutLock: Byte read FLayoutLock;
  378.     property Options: TDBGridOptions read FOptions write SetOptions
  379.       default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
  380.       dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
  381.     property ParentColor default False;
  382.     property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
  383.     property SelectedRows: TBookmarkList read FBookmarks;
  384.     property TitleFont: TFont read FTitleFont write SetTitleFont;
  385.     property UpdateLock: Byte read FUpdateLock;
  386.     property OnColEnter: TNotifyEvent read FOnColEnter write FOnColEnter;
  387.     property OnColExit: TNotifyEvent read FOnColExit write FOnColExit;
  388.     property OnDrawDataCell: TDrawDataCellEvent read FOnDrawDataCell
  389.       write FOnDrawDataCell; { obsolete }
  390.     property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell
  391.       write FOnDrawColumnCell;
  392.     property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
  393.       write FOnEditButtonClick;
  394.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  395.   public
  396.     constructor Create(AOwner: TComponent); override;
  397.     destructor Destroy; override;
  398.     procedure DefaultDrawDataCell(const Rect: TRect; Field: TField;
  399.       State: TGridDrawState); { obsolete }
  400.     procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
  401.       Column: TColumn; State: TGridDrawState);
  402.     function ValidFieldIndex(FieldIndex: Integer): Boolean;
  403.     property EditorMode;
  404.     property FieldCount: Integer read GetFieldCount;
  405.     property Fields[FieldIndex: Integer]: TField read GetFields;
  406.     property SelectedField: TField read GetSelectedField write SetSelectedField;
  407.     property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
  408.   end;
  409.  
  410.   TDBGrid = class(TCustomDBGrid)
  411.   public
  412.     property Canvas;
  413.     property SelectedRows;
  414.   published
  415.     property Align;
  416.     property BorderStyle;
  417.     property Color;
  418.     property Columns stored StoreColumns;
  419.     property Ctl3D;
  420.     property DataSource;
  421.     property DefaultDrawing;
  422.     property DragCursor;
  423.     property DragMode;
  424.     property Enabled;
  425.     property FixedColor;
  426.     property Font;
  427.     property Options;
  428.     property ParentColor;
  429.     property ParentCtl3D;
  430.     property ParentFont;
  431.     property ParentShowHint;
  432.     property PopupMenu;
  433.     property ReadOnly;
  434.     property ShowHint;
  435.     property TabOrder;
  436.     property TabStop;
  437.     property TitleFont;
  438.     property Visible;
  439.     property OnColEnter;
  440.     property OnColExit;
  441.     property OnColumnMoved;
  442.     property OnDrawDataCell;  { obsolete }
  443.     property OnDrawColumnCell;
  444.     property OnDblClick;
  445.     property OnDragDrop;
  446.     property OnDragOver;
  447.     property OnEditButtonClick;
  448.     property OnEndDrag;
  449.     property OnEnter;
  450.     property OnExit;
  451.     property OnKeyDown;
  452.     property OnKeyPress;
  453.     property OnKeyUp;
  454.     property OnStartDrag;
  455.   end;
  456.  
  457. const
  458.   IndicatorWidth = 11;
  459.  
  460. implementation
  461.  
  462. uses DBConsts, Dialogs, BDE;
  463.  
  464. {$R DBGRIDS.RES}
  465.  
  466. const
  467.   bmArrow = 'DBGARROW';
  468.   bmEdit = 'DBEDIT';
  469.   bmInsert = 'DBINSERT';
  470.  
  471.   MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }
  472.  
  473. { Error reporting }
  474.  
  475. procedure RaiseGridError(const S: string);
  476. begin
  477.   raise EInvalidGridOperation.Create(S);
  478. end;
  479.  
  480. procedure GridError(S: Word);
  481. begin
  482.   RaiseGridError(LoadStr(S));
  483. end;
  484.  
  485. procedure GridErrorFmt(S: Word; const Args: array of const);
  486. begin
  487.   RaiseGridError(FmtLoadStr(S, Args));
  488. end;
  489.  
  490. { TDBGridInplaceEdit }
  491.  
  492. { TDBGridInplaceEdit adds support for a button on the in-place editor,
  493.   which can be used to drop down a table-based lookup list, a stringlist-based
  494.   pick list, or (if button style is esEllipsis) fire the grid event
  495.   OnEditButtonClick.  }
  496.  
  497. type
  498.   TEditStyle = (esSimple, esEllipsis, esPickList, esDataList);
  499.   TPopupListbox = class;
  500.  
  501.   TDBGridInplaceEdit = class(TInplaceEdit)
  502.   private
  503.     FButtonWidth: Integer;
  504.     FDataList: TDBLookupListBox;
  505.     FPickList: TPopupListbox;
  506.     FActiveList: TWinControl;
  507.     FLookupSource: TDatasource;
  508.     FEditStyle: TEditStyle;
  509.     FListVisible: Boolean;
  510.     FTracking: Boolean;
  511.     FPressed: Boolean;
  512.     procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
  513.       Shift: TShiftState; X, Y: Integer);
  514.     procedure SetEditStyle(Value: TEditStyle);
  515.     procedure StopTracking;
  516.     procedure TrackButton(X,Y: Integer);
  517.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
  518.     procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
  519.     procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
  520.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;
  521.     procedure WMPaint(var Message: TWMPaint); message wm_Paint;
  522.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SetCursor;
  523.   protected
  524.     procedure BoundsChanged; override;
  525.     procedure CloseUp(Accept: Boolean);
  526.     procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
  527.     procedure DropDown;
  528.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  529.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  530.       X, Y: Integer); override;
  531.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  532.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  533.       X, Y: Integer); override;
  534.     procedure PaintWindow(DC: HDC); override;
  535.     procedure UpdateContents; override;
  536.     procedure WndProc(var Message: TMessage); override;
  537.     property  EditStyle: TEditStyle read FEditStyle write SetEditStyle;
  538.     property  ActiveList: TWinControl read FActiveList write FActiveList;
  539.     property  DataList: TDBLookupListBox read FDataList;
  540.     property  PickList: TPopupListbox read FPickList;
  541.   public
  542.     constructor Create(Owner: TComponent); override;
  543.   end;
  544.  
  545. { TPopupListbox }
  546.  
  547.   TPopupListbox = class(TCustomListbox)
  548.   private
  549.     FSearchText: String;
  550.     FSearchTickCount: Longint;
  551.   protected
  552.     procedure CreateParams(var Params: TCreateParams); override;
  553.     procedure CreateWnd; override;
  554.     procedure KeyPress(var Key: Char); override;
  555.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  556.   end;
  557.  
  558. procedure TPopupListBox.CreateParams(var Params: TCreateParams);
  559. begin
  560.   inherited CreateParams(Params);
  561.   with Params do
  562.   begin
  563.     Style := Style or WS_BORDER;
  564.     ExStyle := WS_EX_TOOLWINDOW;
  565.     WindowClass.Style := CS_SAVEBITS;
  566.   end;
  567. end;
  568.  
  569. procedure TPopupListbox.CreateWnd;
  570. begin
  571.   inherited CreateWnd;
  572.   Windows.SetParent(Handle, 0);
  573.   CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
  574. end;
  575.  
  576. procedure TPopupListbox.Keypress(var Key: Char);
  577. var
  578.   TickCount: Integer;
  579. begin
  580.   case Key of
  581.     #8, #27: FSearchText := '';
  582.     #32..#255:
  583.       begin
  584.         TickCount := GetTickCount;
  585.         if TickCount - FSearchTickCount > 2000 then FSearchText := '';
  586.         FSearchTickCount := TickCount;
  587.         if Length(FSearchText) < 32 then FSearchText := FSearchText + Key;
  588.         SendMessage(Handle, LB_SelectString, WORD(-1), Longint(PChar(FSearchText)));
  589.         Key := #0;
  590.       end;
  591.   end;
  592.   inherited Keypress(Key);
  593. end;
  594.  
  595. procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  596.   X, Y: Integer);
  597. begin
  598.   inherited MouseUp(Button, Shift, X, Y);
  599.   TDBGridInPlaceEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and
  600.       (X < Width) and (Y < Height));
  601. end;
  602.  
  603.  
  604. constructor TDBGridInplaceEdit.Create(Owner: TComponent);
  605. begin
  606.   inherited Create(Owner);
  607.   FLookupSource := TDataSource.Create(Self);
  608.   FButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
  609.   FEditStyle := esSimple;
  610. end;
  611.  
  612. procedure TDBGridInplaceEdit.BoundsChanged;
  613. var
  614.   R: TRect;
  615. begin
  616.   SetRect(R, 2, 2, Width - 2, Height);
  617.   if FEditStyle <> esSimple then Dec(R.Right, FButtonWidth);
  618.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  619.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  620. end;
  621.  
  622. procedure TDBGridInplaceEdit.CloseUp(Accept: Boolean);
  623. var
  624.   MasterField: TField;
  625.   ListValue: Variant;
  626. begin
  627.   if FListVisible then
  628.   begin
  629.     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  630.     if FActiveList = FDataList then
  631.       ListValue := FDataList.KeyValue
  632.     else
  633.       if FPickList.ItemIndex <> -1 then
  634.         ListValue := FPickList.Items[FPicklist.ItemIndex];
  635.     SetWindowPos(FActiveList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
  636.       SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
  637.     FListVisible := False;
  638.     if Assigned(FDataList) then
  639.       FDataList.ListSource := nil;
  640.     FLookupSource.Dataset := nil;
  641.     Invalidate;
  642.     if Accept then
  643.       if FActiveList = FDataList then
  644.         with TCustomDBGrid(Grid), Columns[SelectedIndex].Field do
  645.         begin
  646.           MasterField := DataSet.FieldByName(KeyFields);
  647.           if MasterField.CanModify then
  648.           begin
  649.             DataSet.Edit;
  650.             MasterField.Value := ListValue;
  651.           end;
  652.         end
  653.       else
  654.         if (not VarIsNull(ListValue)) and EditCanModify then
  655.           with TCustomDBGrid(Grid), Columns[SelectedIndex].Field do
  656.             Text := ListValue;
  657.   end;
  658. end;
  659.  
  660. procedure TDBGridInplaceEdit.DoDropDownKeys(var Key: Word; Shift: TShiftState);
  661. begin
  662.   case Key of
  663.     VK_UP, VK_DOWN:
  664.       if ssAlt in Shift then
  665.       begin
  666.         if FListVisible then CloseUp(True) else DropDown;
  667.         Key := 0;
  668.       end;
  669.     VK_RETURN, VK_ESCAPE:
  670.       if FListVisible and not (ssAlt in Shift) then
  671.       begin
  672.         CloseUp(Key = VK_RETURN);
  673.         Key := 0;
  674.       end;
  675.   end;
  676. end;
  677.  
  678. procedure TDBGridInplaceEdit.DropDown;
  679. var
  680.   P: TPoint;
  681.   Y: Integer;
  682.   Column: TColumn;
  683. begin
  684.   if not FListVisible and Assigned(FActiveList) then
  685.   begin
  686.     FActiveList.Width := Width;
  687.     with TCustomDBGrid(Grid) do
  688.       Column := Columns[SelectedIndex];
  689.     if FActiveList = FDataList then
  690.     with Column.Field do
  691.     begin
  692.       FDataList.Color := Color;
  693.       FDataList.Font := Font;
  694.       FDataList.RowCount := Column.DropDownRows;
  695.       FLookupSource.DataSet := LookupDataSet;
  696.       FDataList.KeyField := LookupKeyFields;
  697.       FDataList.ListField := LookupResultField;
  698.       FDataList.ListSource := FLookupSource;
  699.       FDataList.KeyValue := DataSet.FieldByName(KeyFields).Value;
  700.     end
  701.     else
  702.     begin
  703.       FPickList.Color := Color;
  704.       FPickList.Font := Font;
  705.       FPickList.Items := Column.Picklist;
  706.       if FPickList.Items.Count >= Column.DropDownRows then
  707.         FPickList.Height := Column.DropDownRows * FPickList.ItemHeight + 4
  708.       else
  709.         FPickList.Height := FPickList.Items.Count * FPickList.ItemHeight + 4;
  710.       if Column.Field.IsNull then
  711.         FPickList.ItemIndex := -1
  712.       else
  713.         FPickList.ItemIndex := FPickList.Items.IndexOf(Column.Field.Value);
  714.     end;
  715.     P := Parent.ClientToScreen(Point(Left, Top));
  716.     Y := P.Y + Height;
  717.     if Y + FActiveList.Height > Screen.Height then Y := P.Y - FActiveList.Height;
  718.     SetWindowPos(FActiveList.Handle, HWND_TOP, P.X, Y, 0, 0,
  719.       SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  720.     FListVisible := True;
  721.     Invalidate;
  722.     Windows.SetFocus(Handle);
  723.   end;
  724. end;
  725.  
  726. type
  727.   TWinControlCracker = class(TWinControl) end;
  728.  
  729. procedure TDBGridInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  730. var
  731.   Msg: TMsg;
  732. begin
  733.   if (EditStyle = esEllipsis) and (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  734.   begin
  735.     TCustomDBGrid(Grid).EditButtonClick;
  736.     PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE);
  737.   end
  738.   else
  739.     inherited KeyDown(Key, Shift);
  740. end;
  741.  
  742. procedure TDBGridInplaceEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  743.   Shift: TShiftState; X, Y: Integer);
  744. begin
  745.   if Button = mbLeft then
  746.     CloseUp(PtInRect(FActiveList.ClientRect, Point(X, Y)));
  747. end;
  748.  
  749. procedure TDBGridInplaceEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  750.   X, Y: Integer);
  751. begin
  752.   if (Button = mbLeft) and (FEditStyle <> esSimple) and
  753.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(X,Y)) then
  754.   begin
  755.     if FListVisible then
  756.       CloseUp(False)
  757.     else
  758.     begin
  759.       MouseCapture := True;
  760.       FTracking := True;
  761.       TrackButton(X, Y);
  762.       if Assigned(FActiveList) then
  763.         DropDown;
  764.     end;
  765.   end;
  766.   inherited MouseDown(Button, Shift, X, Y);
  767. end;
  768.  
  769. procedure TDBGridInplaceEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
  770. var
  771.   ListPos: TPoint;
  772.   MousePos: TSmallPoint;
  773. begin
  774.   if FTracking then
  775.   begin
  776.     TrackButton(X, Y);
  777.     if FListVisible then
  778.     begin
  779.       ListPos := FActiveList.ScreenToClient(ClientToScreen(Point(X, Y)));
  780.       if PtInRect(FActiveList.ClientRect, ListPos) then
  781.       begin
  782.         StopTracking;
  783.         MousePos := PointToSmallPoint(ListPos);
  784.         SendMessage(FActiveList.Handle, WM_LBUTTONDOWN, 0, Integer(MousePos));
  785.         Exit;
  786.       end;
  787.     end;
  788.   end;
  789.   inherited MouseMove(Shift, X, Y);
  790. end;
  791.  
  792. procedure TDBGridInplaceEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  793.   X, Y: Integer);
  794. var
  795.   WasPressed: Boolean;
  796. begin
  797.   WasPressed := FPressed;
  798.   StopTracking;
  799.   if (Button = mbLeft) and (FEditStyle = esEllipsis) and WasPressed then
  800.     TCustomDBGrid(Grid).EditButtonClick;
  801.   inherited MouseUp(Button, Shift, X, Y);
  802. end;
  803.  
  804. procedure TDBGridInplaceEdit.PaintWindow(DC: HDC);
  805. var
  806.   R: TRect;
  807.   Flags: Integer;
  808.   W: Integer;
  809. begin
  810.   if FEditStyle <> esSimple then
  811.   begin
  812.     SetRect(R, Width - FButtonWidth, 0, Width, Height);
  813.     Flags := 0;
  814.     if FEditStyle in [esDataList, esPickList] then
  815.     begin
  816.       if FActiveList = nil then
  817.         Flags := DFCS_INACTIVE
  818.       else if FPressed then
  819.         Flags := DFCS_FLAT or DFCS_PUSHED;
  820.       DrawFrameControl(DC, R, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
  821.     end
  822.     else   { esEllipsis }
  823.     begin
  824.       if FPressed then
  825.         Flags := BF_FLAT;
  826.       DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_MIDDLE or Flags);
  827.       Flags := ((R.Right - R.Left) shr 1) - 1 + Ord(FPressed);
  828.       W := Height shr 3;
  829.       if W = 0 then W := 1;
  830.       PatBlt(DC, R.Left + Flags, R.Top + Flags, W, W, BLACKNESS);
  831.       PatBlt(DC, R.Left + Flags - (W * 2), R.Top + Flags, W, W, BLACKNESS);
  832.       PatBlt(DC, R.Left + Flags + (W * 2), R.Top + Flags, W, W, BLACKNESS);
  833.     end;
  834.     ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
  835.   end;
  836.   inherited PaintWindow(DC);
  837. end;
  838.  
  839. procedure TDBGridInplaceEdit.SetEditStyle(Value: TEditStyle);
  840. begin
  841.   if Value = FEditStyle then Exit;
  842.   FEditStyle := Value;
  843.   case Value of
  844.     esPickList:
  845.       begin
  846.         if FPickList = nil then
  847.         begin
  848.           FPickList := TPopupListbox.Create(Self);
  849.           FPickList.Visible := False;
  850.           FPickList.Parent := Self;
  851.           FPickList.OnMouseUp := ListMouseUp;
  852.           FPickList.IntegralHeight := True;
  853.           FPickList.ItemHeight := 11;
  854.         end;
  855.         FActiveList := FPickList;
  856.       end;
  857.     esDataList:
  858.       begin
  859.         if FDataList = nil then
  860.         begin
  861.           FDataList := TPopupDataList.Create(Self);
  862.           FDataList.Visible := False;
  863.           FDataList.Parent := Self;
  864.           FDataList.OnMouseUp := ListMouseUp;
  865.         end;
  866.         FActiveList := FDataList;
  867.       end;
  868.   else  { cbsNone, cbsEllipsis, or read only field }
  869.     FActiveList := nil;
  870.   end;
  871.   with TCustomDBGrid(Grid) do
  872.     Self.ReadOnly := Columns[SelectedIndex].ReadOnly;
  873.   Repaint;
  874. end;
  875.  
  876. procedure TDBGridInplaceEdit.StopTracking;
  877. begin
  878.   if FTracking then
  879.   begin
  880.     TrackButton(-1, -1);
  881.     FTracking := False;
  882.     MouseCapture := False;
  883.   end;
  884. end;
  885.  
  886. procedure TDBGridInplaceEdit.TrackButton(X,Y: Integer);
  887. var
  888.   NewState: Boolean;
  889.   R: TRect;
  890. begin
  891.   SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  892.   NewState := PtInRect(R, Point(X, Y));
  893.   if FPressed <> NewState then
  894.   begin
  895.     FPressed := NewState;
  896.     InvalidateRect(Handle, @R, False);
  897.   end;
  898. end;
  899.  
  900. procedure TDBGridInplaceEdit.UpdateContents;
  901. var
  902.   Column: TColumn;
  903.   NewStyle: TEditStyle;
  904.   MasterField: TField;
  905. begin
  906.   with TCustomDBGrid(Grid) do
  907.     Column := Columns[SelectedIndex];
  908.   NewStyle := esSimple;
  909.   case Column.ButtonStyle of
  910.    cbsEllipsis: NewStyle := esEllipsis;
  911.    cbsAuto:
  912.      if Assigned(Column.Field) then
  913.      with Column.Field do
  914.      begin
  915.        { Show the dropdown button only if the field is editable }
  916.        if Lookup then
  917.        begin
  918.          MasterField := Dataset.FieldByName(KeyFields);
  919.          { Column.DefaultReadonly will always be True for a lookup field.
  920.            Test if Column.ReadOnly has been assigned a value of True }
  921.          if Assigned(MasterField) and MasterField.CanModify and
  922.            not ((cvReadOnly in Column.AssignedValues) and Column.ReadOnly) then
  923.            with TCustomDBGrid(Grid) do
  924.              if not ReadOnly and DataLink.Active and not Datalink.ReadOnly then
  925.                NewStyle := esDataList
  926.        end
  927.        else
  928.        if Assigned(Column.Picklist) and (Column.PickList.Count > 0) and
  929.          not Column.Readonly then
  930.          NewStyle := esPickList;
  931.      end;
  932.   end;
  933.   EditStyle := NewStyle;
  934.   inherited UpdateContents;
  935. end;
  936.  
  937. procedure TDBGridInplaceEdit.CMCancelMode(var Message: TCMCancelMode);
  938. begin
  939.   if (Message.Sender <> Self) and (Message.Sender <> FActiveList) then
  940.     CloseUp(False);
  941. end;
  942.  
  943. procedure TDBGridInplaceEdit.WMCancelMode(var Message: TMessage);
  944. begin
  945.   StopTracking;
  946.   inherited;
  947. end;
  948.  
  949. procedure TDBGridInplaceEdit.WMKillFocus(var Message: TMessage);
  950. begin
  951.   inherited;
  952.   CloseUp(False);
  953. end;
  954.  
  955. procedure TDBGridInplaceEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  956. begin
  957.   with Message do
  958.   if (FEditStyle <> esSimple) and
  959.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), Point(XPos, YPos)) then
  960.     Exit;
  961.   inherited;
  962. end;
  963.  
  964. procedure TDBGridInplaceEdit.WMPaint(var Message: TWMPaint);
  965. begin
  966.   PaintHandler(Message);
  967. end;
  968.  
  969. procedure TDBGridInplaceEdit.WMSetCursor(var Message: TWMSetCursor);
  970. var
  971.   P: TPoint;
  972. begin
  973.   GetCursorPos(P);
  974.   if (FEditStyle <> esSimple) and
  975.     PtInRect(Rect(Width - FButtonWidth, 0, Width, Height), ScreenToClient(P)) then
  976.     Windows.SetCursor(LoadCursor(0, idc_Arrow))
  977.   else
  978.     inherited;
  979. end;
  980.  
  981. procedure TDBGridInplaceEdit.WndProc(var Message: TMessage);
  982. begin
  983.   case Message.Msg of
  984.     wm_KeyDown, wm_SysKeyDown, wm_Char:
  985.       if EditStyle in [esPickList, esDataList] then
  986.       with TWMKey(Message) do
  987.       begin
  988.         DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
  989.         if (CharCode <> 0) and FListVisible then
  990.         begin
  991.           with TMessage(Message) do
  992.             SendMessage(FActiveList.Handle, Msg, WParam, LParam);
  993.           Exit;
  994.         end;
  995.       end
  996.   end;
  997.   inherited;
  998. end;
  999.  
  1000.  
  1001. { TGridDataLink }
  1002.  
  1003. type
  1004.   TIntArray = array[0..MaxMapSize] of Integer;
  1005.   PIntArray = ^TIntArray;
  1006.  
  1007. constructor TGridDataLink.Create(AGrid: TCustomDBGrid);
  1008. begin
  1009.   inherited Create;
  1010.   FGrid := AGrid;
  1011. end;
  1012.  
  1013. destructor TGridDataLink.Destroy;
  1014. begin
  1015.   ClearMapping;
  1016.   inherited Destroy;
  1017. end;
  1018.  
  1019. function TGridDataLink.GetDefaultFields: Boolean;
  1020. var
  1021.   I: Integer;
  1022. begin
  1023.   Result := True;
  1024.   if DataSet <> nil then Result := DataSet.DefaultFields;
  1025.   if Result and SparseMap then
  1026.   for I := 0 to FFieldCount-1 do
  1027.     if PIntArray(FFieldMap)^[I] < 0 then
  1028.     begin
  1029.       Result := False;
  1030.       Exit;
  1031.     end;
  1032. end;
  1033.  
  1034. function TGridDataLink.GetFields(I: Integer): TField;
  1035. begin
  1036.   if (0 <= I) and (I < FFieldCount) and (PIntArray(FFieldMap)^[I] >= 0) then
  1037.     Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
  1038.   else
  1039.     Result := nil;
  1040. end;
  1041.  
  1042. function TGridDataLink.AddMapping(const FieldName: string): Boolean;
  1043. var
  1044.   Field: TField;
  1045.   NewSize: Integer;
  1046. begin
  1047.   Result := True;
  1048.   if FFieldCount >= MaxMapSize then GridError(STooManyColumns);
  1049.   if SparseMap then
  1050.     Field := DataSet.FindField(FieldName)
  1051.   else
  1052.     Field := DataSet.FieldByName(FieldName);
  1053.  
  1054.   if FFieldCount = FFieldMapSize then
  1055.   begin
  1056.     NewSize := FFieldMapSize;
  1057.     if NewSize = 0 then
  1058.       NewSize := 8
  1059.     else
  1060.       Inc(NewSize, NewSize);
  1061.     if (NewSize < FFieldCount) then
  1062.       NewSize := FFieldCount + 1;
  1063.     if (NewSize > MaxMapSize) then
  1064.       NewSize := MaxMapSize;
  1065.     ReallocMem(FFieldMap, NewSize * SizeOf(Integer));
  1066.     FFieldMapSize := NewSize;
  1067.   end;
  1068.   if Assigned(Field) then
  1069.   begin
  1070.     PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
  1071.     Field.FreeNotification(FGrid);
  1072.   end
  1073.   else
  1074.     PIntArray(FFieldMap)^[FFieldCount] := -1;
  1075.   Inc(FFieldCount);
  1076. end;
  1077.  
  1078. procedure TGridDataLink.ActiveChanged;
  1079. begin
  1080.   FGrid.LinkActive(Active);
  1081. end;
  1082.  
  1083. procedure TGridDataLink.ClearMapping;
  1084. begin
  1085.   if FFieldMap <> nil then
  1086.   begin
  1087.     FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
  1088.     FFieldMap := nil;
  1089.     FFieldMapSize := 0;
  1090.     FFieldCount := 0;
  1091.   end;
  1092. end;
  1093.  
  1094. procedure TGridDataLink.Modified;
  1095. begin
  1096.   FModified := True;
  1097. end;
  1098.  
  1099. procedure TGridDataLink.DataSetChanged;
  1100. begin
  1101.   FGrid.DataChanged;
  1102.   FModified := False;
  1103. end;
  1104.  
  1105. procedure TGridDataLink.DataSetScrolled(Distance: Integer);
  1106. begin
  1107.   FGrid.Scroll(Distance);
  1108. end;
  1109.  
  1110. procedure TGridDataLink.LayoutChanged;
  1111. var
  1112.   SaveState: Boolean;
  1113. begin
  1114.   { FLayoutFromDataset determines whether default column width is forced to
  1115.     be at least wide enough for the column title.  }
  1116.   SaveState := FGrid.FLayoutFromDataset;
  1117.   FGrid.FLayoutFromDataset := True;
  1118.   try
  1119.     FGrid.LayoutChanged;
  1120.   finally
  1121.     FGrid.FLayoutFromDataset := SaveState;
  1122.   end;
  1123. end;
  1124.  
  1125. procedure TGridDataLink.FocusControl(Field: TFieldRef);
  1126. begin
  1127.   if Assigned(Field) and Assigned(Field^) then
  1128.   begin
  1129.     FGrid.SelectedField := Field^;
  1130.     if (FGrid.SelectedField = Field^) and FGrid.AcquireFocus then
  1131.     begin
  1132.       Field^ := nil;
  1133.       FGrid.ShowEditor;
  1134.     end;
  1135.   end;
  1136. end;
  1137.  
  1138. procedure TGridDataLink.EditingChanged;
  1139. begin
  1140.   FGrid.EditingChanged;
  1141. end;
  1142.  
  1143. procedure TGridDataLink.RecordChanged(Field: TField);
  1144. begin
  1145.     FGrid.RecordChanged(Field);
  1146.     FModified := False;
  1147. end;
  1148.  
  1149. procedure TGridDataLink.UpdateData;
  1150. begin
  1151.   FInUpdateData := True;
  1152.   try
  1153.     if FModified then FGrid.UpdateData;
  1154.     FModified := False;
  1155.   finally
  1156.     FInUpdateData := False;
  1157.   end;
  1158. end;
  1159.  
  1160. function TGridDataLink.GetMappedIndex(ColIndex: Integer): Integer;
  1161. begin
  1162.   if (0 <= ColIndex) and (ColIndex < FFieldCount) then
  1163.     Result := PIntArray(FFieldMap)^[ColIndex]
  1164.   else
  1165.     Result := -1;
  1166. end;
  1167.  
  1168. procedure TGridDataLink.Reset;
  1169. begin
  1170.   if FModified then RecordChanged(nil) else Dataset.Cancel;
  1171. end;
  1172.  
  1173.  
  1174. { TColumnTitle }
  1175. constructor TColumnTitle.Create(Column: TColumn);
  1176. begin
  1177.   inherited Create;
  1178.   FColumn := Column;
  1179.   FFont := TFont.Create;
  1180.   FFont.Assign(DefaultFont);
  1181.   FFont.OnChange := FontChanged;
  1182. end;
  1183.  
  1184. destructor TColumnTitle.Destroy;
  1185. begin
  1186.   FFont.Free;
  1187.   inherited Destroy;
  1188. end;
  1189.  
  1190. procedure TColumnTitle.Assign(Source: TPersistent);
  1191. begin
  1192.   if Source is TColumnTitle then
  1193.   begin
  1194.     if cvTitleAlignment in TColumnTitle(Source).FColumn.FAssignedValues then
  1195.       Alignment := TColumnTitle(Source).Alignment;
  1196.     if cvTitleColor in TColumnTitle(Source).FColumn.FAssignedValues then
  1197.       Color := TColumnTitle(Source).Color;
  1198.     if cvTitleCaption in TColumnTitle(Source).FColumn.FAssignedValues then
  1199.       Caption := TColumnTitle(Source).Caption;
  1200.     if cvTitleFont in TColumnTitle(Source).FColumn.FAssignedValues then
  1201.       Font := TColumnTitle(Source).Font;
  1202.   end
  1203.   else
  1204.     inherited Assign(Source);
  1205. end;
  1206.  
  1207. function TColumnTitle.DefaultAlignment: TAlignment;
  1208. begin
  1209.   Result := taLeftJustify;
  1210. end;
  1211.  
  1212. function TColumnTitle.DefaultColor: TColor;
  1213. var
  1214.   Grid: TCustomDBGrid;
  1215. begin
  1216.   Grid := FColumn.GetGrid;
  1217.   if Assigned(Grid) then
  1218.     Result := Grid.FixedColor
  1219.   else
  1220.     Result := clBtnFace;
  1221. end;
  1222.  
  1223. function TColumnTitle.DefaultFont: TFont;
  1224. var
  1225.   Grid: TCustomDBGrid;
  1226. begin
  1227.   Grid := FColumn.GetGrid;
  1228.   if Assigned(Grid) then
  1229.     Result := Grid.TitleFont
  1230.   else
  1231.     Result := FColumn.Font;
  1232. end;
  1233.  
  1234. function TColumnTitle.DefaultCaption: string;
  1235. var
  1236.   Field: TField;
  1237. begin
  1238.   Field := FColumn.Field;
  1239.   if Assigned(Field) then
  1240.     Result := Field.DisplayName
  1241.   else
  1242.     Result := FColumn.FieldName;
  1243. end;
  1244.  
  1245. procedure TColumnTitle.FontChanged(Sender: TObject);
  1246. begin
  1247.   Include(FColumn.FAssignedValues, cvTitleFont);
  1248.   FColumn.Changed(True);
  1249. end;
  1250.  
  1251. function TColumnTitle.GetAlignment: TAlignment;
  1252. begin
  1253.   if cvTitleAlignment in FColumn.FAssignedValues then
  1254.     Result := FAlignment
  1255.   else
  1256.     Result := DefaultAlignment;
  1257. end;
  1258.  
  1259. function TColumnTitle.GetColor: TColor;
  1260. begin
  1261.   if cvTitleColor in FColumn.FAssignedValues then
  1262.     Result := FColor
  1263.   else
  1264.     Result := DefaultColor;
  1265. end;
  1266.  
  1267. function TColumnTitle.GetCaption: string;
  1268. begin
  1269.   if cvTitleCaption in FColumn.FAssignedValues then
  1270.     Result := FCaption
  1271.   else
  1272.     Result := DefaultCaption;
  1273. end;
  1274.  
  1275. function TColumnTitle.GetFont: TFont;
  1276. var
  1277.   Save: TNotifyEvent;
  1278.   Def: TFont;
  1279. begin
  1280.   if not (cvTitleFont in FColumn.FAssignedValues) then
  1281.   begin
  1282.     Def := DefaultFont;
  1283.     if (FFont.Handle <> Def.Handle) or (FFont.Color <> Def.Color) then
  1284.     begin
  1285.       Save := FFont.OnChange;
  1286.       FFont.OnChange := nil;
  1287.       FFont.Assign(DefaultFont);
  1288.       FFont.OnChange := Save;
  1289.     end;
  1290.   end;
  1291.   Result := FFont;
  1292. end;
  1293.  
  1294. function TColumnTitle.IsAlignmentStored: Boolean;
  1295. begin
  1296.   Result := (cvTitleAlignment in FColumn.FAssignedValues) and
  1297.     (FAlignment <> DefaultAlignment);
  1298. end;
  1299.  
  1300. function TColumnTitle.IsColorStored: Boolean;
  1301. begin
  1302.   Result := (cvTitleColor in FColumn.FAssignedValues) and
  1303.     (FColor <> DefaultColor);
  1304. end;
  1305.  
  1306. function TColumnTitle.IsFontStored: Boolean;
  1307. begin
  1308.   Result := (cvTitleFont in FColumn.FAssignedValues);
  1309. end;
  1310.  
  1311. function TColumnTitle.IsCaptionStored: Boolean;
  1312. begin
  1313.   Result := (cvTitleCaption in FColumn.FAssignedValues) and
  1314.     (FCaption <> DefaultCaption);
  1315. end;
  1316.  
  1317. procedure TColumnTitle.RefreshDefaultFont;
  1318. var
  1319.   Save: TNotifyEvent;
  1320. begin
  1321.   if (cvTitleFont in FColumn.FAssignedValues) then Exit;
  1322.   Save := FFont.OnChange;
  1323.   FFont.OnChange := nil;
  1324.   try
  1325.     FFont.Assign(DefaultFont);
  1326.   finally
  1327.     FFont.OnChange := Save;
  1328.   end;
  1329. end;
  1330.  
  1331. procedure TColumnTitle.RestoreDefaults;
  1332. var
  1333.   FontAssigned: Boolean;
  1334. begin
  1335.   FontAssigned := cvTitleFont in FColumn.FAssignedValues;
  1336.   FColumn.FAssignedValues := FColumn.FAssignedValues - ColumnTitleValues;
  1337.   FCaption := '';
  1338.   RefreshDefaultFont;
  1339.   { If font was assigned, changing it back to default may affect grid title
  1340.     height, and title height changes require layout and redraw of the grid. }
  1341.   FColumn.Changed(FontAssigned);
  1342. end;
  1343.  
  1344. procedure TColumnTitle.SetAlignment(Value: TAlignment);
  1345. begin
  1346.   if (cvTitleAlignment in FColumn.FAssignedValues) and (Value = FAlignment) then Exit;
  1347.   FAlignment := Value;
  1348.   Include(FColumn.FAssignedValues, cvTitleAlignment);
  1349.   FColumn.Changed(False);
  1350. end;
  1351.  
  1352. procedure TColumnTitle.SetColor(Value: TColor);
  1353. begin
  1354.   if (cvTitleColor in FColumn.FAssignedValues) and (Value = FColor) then Exit;
  1355.   FColor := Value;
  1356.   Include(FColumn.FAssignedValues, cvTitleColor);
  1357.   FColumn.Changed(False);
  1358. end;
  1359.  
  1360. procedure TColumnTitle.SetFont(Value: TFont);
  1361. begin
  1362.   FFont.Assign(Value);
  1363. end;
  1364.  
  1365. procedure TColumnTitle.SetCaption(const Value: string);
  1366. begin
  1367.   if (cvTitleCaption in FColumn.FAssignedValues) and (Value = FCaption) then Exit;
  1368.   FCaption := Value;
  1369.   Include(FColumn.FAssignedValues, cvTitleCaption);
  1370.   FColumn.Changed(False);
  1371. end;
  1372.  
  1373.  
  1374. { TColumn }
  1375.  
  1376. constructor TColumn.Create(Collection: TCollection);
  1377. var
  1378.   Grid: TCustomDBGrid;
  1379. begin
  1380.   Grid := nil;
  1381.   if Assigned(Collection) and (Collection is TDBGridColumns) then
  1382.     Grid := TDBGridColumns(Collection).Grid;
  1383.   if Assigned(Grid) then
  1384.     Grid.BeginLayout;
  1385.   try
  1386.     inherited Create(Collection);
  1387.     FDropDownRows := 7;
  1388.     FButtonStyle := cbsAuto;
  1389.     FFont := TFont.Create;
  1390.     FFont.Assign(DefaultFont);
  1391.     FFont.OnChange := FontChanged;
  1392.     FTitle := CreateTitle;
  1393.   finally
  1394.     if Assigned(Grid) then
  1395.       Grid.EndLayout;
  1396.   end;
  1397. end;
  1398.  
  1399. destructor TColumn.Destroy;
  1400. begin
  1401.   FTitle.Free;
  1402.   FFont.Free;
  1403.   FPickList.Free;
  1404.   inherited Destroy;
  1405. end;
  1406.  
  1407. procedure TColumn.Assign(Source: TPersistent);
  1408. begin
  1409.   if Source is TColumn then
  1410.   begin
  1411.     if Assigned(Collection) then Collection.BeginUpdate;
  1412.     try
  1413.       RestoreDefaults;
  1414.       FieldName := TColumn(Source).FieldName;
  1415.       if cvColor in TColumn(Source).AssignedValues then
  1416.         Color := TColumn(Source).Color;
  1417.       if cvWidth in TColumn(Source).AssignedValues then
  1418.         Width := TColumn(Source).Width;
  1419.       if cvFont in TColumn(Source).AssignedValues then
  1420.         Font := TColumn(Source).Font;
  1421.       if cvAlignment in TColumn(Source).AssignedValues then
  1422.         Alignment := TColumn(Source).Alignment;
  1423.       if cvReadOnly in TColumn(Source).AssignedValues then
  1424.         ReadOnly := TColumn(Source).ReadOnly;
  1425.       Title := TColumn(Source).Title;
  1426.       DropDownRows := TColumn(Source).DropDownRows;
  1427.       ButtonStyle := TColumn(Source).ButtonStyle;
  1428.       PickList := TColumn(Source).PickList;
  1429.     finally
  1430.       if Assigned(Collection) then Collection.EndUpdate;
  1431.     end;
  1432.   end
  1433.   else
  1434.     inherited Assign(Source);
  1435. end;
  1436.  
  1437. function TColumn.CreateTitle: TColumnTitle;
  1438. begin
  1439.   Result := TColumnTitle.Create(Self);
  1440. end;
  1441.  
  1442. function TColumn.DefaultAlignment: TAlignment;
  1443. begin
  1444.   if Assigned(Field) then
  1445.     Result := FField.Alignment
  1446.   else
  1447.     Result := taLeftJustify;
  1448. end;
  1449.  
  1450. function TColumn.DefaultColor: TColor;
  1451. var
  1452.   Grid: TCustomDBGrid;
  1453. begin
  1454.   Grid := GetGrid;
  1455.   if Assigned(Grid) then
  1456.     Result := Grid.Color
  1457.   else
  1458.     Result := clWindow;
  1459. end;
  1460.  
  1461. function TColumn.DefaultFont: TFont;
  1462. var
  1463.   Grid: TCustomDBGrid;
  1464. begin
  1465.   Grid := GetGrid;
  1466.   if Assigned(Grid) then
  1467.     Result := Grid.Font
  1468.   else
  1469.     Result := FFont;
  1470. end;
  1471.  
  1472. function TColumn.DefaultReadOnly: Boolean;
  1473. begin
  1474.   Result := False;
  1475. end;
  1476.  
  1477. function TColumn.DefaultWidth: Integer;
  1478. var
  1479.   W: Integer;
  1480.   RestoreCanvas: Boolean;
  1481.   TM: TTextMetric;
  1482. begin
  1483.   if GetGrid = nil then
  1484.   begin
  1485.     Result := 64;
  1486.     Exit;
  1487.   end;
  1488.   with GetGrid do
  1489.   begin
  1490.     if Assigned(Field) then
  1491.     begin
  1492.       RestoreCanvas := not HandleAllocated;
  1493.       if RestoreCanvas then
  1494.         Canvas.Handle := GetDC(0);
  1495.       try
  1496.         Canvas.Font := Self.Font;
  1497.         GetTextMetrics(Canvas.Handle, TM);
  1498.         Result := Field.DisplayWidth * (Canvas.TextWidth('0') - TM.tmOverhang)
  1499.           + TM.tmOverhang + 4;
  1500.         if dgTitles in Options then
  1501.         begin
  1502.           Canvas.Font := Title.Font;
  1503.           W := Canvas.TextWidth(Title.Caption) + 4;
  1504.           if Result < W then
  1505.             Result := W;
  1506.         end;
  1507.       finally
  1508.         if RestoreCanvas then
  1509.         begin
  1510.           ReleaseDC(0,Canvas.Handle);
  1511.           Canvas.Handle := 0;
  1512.         end;
  1513.       end;
  1514.     end
  1515.     else
  1516.       Result := DefaultColWidth;
  1517.   end;
  1518. end;
  1519.  
  1520. procedure TColumn.FontChanged;
  1521. begin
  1522.   Include(FAssignedValues, cvFont);
  1523.   Title.RefreshDefaultFont;
  1524.   Changed(False);
  1525. end;
  1526.  
  1527. function TColumn.GetAlignment: TAlignment;
  1528. begin
  1529.   if cvAlignment in FAssignedValues then
  1530.     Result := FAlignment
  1531.   else
  1532.     Result := DefaultAlignment;
  1533. end;
  1534.  
  1535. function TColumn.GetColor: TColor;
  1536. begin
  1537.   if cvColor in FAssignedValues then
  1538.     Result := FColor
  1539.   else
  1540.     Result := DefaultColor;
  1541. end;
  1542.  
  1543. function TColumn.GetField: TField;
  1544. var
  1545.   Grid: TCustomDBGrid;
  1546. begin    { Returns Nil if FieldName can't be found in dataset }
  1547.   Grid := GetGrid;
  1548.   if (FField = nil) and (Length(FFieldName) > 0) and Assigned(Grid) and
  1549.     Assigned(Grid.DataLink.DataSet) then
  1550.   with Grid.Datalink.Dataset do
  1551.     if Active or (not DefaultFields) then
  1552.       SetField(FindField(FieldName));
  1553.   Result := FField;
  1554. end;
  1555.  
  1556. function TColumn.GetFont: TFont;
  1557. var
  1558.   Save: TNotifyEvent;
  1559. begin
  1560.   if not (cvFont in FAssignedValues) and (FFont.Handle <> DefaultFont.Handle) then
  1561.   begin
  1562.     Save := FFont.OnChange;
  1563.     FFont.OnChange := nil;
  1564.     FFont.Assign(DefaultFont);
  1565.     FFont.OnChange := Save;
  1566.   end;
  1567.   Result := FFont;
  1568. end;
  1569.  
  1570. function TColumn.GetGrid: TCustomDBGrid;
  1571. begin
  1572.   if Assigned(Collection) and (Collection is TDBGridColumns) then
  1573.     Result := TDBGridColumns(Collection).Grid
  1574.   else
  1575.     Result := nil;
  1576. end;
  1577.  
  1578. function TColumn.GetPickList: TStrings;
  1579. begin
  1580.   if FPickList = nil then
  1581.     FPickList := TStringList.Create;
  1582.   Result := FPickList;
  1583. end;
  1584.  
  1585. function TColumn.GetReadOnly: Boolean;
  1586. begin
  1587.   if cvReadOnly in FAssignedValues then
  1588.     Result := FReadOnly
  1589.   else
  1590.     Result := DefaultReadOnly;
  1591. end;
  1592.  
  1593. function TColumn.GetWidth: Integer;
  1594. begin
  1595.   if cvWidth in FAssignedValues then
  1596.     Result := FWidth
  1597.   else
  1598.     Result := DefaultWidth;
  1599. end;
  1600.  
  1601. function TColumn.IsAlignmentStored: Boolean;
  1602. begin
  1603.   Result := (cvAlignment in FAssignedValues) and (FAlignment <> DefaultAlignment);
  1604. end;
  1605.  
  1606. function TColumn.IsColorStored: Boolean;
  1607. begin
  1608.   Result := (cvColor in FAssignedValues) and (FColor <> DefaultColor);
  1609. end;
  1610.  
  1611. function TColumn.IsFontStored: Boolean;
  1612. begin
  1613.   Result := (cvFont in FAssignedValues);
  1614. end;
  1615.  
  1616. function TColumn.IsReadOnlyStored: Boolean;
  1617. begin
  1618.   Result := (cvReadOnly in FAssignedValues) and (FReadOnly <> DefaultReadOnly);
  1619. end;
  1620.  
  1621. function TColumn.IsWidthStored: Boolean;
  1622. begin
  1623.   Result := (cvWidth in FAssignedValues) and (FWidth <> DefaultWidth);
  1624. end;
  1625.  
  1626. procedure TColumn.RefreshDefaultFont;
  1627. var
  1628.   Save: TNotifyEvent;
  1629. begin
  1630.   if cvFont in FAssignedValues then Exit;
  1631.   Save := FFont.OnChange;
  1632.   FFont.OnChange := nil;
  1633.   try
  1634.     FFont.Assign(DefaultFont);
  1635.   finally
  1636.     FFont.OnChange := Save;
  1637.   end;
  1638. end;
  1639.  
  1640. procedure TColumn.RestoreDefaults;
  1641. var
  1642.   FontAssigned: Boolean;
  1643. begin
  1644.   FontAssigned := cvFont in FAssignedValues;
  1645.   FTitle.RestoreDefaults;
  1646.   FAssignedValues := [];
  1647.   RefreshDefaultFont;
  1648.   FPickList.Free;
  1649.   FPickList := nil;
  1650.   ButtonStyle := cbsAuto;
  1651.   Changed(FontAssigned);
  1652. end;
  1653.  
  1654. procedure TColumn.SetAlignment(Value: TAlignment);
  1655. begin
  1656.   if (cvAlignment in FAssignedValues) and (Value = FAlignment) then Exit;
  1657.   FAlignment := Value;
  1658.   Include(FAssignedValues, cvAlignment);
  1659.   Changed(False);
  1660. end;
  1661.  
  1662. procedure TColumn.SetButtonStyle(Value: TColumnButtonStyle);
  1663. begin
  1664.   if Value = FButtonStyle then Exit;
  1665.   FButtonStyle := Value;
  1666.   Changed(False);
  1667. end;
  1668.  
  1669. procedure TColumn.SetColor(Value: TColor);
  1670. begin
  1671.   if (cvColor in FAssignedValues) and (Value = FColor) then Exit;
  1672.   FColor := Value;
  1673.   Include(FAssignedValues, cvColor);
  1674.   Changed(False);
  1675. end;
  1676.  
  1677. procedure TColumn.SetField(Value: TField);
  1678. begin
  1679.   if FField = Value then Exit;
  1680.   FField := Value;
  1681.   if Assigned(Value) then
  1682.     FFieldName := Value.FieldName;
  1683.   Changed(False);
  1684. end;
  1685.  
  1686. procedure TColumn.SetFieldName(const Value: String);
  1687. var
  1688.   AField: TField;
  1689.   Grid: TCustomDBGrid;
  1690. begin
  1691.   AField := nil;
  1692.   Grid := GetGrid;
  1693.   if Assigned(Grid) and Assigned(Grid.DataLink.DataSet) and
  1694.     not (csLoading in Grid.ComponentState) and (Length(Value) > 0) then
  1695.       AField := Grid.DataLink.DataSet.FindField(Value); { no exceptions }
  1696.   FFieldName := Value;
  1697.   SetField(AField);
  1698.   Changed(False);
  1699. end;
  1700.  
  1701. procedure TColumn.SetFont(Value: TFont);
  1702. begin
  1703.   FFont.Assign(Value);
  1704.   Include(FAssignedValues, cvFont);
  1705.   Changed(False);
  1706. end;
  1707.  
  1708. procedure TColumn.SetPickList(Value: TStrings);
  1709. begin
  1710.   if Value = nil then
  1711.   begin
  1712.     FPickList.Free;
  1713.     FPickList := nil;
  1714.     Exit;
  1715.   end;
  1716.   PickList.Assign(Value);
  1717. end;
  1718.  
  1719. procedure TColumn.SetReadOnly(Value: Boolean);
  1720. begin
  1721.   if (cvReadOnly in FAssignedValues) and (Value = FReadOnly) then Exit;
  1722.   FReadOnly := Value;
  1723.   Include(FAssignedValues, cvReadOnly);
  1724.   Changed(False);
  1725. end;
  1726.  
  1727. procedure TColumn.SetTitle(Value: TColumnTitle);
  1728. begin
  1729.   FTitle.Assign(Value);
  1730. end;
  1731.  
  1732. procedure TColumn.SetWidth(Value: Integer);
  1733. begin
  1734.   if (cvWidth in FAssignedValues) or (Value <> DefaultWidth) then
  1735.   begin
  1736.     FWidth := Value;
  1737.     Include(FAssignedValues, cvWidth);
  1738.   end;
  1739.   Changed(False);
  1740. end;
  1741.  
  1742. { TPassthroughColumn }
  1743.  
  1744. type
  1745.   TPassthroughColumnTitle = class(TColumnTitle)
  1746.   private
  1747.     procedure SetCaption(const Value: string); override;
  1748.   end;
  1749.  
  1750.   TPassthroughColumn = class(TColumn)
  1751.   private
  1752.     procedure SetAlignment(Value: TAlignment); override;
  1753.     procedure SetField(Value: TField); override;
  1754.     procedure SetIndex(Value: Integer); override;
  1755.     procedure SetReadOnly(Value: Boolean); override;
  1756.     procedure SetWidth(Value: Integer); override;
  1757.   protected
  1758.     function CreateTitle: TColumnTitle; override;
  1759.   end;
  1760.  
  1761. { TPassthroughColumnTitle }
  1762.  
  1763. procedure TPassthroughColumnTitle.SetCaption(const Value: string);
  1764. var
  1765.   Grid: TCustomDBGrid;
  1766. begin
  1767.   Grid := FColumn.GetGrid;
  1768.   if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(FColumn.Field) then
  1769.     FColumn.Field.DisplayLabel := Value
  1770.   else
  1771.     inherited SetCaption(Value);
  1772. end;
  1773.  
  1774.  
  1775. { TPassthroughColumn }
  1776.  
  1777. function TPassthroughColumn.CreateTitle: TColumnTitle;
  1778. begin
  1779.   Result := TPassthroughColumnTitle.Create(Self);
  1780. end;
  1781.  
  1782. procedure TPassthroughColumn.SetAlignment(Value: TAlignment);
  1783. var
  1784.   Grid: TCustomDBGrid;
  1785. begin
  1786.   Grid := GetGrid;
  1787.   if Assigned(Grid) and (Grid.Datalink.Active) and Assigned(Field) then
  1788.     Field.Alignment := Value
  1789.   else
  1790.     inherited SetAlignment(Value);
  1791. end;
  1792.  
  1793. procedure TPassthroughColumn.SetField(Value: TField);
  1794. begin
  1795.   inherited SetField(Value);
  1796.   if Value = nil then
  1797.     FFieldName := '';
  1798.   RestoreDefaults;
  1799. end;
  1800.  
  1801. procedure TPassthroughColumn.SetIndex(Value: Integer);
  1802. var
  1803.   Grid: TCustomDBGrid;
  1804.   Fld: TField;
  1805. begin
  1806.   Grid := GetGrid;
  1807.   if Assigned(Grid) and Grid.Datalink.Active then
  1808.   begin
  1809.     Fld := Grid.Datalink.Fields[Value];
  1810.     if Assigned(Fld) then
  1811.       Field.Index := Fld.Index;
  1812.   end;
  1813.   inherited SetIndex(Value);
  1814. end;
  1815.  
  1816. procedure TPassthroughColumn.SetReadOnly(Value: Boolean);
  1817. var
  1818.   Grid: TCustomDBGrid;
  1819. begin
  1820.   Grid := GetGrid;
  1821.   if Assigned(Grid) and Grid.Datalink.Active and Assigned(Field) then
  1822.     Field.ReadOnly := Value
  1823.   else
  1824.     inherited SetReadOnly(Value);
  1825. end;
  1826.  
  1827. procedure TPassthroughColumn.SetWidth(Value: Integer);
  1828. var
  1829.   Grid: TCustomDBGrid;
  1830.   TM: TTextMetric;
  1831. begin
  1832.   Grid := GetGrid;
  1833.   if Assigned(Grid) then
  1834.   begin
  1835.     if Grid.HandleAllocated and Assigned(Field) and Grid.FUpdateFields then
  1836.     with Grid do
  1837.     begin
  1838.       Canvas.Font := Self.Font;
  1839.       GetTextMetrics(Canvas.Handle, TM);
  1840.       Field.DisplayWidth := (Value + (TM.tmAveCharWidth div 2) - TM.tmOverhang - 3)
  1841.         div TM.tmAveCharWidth;
  1842.     end;
  1843.     if (not Grid.FLayoutFromDataset) or (cvWidth in FAssignedValues) then
  1844.       inherited SetWidth(Value);
  1845.   end
  1846.   else
  1847.     inherited SetWidth(Value);
  1848. end;
  1849.  
  1850.  
  1851. { TDBGridColumns }
  1852.  
  1853. constructor TDBGridColumns.Create(Grid: TCustomDBGrid; ColumnClass: TColumnClass);
  1854. begin
  1855.   inherited Create(ColumnClass);
  1856.   FGrid := Grid;
  1857. end;
  1858.  
  1859. function TDBGridColumns.Add: TColumn;
  1860. begin
  1861.   Result := TColumn(inherited Add);
  1862. end;
  1863.  
  1864. function TDBGridColumns.GetColumn(Index: Integer): TColumn;
  1865. begin
  1866.   Result := TColumn(inherited Items[Index]);
  1867. end;
  1868.  
  1869. function TDBGridColumns.GetState: TDBGridColumnsState;
  1870. begin
  1871.   Result := TDBGridColumnsState((Count > 0) and not (Items[0] is TPassthroughColumn));
  1872. end;
  1873.  
  1874. procedure TDBGridColumns.RestoreDefaults;
  1875. var
  1876.   I: Integer;
  1877. begin
  1878.   BeginUpdate;
  1879.   try
  1880.     for I := 0 to Count-1 do
  1881.       Items[I].RestoreDefaults;
  1882.   finally
  1883.     EndUpdate;
  1884.   end;
  1885. end;
  1886.  
  1887. procedure TDBGridColumns.RebuildColumns;
  1888. var
  1889.   I: Integer;
  1890. begin
  1891.   if Assigned(FGrid) and Assigned(FGrid.DataSource) and
  1892.     Assigned(FGrid.Datasource.Dataset) then
  1893.   begin
  1894.     FGrid.BeginLayout;
  1895.     try
  1896.       Clear;
  1897.       with FGrid.Datasource.Dataset do
  1898.         for I := 0 to FieldCount-1 do
  1899.           Add.FieldName := Fields[I].FieldName
  1900.     finally
  1901.       FGrid.EndLayout;
  1902.     end
  1903.   end
  1904.   else
  1905.     Clear;
  1906. end;
  1907.  
  1908. procedure TDBGridColumns.SetColumn(Index: Integer; Value: TColumn);
  1909. begin
  1910.   Items[Index].Assign(Value);
  1911. end;
  1912.  
  1913. procedure TDBGridColumns.SetState(NewState: TDBGridColumnsState);
  1914. begin
  1915.   if NewState = State then Exit;
  1916.   if NewState = csDefault then
  1917.     Clear
  1918.   else
  1919.     RebuildColumns;
  1920. end;
  1921.  
  1922. procedure TDBGridColumns.Update(Item: TCollectionItem);
  1923. var
  1924.   Raw: Integer;
  1925. begin
  1926.   if (FGrid = nil) or (csLoading in FGrid.ComponentState) then Exit;
  1927.   if Item = nil then
  1928.   begin
  1929.     FGrid.LayoutChanged;
  1930.   end
  1931.   else
  1932.   begin
  1933.     Raw := FGrid.DataToRawColumn(Item.Index);
  1934.     FGrid.InvalidateCol(Raw);
  1935.     FGrid.ColWidths[Raw] := TColumn(Item).Width;
  1936.   end;
  1937. end;
  1938.  
  1939. { TBookmarkList }
  1940.  
  1941. constructor TBookmarkList.Create(AGrid: TCustomDBGrid);
  1942. begin
  1943.   inherited Create;
  1944.   FList := TStringList.Create;
  1945.   FList.OnChange := StringsChanged;
  1946.   FGrid := AGrid;
  1947. end;
  1948.  
  1949. destructor TBookmarkList.Destroy;
  1950. begin
  1951.   Clear;
  1952.   FList.Free;
  1953.   inherited Destroy;
  1954. end;
  1955.  
  1956. procedure TBookmarkList.Clear;
  1957. begin
  1958.   if FList.Count = 0 then Exit;
  1959.   FList.Clear;
  1960.   FGrid.Invalidate;
  1961. end;
  1962.  
  1963. function TBookmarkList.Compare(const Item1, Item2: TBookmarkStr): Integer;
  1964. const Filter: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
  1965. begin    // Don't pass nil pointers to DbiCompareBookmarks
  1966.   Result := Filter[Length(Item1) = 0, Length(Item2) = 0];
  1967.   if Result < 2 then Exit;
  1968.   with FGrid.Datalink.Datasource.Dataset do
  1969.     DB.Check(DbiCompareBookmarks(Handle, Pointer(Item1), Pointer(Item2), Result));
  1970.   if Result = 2 then Result := 0;
  1971. end;
  1972.  
  1973. function TBookmarkList.CurrentRow: TBookmarkStr;
  1974. begin
  1975.   if not FLinkActive then GridError(sDataSetClosed);
  1976.   Result := FGrid.Datalink.Datasource.Dataset.Bookmark;
  1977. end;
  1978.  
  1979. function TBookmarkList.GetCurrentRowSelected: Boolean;
  1980. var
  1981.   Index: Integer;
  1982. begin
  1983.   Result := Find(CurrentRow, Index);
  1984. end;
  1985.  
  1986. function TBookmarkList.Find(const Item: TBookmarkStr; var Index: Integer): Boolean;
  1987. var
  1988.   L, H, I, C: Integer;
  1989. begin
  1990.   if (Item = FCache) and (FCacheIndex >= 0) then
  1991.   begin
  1992.     Index := FCacheIndex;
  1993.     Result := FCacheFind;
  1994.     Exit;
  1995.   end;
  1996.   Result := False;
  1997.   L := 0;
  1998.   H := FList.Count - 1;
  1999.   while L <= H do
  2000.   begin
  2001.     I := (L + H) shr 1;
  2002.     C := Compare(FList[I], Item);
  2003.     if C < 0 then L := I + 1 else
  2004.     begin
  2005.       H := I - 1;
  2006.       if C = 0 then
  2007.       begin
  2008.         Result := True;
  2009.         L := I;
  2010.       end;
  2011.     end;
  2012.   end;
  2013.   Index := L;
  2014.   FCache := Item;
  2015.   FCacheIndex := Index;
  2016.   FCacheFind := Result;
  2017. end;
  2018.  
  2019. function TBookmarkList.GetCount: Integer;
  2020. begin
  2021.   Result := FList.Count;
  2022. end;
  2023.  
  2024. function TBookmarkList.GetItem(Index: Integer): TBookmarkStr;
  2025. begin
  2026.   Result := FList[Index];
  2027. end;
  2028.  
  2029. function TBookmarkList.IndexOf(const Item: TBookmarkStr): Integer;
  2030. begin
  2031.   if not Find(Item, Result) then
  2032.     Result := -1;
  2033. end;
  2034.  
  2035. function TBookmarkList.Insert(const Item: TBookmarkStr): Integer;
  2036. begin
  2037.   Result := 0;
  2038.   if (Length(Item) > 0) and (not Find(Item, Result)) then
  2039.     FList.Insert(Result, Item);
  2040. end;
  2041.  
  2042. procedure TBookmarkList.LinkActive(Value: Boolean);
  2043. begin
  2044.   Clear;
  2045.   FLinkActive := Value;
  2046. end;
  2047.  
  2048. procedure TBookmarkList.Delete;
  2049. var
  2050.   I: Integer;
  2051. begin
  2052.   with FGrid.Datalink.Datasource.Dataset do
  2053.   begin
  2054.     DisableControls;
  2055.     try
  2056.       for I := FList.Count-1 downto 0 do
  2057.       begin
  2058.         Bookmark := FList[I];
  2059.         Delete;
  2060.         FList.Delete(I);
  2061.       end;
  2062.     finally
  2063.       EnableControls;
  2064.     end;
  2065.   end;
  2066. end;
  2067.  
  2068. function TBookmarkList.Refresh: Boolean;
  2069. var
  2070.   I: Integer;
  2071. begin
  2072.   Result := False;
  2073.   with FGrid.DataLink.Datasource.Dataset do
  2074.   try
  2075.     CheckBrowseMode;
  2076.     for I := FList.Count - 1 downto 0 do
  2077.       if DBISetToBookmark(Handle, Pointer(FList[I])) <> 0 then
  2078.       begin
  2079.         Result := True;
  2080.         FList.Delete(I);
  2081.       end;
  2082.   finally
  2083.     UpdateCursorPos;
  2084.     if Result then FGrid.Invalidate;
  2085.   end;
  2086. end;
  2087.  
  2088. procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
  2089. var
  2090.   Index: Integer;
  2091.   Current: TBookmarkStr;
  2092. begin
  2093.   Current := CurrentRow;
  2094.   if (Length(Current) = 0) or (Find(Current, Index) = Value) then Exit;
  2095.   if Value then
  2096.     FList.Insert(Index, Current)
  2097.   else
  2098.     FList.Delete(Index);
  2099.   FGrid.InvalidateRow(FGrid.Row);
  2100. end;
  2101.  
  2102. procedure TBookmarkList.StringsChanged(Sender: TObject);
  2103. begin
  2104.   FCache := '';
  2105.   FCacheIndex := -1;
  2106. end;
  2107.  
  2108.  
  2109. { TCustomDBGrid }
  2110.  
  2111. var
  2112.   DrawBitmap: TBitmap;
  2113.   UserCount: Integer;
  2114.  
  2115. procedure UsesBitmap;
  2116. begin
  2117.   if UserCount = 0 then
  2118.     DrawBitmap := TBitmap.Create;
  2119.   Inc(UserCount);
  2120. end;
  2121.  
  2122. procedure ReleaseBitmap;
  2123. begin
  2124.   Dec(UserCount);
  2125.   if UserCount = 0 then DrawBitmap.Free;
  2126. end;
  2127.  
  2128. function Max(X, Y: Integer): Integer;
  2129. begin
  2130.   Result := Y;
  2131.   if X > Y then Result := X;
  2132. end;
  2133.  
  2134. procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  2135.   const Text: string; Alignment: TAlignment);
  2136. const
  2137.   AlignFlags : array [TAlignment] of Integer =
  2138.     ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
  2139.       DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
  2140.       DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
  2141. var
  2142.   B, R: TRect;
  2143.   I, Left: Integer;
  2144. begin
  2145.   I := ColorToRGB(ACanvas.Brush.Color);
  2146.   if GetNearestColor(ACanvas.Handle, I) = I then
  2147.   begin                       { Use ExtTextOut for solid colors }
  2148.     case Alignment of
  2149.       taLeftJustify:
  2150.         Left := ARect.Left + DX;
  2151.       taRightJustify:
  2152.         Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
  2153.     else { taCenter }
  2154.       Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
  2155.         - (ACanvas.TextWidth(Text) shr 1);
  2156.     end;
  2157.     ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or
  2158.       ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
  2159.   end
  2160.   else begin                  { Use FillRect and Drawtext for dithered colors }
  2161.     with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
  2162.     begin                     { brush origin tics in painting / scrolling.    }
  2163.       Width := Max(Width, Right - Left);
  2164.       Height := Max(Height, Bottom - Top);
  2165.       R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
  2166.       B := Rect(0, 0, Right - Left, Bottom - Top);
  2167.     end;
  2168.     with DrawBitmap.Canvas do
  2169.     begin
  2170.       Font := ACanvas.Font;
  2171.       Font.Color := ACanvas.Font.Color;
  2172.       Brush := ACanvas.Brush;
  2173.       Brush.Style := bsSolid;
  2174.       FillRect(B);
  2175.       SetBkMode(Handle, TRANSPARENT);
  2176.       DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
  2177.     end;
  2178.     ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
  2179.   end;
  2180. end;
  2181.  
  2182. constructor TCustomDBGrid.Create(AOwner: TComponent);
  2183. var
  2184.   Bmp: TBitmap;
  2185. begin
  2186.   inherited Create(AOwner);
  2187.   inherited DefaultDrawing := False;
  2188.   FAcquireFocus := True;
  2189.   Bmp := TBitmap.Create;
  2190.   try
  2191.     Bmp.Handle := LoadBitmap(HInstance, bmArrow);
  2192.     FIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
  2193.     FIndicators.AddMasked(Bmp, clWhite);
  2194.     Bmp.Handle := LoadBitmap(HInstance, bmEdit);
  2195.     FIndicators.AddMasked(Bmp, clWhite);
  2196.     Bmp.Handle := LoadBitmap(HInstance, bmInsert);
  2197.     FIndicators.AddMasked(Bmp, clWhite);
  2198.   finally
  2199.     Bmp.Free;
  2200.   end;
  2201.   FTitleOffset := 1;
  2202.   FIndicatorOffset := 1;
  2203.   FUpdateFields := True;
  2204.   FOptions := [dgEditing, dgTitles, dgIndicator, dgColumnResize,
  2205.     dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit];
  2206.   UsesBitmap;
  2207.   ScrollBars := ssHorizontal;
  2208.   inherited Options := [goFixedHorzLine, goFixedVertLine, goHorzLine,
  2209.     goVertLine, goColSizing, goColMoving, goTabs, goEditing];
  2210.   FColumns := CreateColumns;
  2211.   inherited RowCount := 2;
  2212.   inherited ColCount := 2;
  2213.   FDataLink := TGridDataLink.Create(Self);
  2214.   Color := clWindow;
  2215.   ParentColor := False;
  2216.   FTitleFont := TFont.Create;
  2217.   FTitleFont.OnChange := TitleFontChanged;
  2218.   FSaveCellExtents := False;
  2219.   FUserChange := True;
  2220.   FDefaultDrawing := True;
  2221.   FBookmarks := TBookmarkList.Create(Self);
  2222.   HideEditor;
  2223. end;
  2224.  
  2225. destructor TCustomDBGrid.Destroy;
  2226. begin
  2227.   FColumns.Free;
  2228.   FColumns := nil;
  2229.   FDataLink.Free;
  2230.   FDataLink := nil;
  2231.   FIndicators.Free;
  2232.   FTitleFont.Free;
  2233.   FTitleFont := nil;
  2234.   FBookmarks.Free;
  2235.   FBookmarks := nil;
  2236.   inherited Destroy;
  2237.   ReleaseBitmap;
  2238. end;
  2239.  
  2240. function TCustomDBGrid.AcquireFocus: Boolean;
  2241. begin
  2242.   Result := True;
  2243.   if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  2244.   begin
  2245.     SetFocus;
  2246.     Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  2247.   end;
  2248. end;
  2249.  
  2250. function TCustomDBGrid.RawToDataColumn(ACol: Integer): Integer;
  2251. begin
  2252.   Result := ACol - FIndicatorOffset;
  2253. end;
  2254.  
  2255. function TCustomDBGrid.DataToRawColumn(ACol: Integer): Integer;
  2256. begin
  2257.   Result := ACol + FIndicatorOffset;
  2258. end;
  2259.  
  2260. function TCustomDBGrid.AcquireLayoutLock: Boolean;
  2261. begin
  2262.   Result := (FUpdateLock = 0) and (FLayoutLock = 0);
  2263.   if Result then BeginLayout;
  2264. end;
  2265.  
  2266. procedure TCustomDBGrid.BeginLayout;
  2267. begin
  2268.   BeginUpdate;
  2269.   if FLayoutLock = 0 then Columns.BeginUpdate;
  2270.   Inc(FLayoutLock);
  2271. end;
  2272.  
  2273. procedure TCustomDBGrid.BeginUpdate;
  2274. begin
  2275.   Inc(FUpdateLock);
  2276. end;
  2277.  
  2278. procedure TCustomDBGrid.CancelLayout;
  2279. begin
  2280.   if FLayoutLock > 0 then
  2281.   begin
  2282.     if FLayoutLock = 1 then
  2283.       Columns.EndUpdate;
  2284.     Dec(FLayoutLock);
  2285.     EndUpdate;
  2286.   end;
  2287. end;
  2288.  
  2289. function TCustomDBGrid.CanEditAcceptKey(Key: Char): Boolean;
  2290. begin
  2291.   with Columns[SelectedIndex] do
  2292.     Result := FDatalink.Active and Assigned(Field) and Field.IsValidChar(Key);
  2293. end;
  2294.  
  2295. function TCustomDBGrid.CanEditModify: Boolean;
  2296. begin
  2297.   Result := False;
  2298.   if not ReadOnly and FDatalink.Active and not FDatalink.Readonly then
  2299.   with Columns[SelectedIndex] do
  2300.     if (not ReadOnly) and Assigned(Field) and Field.CanModify
  2301.       and (not (Field is TBlobField) or Assigned(Field.OnSetText)) then
  2302.       // Allow editing of memo fields if OnSetText event is assigned
  2303.     begin
  2304.       FDatalink.Edit;
  2305.       Result := FDatalink.Editing;
  2306.       if Result then FDatalink.Modified;
  2307.     end;
  2308. end;
  2309.  
  2310. function TCustomDBGrid.CanEditShow: Boolean;
  2311. begin
  2312.   Result := (LayoutLock = 0) and inherited CanEditShow;
  2313. end;
  2314.  
  2315. procedure TCustomDBGrid.ColEnter;
  2316. begin
  2317.   if Assigned(FOnColEnter) then FOnColEnter(Self);
  2318. end;
  2319.  
  2320. procedure TCustomDBGrid.ColExit;
  2321. begin
  2322.   if Assigned(FOnColExit) then FOnColExit(Self);
  2323. end;
  2324.  
  2325. procedure TCustomDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  2326. begin
  2327.   FromIndex := RawToDataColumn(FromIndex);
  2328.   ToIndex := RawToDataColumn(ToIndex);
  2329.   Columns[FromIndex].Index := ToIndex;
  2330.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  2331. end;
  2332.  
  2333. procedure TCustomDBGrid.ColWidthsChanged;
  2334. var
  2335.   I: Integer;
  2336. begin
  2337.   inherited ColWidthsChanged;
  2338.   if (FDatalink.Active or (FColumns.State = csCustomized)) and
  2339.     AcquireLayoutLock then
  2340.   try
  2341.     for I := FIndicatorOffset to ColCount - 1 do
  2342.       FColumns[I - FIndicatorOffset].Width := ColWidths[I];
  2343.   finally
  2344.     EndLayout;
  2345.   end;
  2346. end;
  2347.  
  2348. function TCustomDBGrid.CreateColumns: TDBGridColumns;
  2349. begin
  2350.   Result := TDBGridColumns.Create(Self, TColumn);
  2351. end;
  2352.  
  2353. function TCustomDBGrid.CreateEditor: TInplaceEdit;
  2354. begin
  2355.   Result := TDBGridInplaceEdit.Create(Self);
  2356. end;
  2357.  
  2358. procedure TCustomDBGrid.CreateWnd;
  2359. begin
  2360.   BeginUpdate;   // prevent updates in WMSize message that follows WMCreate
  2361.   try
  2362.     inherited CreateWnd;
  2363.   finally
  2364.     EndUpdate;
  2365.   end;
  2366.   UpdateRowCount;
  2367.   UpdateActive;
  2368.   UpdateScrollBar;
  2369. end;
  2370.  
  2371. procedure TCustomDBGrid.DataChanged;
  2372. begin
  2373.   if not HandleAllocated then Exit;
  2374.   UpdateRowCount;
  2375.   UpdateScrollBar;
  2376.   UpdateActive;
  2377.   InvalidateEditor;
  2378.   ValidateRect(Handle, nil);
  2379.   Invalidate;
  2380. end;
  2381.  
  2382. procedure TCustomDBGrid.DeferLayout;
  2383. var
  2384.   M: TMsg;
  2385. begin
  2386.   if not PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_NoRemove) then
  2387.     PostMessage(Handle, cm_DeferLayout, 0, 0);
  2388.   CancelLayout;
  2389. end;
  2390.  
  2391. procedure TCustomDBGrid.DefineFieldMap;
  2392. var
  2393.   I: Integer;
  2394. begin
  2395.   if FColumns.State = csCustomized then
  2396.   begin   { Build the column/field map from the column attributes }
  2397.     DataLink.SparseMap := True;
  2398.     for I := 0 to FColumns.Count-1 do
  2399.       FDataLink.AddMapping(FColumns[I].FieldName);
  2400.   end
  2401.   else   { Build the column/field map from the field list order }
  2402.   begin
  2403.     FDataLink.SparseMap := False;
  2404.     with Datalink.Dataset do
  2405.       for I := 0 to FieldCount - 1 do
  2406.         with Fields[I] do if Visible then Datalink.AddMapping(FieldName);
  2407.   end;
  2408. end;
  2409.  
  2410. procedure TCustomDBGrid.DefaultDrawDataCell(const Rect: TRect; Field: TField;
  2411.   State: TGridDrawState);
  2412. var
  2413.   Alignment: TAlignment;
  2414.   Value: string;
  2415. begin
  2416.   Alignment := taLeftJustify;
  2417.   Value := '';
  2418.   if Assigned(Field) then
  2419.   begin
  2420.     Alignment := Field.Alignment;
  2421.     Value := Field.DisplayText;
  2422.   end;
  2423.   WriteText(Canvas, Rect, 2, 2, Value, Alignment);
  2424. end;
  2425.  
  2426. procedure TCustomDBGrid.DefaultDrawColumnCell(const Rect: TRect;
  2427.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  2428. var
  2429.   Value: string;
  2430. begin
  2431.   Value := '';
  2432.   if Assigned(Column.Field) then
  2433.     Value := Column.Field.DisplayText;
  2434.   WriteText(Canvas, Rect, 2, 2, Value, Column.Alignment);
  2435. end;
  2436.  
  2437. procedure TCustomDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
  2438. var
  2439.   OldActive: Integer;
  2440.   Indicator: Integer;
  2441.   Highlight: Boolean;
  2442.   Value: string;
  2443.   DrawColumn: TColumn;
  2444.   FrameOffs: Byte;
  2445. begin
  2446.   if csLoading in ComponentState then
  2447.   begin
  2448.     Canvas.Brush.Color := Color;
  2449.     Canvas.FillRect(ARect);
  2450.     Exit;
  2451.   end;
  2452.  
  2453.   Dec(ARow, FTitleOffset);
  2454.   Dec(ACol, FIndicatorOffset);
  2455.  
  2456.   if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
  2457.     [dgRowLines, dgColLines]) then
  2458.   begin
  2459.     InflateRect(ARect, -1, -1);
  2460.     FrameOffs := 1;
  2461.   end
  2462.   else
  2463.     FrameOffs := 2;
  2464.  
  2465.   if (gdFixed in AState) and (ACol < 0) then
  2466.   begin
  2467.     Canvas.Brush.Color := FixedColor;
  2468.     Canvas.FillRect(ARect);
  2469.     if Assigned(DataLink) and DataLink.Active and
  2470.       (ARow = FDataLink.ActiveRecord) then
  2471.     begin
  2472.       Indicator := 0;
  2473.       if FDataLink.DataSet <> nil then
  2474.         case FDataLink.DataSet.State of
  2475.           dsEdit: Indicator := 1;
  2476.           dsInsert: Indicator := 2;
  2477.         end;
  2478.       FIndicators.BkColor := FixedColor;
  2479.       FIndicators.Draw(Canvas, ARect.Right - FIndicators.Width - FrameOffs,
  2480.         (ARect.Top + ARect.Bottom - FIndicators.Height) shr 1, Indicator);
  2481.       FSelRow := ARow + FTitleOffset;
  2482.     end;
  2483.   end
  2484.   else with Canvas do
  2485.   begin
  2486.     DrawColumn := Columns[ACol];
  2487.     if gdFixed in AState then
  2488.     begin
  2489.       Font := DrawColumn.Title.Font;
  2490.       Brush.Color := DrawColumn.Title.Color;
  2491.     end
  2492.     else
  2493.     begin
  2494.       Font := DrawColumn.Font;
  2495.       Brush.Color := DrawColumn.Color;
  2496.     end;
  2497.     if ARow < 0 then with DrawColumn.Title do
  2498.       WriteText(Canvas, ARect, FrameOffs, FrameOffs, Caption, Alignment)
  2499.     else if (FDataLink = nil) or not FDataLink.Active then
  2500.       FillRect(ARect)
  2501.     else
  2502.     begin
  2503.       Value := '';
  2504.       OldActive := FDataLink.ActiveRecord;
  2505.       try
  2506.         FDataLink.ActiveRecord := ARow;
  2507.         if Assigned(DrawColumn.Field) then
  2508.           Value := DrawColumn.Field.DisplayText;
  2509.         Highlight := HighlightCell(ACol, ARow, Value, AState);
  2510.         if Highlight then
  2511.         begin
  2512.           Brush.Color := clHighlight;
  2513.           Font.Color := clHighlightText;
  2514.         end;
  2515.         if FDefaultDrawing then
  2516.           WriteText(Canvas, ARect, 2, 2, Value, DrawColumn.Alignment);
  2517.         if Columns.State = csDefault then
  2518.           DrawDataCell(ARect, DrawColumn.Field, AState);
  2519.         DrawColumnCell(ARect, ACol, DrawColumn, AState);
  2520.       finally
  2521.         FDataLink.ActiveRecord := OldActive;
  2522.       end;
  2523.       if FDefaultDrawing and (gdSelected in AState)
  2524.         and ((dgAlwaysShowSelection in Options) or Focused)
  2525.         and not (csDesigning in ComponentState)
  2526.         and not (dgRowSelect in Options)
  2527.         and (UpdateLock = 0)
  2528.         and (ValidParentForm(Self).ActiveControl = Self) then
  2529.         Windows.DrawFocusRect(Handle, ARect);
  2530.     end;
  2531.   end;
  2532.   if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
  2533.     [dgRowLines, dgColLines]) then
  2534.   begin
  2535.     InflateRect(ARect, 1, 1);
  2536.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  2537.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
  2538.   end;
  2539. end;
  2540.  
  2541. procedure TCustomDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2542.   State: TGridDrawState);
  2543. begin
  2544.   if Assigned(FOnDrawDataCell) then FOnDrawDataCell(Self, Rect, Field, State);
  2545. end;
  2546.  
  2547. procedure TCustomDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  2548.   Column: TColumn; State: TGridDrawState);
  2549. begin
  2550.   if Assigned(OnDrawColumnCell) then
  2551.     OnDrawColumnCell(Self, Rect, DataCol, Column, State);
  2552. end;
  2553.  
  2554. function TCustomDBGrid.Edit: Boolean;
  2555. begin
  2556.   Result := False;
  2557.   if not ReadOnly then
  2558.   begin
  2559.     FDataChanged := False;
  2560.     FEditRequest := True;
  2561.     try
  2562.       FDataLink.Edit;
  2563.     finally
  2564.       FEditRequest := False;
  2565.     end;
  2566.     Result := FDataChanged;
  2567.   end;
  2568. end;
  2569.  
  2570. procedure TCustomDBGrid.EditButtonClick;
  2571. begin
  2572.   if Assigned(FOnEditButtonClick) then FOnEditButtonClick(Self);
  2573. end;
  2574.  
  2575. procedure TCustomDBGrid.EditingChanged;
  2576. begin
  2577.   if dgIndicator in Options then InvalidateCell(0, FSelRow);
  2578. end;
  2579.  
  2580. procedure TCustomDBGrid.EndLayout;
  2581. begin
  2582.   if FLayoutLock > 0 then
  2583.   begin
  2584.     try
  2585.       try
  2586.         if FLayoutLock = 1 then
  2587.           InternalLayout;
  2588.       finally
  2589.         if FLayoutLock = 1 then
  2590.           FColumns.EndUpdate;
  2591.       end;
  2592.     finally
  2593.       Dec(FLayoutLock);
  2594.       EndUpdate;
  2595.     end;
  2596.   end;
  2597. end;
  2598.  
  2599. procedure TCustomDBGrid.EndUpdate;
  2600. begin
  2601.   if FUpdateLock > 0 then
  2602.     Dec(FUpdateLock);
  2603. end;
  2604.  
  2605. function TCustomDBGrid.GetColField(DataCol: Integer): TField;
  2606. begin
  2607.   Result := nil;
  2608.   if (DataCol >= 0) and FDatalink.Active and (DataCol < Columns.Count) then
  2609.     Result := Columns[DataCol].Field;
  2610. end;
  2611.  
  2612. function TCustomDBGrid.GetDataSource: TDataSource;
  2613. begin
  2614.   Result := FDataLink.DataSource;
  2615. end;
  2616.  
  2617. function TCustomDBGrid.GetEditLimit: Integer;
  2618. begin
  2619.   Result := 0;
  2620.   if Assigned(SelectedField) and (SelectedField is TStringField) then
  2621.     Result := TStringField(SelectedField).Size;
  2622. end;
  2623.  
  2624. function TCustomDBGrid.GetEditMask(ACol, ARow: Longint): string;
  2625. begin
  2626.   Result := '';
  2627.   if FDatalink.Active then
  2628.   with Columns[RawToDataColumn(ACol)] do
  2629.     if Assigned(Field) then
  2630.       Result := Field.EditMask;
  2631. end;
  2632.  
  2633. function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
  2634. begin
  2635.   Result := '';
  2636.   if FDatalink.Active then
  2637.   with Columns[RawToDataColumn(ACol)] do
  2638.     if Assigned(Field) then
  2639.       Result := Field.Text;
  2640.   FEditText := Result;
  2641. end;
  2642.  
  2643. function TCustomDBGrid.GetFieldCount: Integer;
  2644. begin
  2645.   Result := FDatalink.FieldCount;
  2646. end;
  2647.  
  2648. function TCustomDBGrid.GetFields(FieldIndex: Integer): TField;
  2649. begin
  2650.   Result := FDatalink.Fields[FieldIndex];
  2651. end;
  2652.  
  2653. function TCustomDBGrid.GetFieldValue(ACol: Integer): string;
  2654. var
  2655.   Field: TField;
  2656. begin
  2657.   Result := '';
  2658.   Field := GetColField(ACol);
  2659.   if Field <> nil then Result := Field.DisplayText;
  2660. end;
  2661.  
  2662. function TCustomDBGrid.GetSelectedField: TField;
  2663. var
  2664.   Index: Integer;
  2665. begin
  2666.   Index := SelectedIndex;
  2667.   if Index <> -1 then
  2668.     Result := Columns[Index].Field
  2669.   else
  2670.     Result := nil;
  2671. end;
  2672.  
  2673. function TCustomDBGrid.GetSelectedIndex: Integer;
  2674. begin
  2675.   Result := RawToDataColumn(Col);
  2676. end;
  2677.  
  2678. function TCustomDBGrid.HighlightCell(DataCol, DataRow: Integer;
  2679.   const Value: string; AState: TGridDrawState): Boolean;
  2680. var
  2681.   Index: Integer;
  2682. begin
  2683.   Result := False;
  2684.   if (dgMultiSelect in Options) and Datalink.Active then
  2685.     Result := FBookmarks.Find(Datalink.Datasource.Dataset.Bookmark, Index);
  2686.   if not Result then
  2687.     Result := (gdSelected in AState)
  2688.       and ((dgAlwaysShowSelection in Options) or Focused)
  2689.         { updatelock eliminates flicker when tabbing between rows }
  2690.       and ((UpdateLock = 0) or (dgRowSelect in Options));
  2691. end;
  2692.  
  2693. procedure TCustomDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
  2694. var
  2695.   KeyDownEvent: TKeyEvent;
  2696.  
  2697.   procedure ClearSelection;
  2698.   begin
  2699.     if (dgMultiSelect in Options) then
  2700.     begin
  2701.       FBookmarks.Clear;
  2702.       FSelecting := False;
  2703.     end;
  2704.   end;
  2705.  
  2706.   procedure DoSelection(Select: Boolean; Direction: Integer);
  2707.   var
  2708.     AddAfter: Boolean;
  2709.   begin
  2710.     AddAfter := False;
  2711.     BeginUpdate;
  2712.     try
  2713.       if (dgMultiSelect in Options) and FDatalink.Active then
  2714.         if Select and (ssShift in Shift) then
  2715.         begin
  2716.           if not FSelecting then
  2717.           begin
  2718.             FSelectionAnchor := FBookmarks.CurrentRow;
  2719.             FBookmarks.CurrentRowSelected := True;
  2720.             FSelecting := True;
  2721.             AddAfter := True;
  2722.           end
  2723.           else
  2724.           with FBookmarks do
  2725.           begin
  2726.             AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
  2727.             if not AddAfter then
  2728.               CurrentRowSelected := False;
  2729.           end
  2730.         end
  2731.         else
  2732.           ClearSelection;
  2733.       FDatalink.Dataset.MoveBy(Direction);
  2734.       if AddAfter then FBookmarks.CurrentRowSelected := True;
  2735.     finally
  2736.       EndUpdate;
  2737.     end;
  2738.   end;
  2739.  
  2740.   procedure NextRow(Select: Boolean);
  2741.   begin
  2742.     with FDatalink.Dataset do
  2743.     begin
  2744.       if (State = dsInsert) and not Modified and not FDatalink.FModified then
  2745.         if EOF then Exit else Cancel
  2746.       else
  2747.         DoSelection(Select, 1);
  2748.       if EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
  2749.         Append;
  2750.     end;
  2751.   end;
  2752.  
  2753.   procedure PriorRow(Select: Boolean);
  2754.   begin
  2755.     with FDatalink.Dataset do
  2756.       if (State = dsInsert) and not Modified and EOF and
  2757.         not FDatalink.FModified then
  2758.         Cancel
  2759.       else
  2760.         DoSelection(Select, -1);
  2761.   end;
  2762.  
  2763.   procedure Tab(GoForward: Boolean);
  2764.   var
  2765.     ACol, Original: Integer;
  2766.   begin
  2767.     ACol := Col;
  2768.     Original := ACol;
  2769.     BeginUpdate;    { Prevent highlight flicker on tab to next/prior row }
  2770.     try
  2771.       while True do
  2772.       begin
  2773.         if GoForward then
  2774.           Inc(ACol) else
  2775.           Dec(ACol);
  2776.         if ACol >= ColCount then
  2777.         begin
  2778.           NextRow(False);
  2779.           ACol := FIndicatorOffset;
  2780.         end
  2781.         else if ACol < FIndicatorOffset then
  2782.         begin
  2783.           PriorRow(False);
  2784.           ACol := ColCount;
  2785.         end;
  2786.         if ACol = Original then Exit;
  2787.         if TabStops[ACol] then
  2788.         begin
  2789.           MoveCol(ACol);
  2790.           Exit;
  2791.         end;
  2792.       end;
  2793.     finally
  2794.       EndUpdate;
  2795.     end;
  2796.   end;
  2797.  
  2798.   function DeletePrompt: Boolean;
  2799.   var
  2800.     Msg: Integer;
  2801.   begin
  2802.     if (FBookmarks.Count > 1) then
  2803.       Msg := SDeleteMultipleRecordsQuestion
  2804.     else
  2805.       Msg := SDeleteRecordQuestion;
  2806.     Result := not (dgConfirmDelete in Options) or
  2807.       (MessageDlg(LoadStr(Msg), mtConfirmation, mbOKCancel, 0) <> idCancel);
  2808.   end;
  2809.  
  2810. const
  2811.   RowMovementKeys = [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END];
  2812.  
  2813. begin
  2814.   KeyDownEvent := OnKeyDown;
  2815.   if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  2816.   if not FDatalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  2817.   with FDatalink.DataSet do
  2818.     if ssCtrl in Shift then
  2819.     begin
  2820.       if (Key in RowMovementKeys) then ClearSelection;
  2821.       case Key of
  2822.         VK_UP, VK_PRIOR: MoveBy(-FDatalink.ActiveRecord);
  2823.         VK_DOWN, VK_NEXT: MoveBy(FDatalink.BufferCount - FDatalink.ActiveRecord - 1);
  2824.         VK_LEFT: MoveCol(FIndicatorOffset);
  2825.         VK_RIGHT: MoveCol(ColCount - 1);
  2826.         VK_HOME: First;
  2827.         VK_END: Last;
  2828.         VK_DELETE: if not ReadOnly and CanModify and DeletePrompt then
  2829.           if FBookmarks.Count > 0 then
  2830.             FBookmarks.Delete
  2831.           else
  2832.             Delete;
  2833.       end
  2834.     end
  2835.     else
  2836.       case Key of
  2837.         VK_UP: PriorRow(True);
  2838.         VK_DOWN: NextRow(True);
  2839.         VK_LEFT:
  2840.           if dgRowSelect in Options then
  2841.             PriorRow(False) else
  2842.             MoveCol(Col - 1);
  2843.         VK_RIGHT:
  2844.           if dgRowSelect in Options then
  2845.             NextRow(False) else
  2846.             MoveCol(Col + 1);
  2847.         VK_HOME:
  2848.           if (ColCount = FIndicatorOffset+1)
  2849.             or (dgRowSelect in Options) then
  2850.           begin
  2851.             ClearSelection;
  2852.             First;
  2853.           end
  2854.           else
  2855.             MoveCol(FIndicatorOffset);
  2856.         VK_END:
  2857.           if (ColCount = FIndicatorOffset+1)
  2858.             or (dgRowSelect in Options) then
  2859.           begin
  2860.             ClearSelection;
  2861.             Last;
  2862.           end
  2863.           else
  2864.             MoveCol(ColCount - 1);
  2865.         VK_NEXT:
  2866.           begin
  2867.             ClearSelection;
  2868.             MoveBy(VisibleRowCount);
  2869.           end;
  2870.         VK_PRIOR:
  2871.           begin
  2872.             ClearSelection;
  2873.             MoveBy(-VisibleRowCount);
  2874.           end;
  2875.         VK_INSERT:
  2876.           if CanModify and (not ReadOnly) and (dgEditing in Options) then
  2877.           begin
  2878.             ClearSelection;
  2879.             Insert;
  2880.           end;
  2881.         VK_TAB: if not (ssAlt in Shift) then Tab(not (ssShift in Shift));
  2882.         VK_ESCAPE:
  2883.           begin
  2884.             FDatalink.Reset;
  2885.             ClearSelection;
  2886.             if not (dgAlwaysShowEditor in Options) then HideEditor;
  2887.           end;
  2888.         VK_F2: EditorMode := True;
  2889.       end;
  2890. end;
  2891.  
  2892. procedure TCustomDBGrid.KeyPress(var Key: Char);
  2893. begin
  2894.   if not (dgAlwaysShowEditor in Options) and (Key = #13) then
  2895.     FDatalink.UpdateData;
  2896.   inherited KeyPress(Key);
  2897. end;
  2898.  
  2899. { InternalLayout is called with layout locks and column locks in effect }
  2900. procedure TCustomDBGrid.InternalLayout;
  2901. var
  2902.   I, J, K: Integer;
  2903.   Fld: TField;
  2904.   Column: TColumn;
  2905.   SeenPassthrough: Boolean;
  2906.   RestoreCanvas: Boolean;
  2907.   M: TMsg;
  2908.  
  2909.   function FieldIsMapped(F: TField): Boolean;
  2910.   var
  2911.     X: Integer;
  2912.   begin
  2913.     Result := False;
  2914.     if F = nil then Exit;
  2915.     for X := 0 to FDatalink.FieldCount-1 do
  2916.       if FDatalink.Fields[X] = F then
  2917.       begin
  2918.         Result := True;
  2919.         Exit;
  2920.       end;
  2921.   end;
  2922.  
  2923. begin
  2924.   if (csLoading in ComponentState) then Exit;
  2925.  
  2926.   if HandleAllocated then
  2927.     PeekMessage(M, Handle, cm_DeferLayout, cm_DeferLayout, pm_Remove or pm_NoYield);
  2928.  
  2929.   { Check for Columns.State flip-flop }
  2930.   SeenPassthrough := False;
  2931.   for I := 0 to FColumns.Count-1 do
  2932.   begin
  2933.     if (FColumns[I] is TPassthroughColumn) then
  2934.       SeenPassthrough := True
  2935.     else
  2936.       if SeenPassthrough then
  2937.       begin   { We have both custom and passthrough columns. Kill the latter }
  2938.         for J := FColumns.Count-1 downto 0 do
  2939.         begin
  2940.           Column := FColumns[J];
  2941.           if Column is TPassthroughColumn then
  2942.             Column.Free;
  2943.         end;
  2944.         Break;
  2945.       end;
  2946.   end;
  2947.  
  2948.   FIndicatorOffset := 0;
  2949.   if dgIndicator in Options then
  2950.     Inc(FIndicatorOffset);
  2951.   FDatalink.ClearMapping;
  2952.   if FDatalink.Active then DefineFieldMap;
  2953.   if FColumns.State = csDefault then
  2954.   begin
  2955.      { Destroy columns whose fields have been destroyed or are no longer
  2956.        in field map }
  2957.     if (not FDataLink.Active) and (FDatalink.DefaultFields) then
  2958.       FColumns.Clear
  2959.     else
  2960.       for J := FColumns.Count-1 downto 0 do
  2961.         with FColumns[J] do
  2962.         if not Assigned(Field)
  2963.           or not FieldIsMapped(Field) then Free;
  2964.     I := FDataLink.FieldCount;
  2965.     if (I = 0) and (FColumns.Count = 0) then Inc(I);
  2966.     for J := 0 to I-1 do
  2967.     begin
  2968.       Fld := FDatalink.Fields[J];
  2969.       if Assigned(Fld) then
  2970.       begin
  2971.         K := J;
  2972.          { Pointer compare is valid here because the grid sets matching
  2973.            column.field properties to nil in response to field object
  2974.            free notifications.  Closing a dataset that has only default
  2975.            field objects will destroy all the fields and set associated
  2976.            column.field props to nil. }
  2977.         while (K < FColumns.Count) and (FColumns[K].Field <> Fld) do
  2978.           Inc(K);
  2979.         if K < FColumns.Count then
  2980.           Column := FColumns[K]
  2981.         else
  2982.         begin
  2983.           Column := TPassthroughColumn.Create(FColumns);
  2984.           Column.Field := Fld;
  2985.         end;
  2986.       end
  2987.       else
  2988.         Column := TPassthroughColumn.Create(FColumns);
  2989.       Column.Index := J;
  2990.     end;
  2991.   end
  2992.   else
  2993.   begin
  2994.     { Force columns to reaquire fields (in case dataset has changed) }
  2995.     for I := 0 to FColumns.Count-1 do
  2996.       FColumns[I].Field := nil;
  2997.   end;
  2998.   ColCount := FColumns.Count + FIndicatorOffset;
  2999.   inherited FixedCols := FIndicatorOffset;
  3000.   FTitleOffset := 0;
  3001.   if dgTitles in Options then FTitleOffset := 1;
  3002.   RestoreCanvas := not HandleAllocated;
  3003.   if RestoreCanvas then
  3004.     Canvas.Handle := GetDC(0);
  3005.   try
  3006.     Canvas.Font := Font;
  3007.     K := Canvas.TextHeight('Wg') + 3;
  3008.     if dgRowLines in Options then
  3009.       Inc(K, GridLineWidth);
  3010.     DefaultRowHeight := K;
  3011.     if dgTitles in Options then
  3012.     begin
  3013.       K := 0;
  3014.       for I := 0 to FColumns.Count-1 do
  3015.       begin
  3016.         Canvas.Font := FColumns[I].Title.Font;
  3017.         J := Canvas.TextHeight('Wg') + 4;
  3018.         if J > K then K := J;
  3019.       end;
  3020.       if K = 0 then
  3021.       begin
  3022.         Canvas.Font := FTitleFont;
  3023.         K := Canvas.TextHeight('Wg') + 4;
  3024.       end;
  3025.       RowHeights[0] := K;
  3026.     end;
  3027.   finally
  3028.     if RestoreCanvas then
  3029.     begin
  3030.       ReleaseDC(0,Canvas.Handle);
  3031.       Canvas.Handle := 0;
  3032.     end;
  3033.   end;
  3034.   UpdateRowCount;
  3035.   SetColumnAttributes;
  3036.   UpdateActive;
  3037.   Invalidate;
  3038. end;
  3039.  
  3040. procedure TCustomDBGrid.LayoutChanged;
  3041. begin
  3042.   if AcquireLayoutLock then
  3043.     EndLayout;
  3044. end;
  3045.  
  3046. procedure TCustomDBGrid.LinkActive(Value: Boolean);
  3047. begin
  3048.   if not Value then HideEditor;
  3049.   FBookmarks.LinkActive(Value);
  3050.   LayoutChanged;
  3051.   UpdateScrollBar;
  3052.   if Value and (dgAlwaysShowEditor in Options) then ShowEditor;
  3053. end;
  3054.  
  3055. procedure TCustomDBGrid.Loaded;
  3056. begin
  3057.   inherited Loaded;
  3058.   if FColumns.Count > 0 then
  3059.     ColCount := FColumns.Count;
  3060.   LayoutChanged;
  3061. end;
  3062.  
  3063. procedure TCustomDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  3064.   X, Y: Integer);
  3065. var
  3066.   Cell: TGridCoord;
  3067.   OldCol,OldRow: Integer;
  3068. begin
  3069.   if not AcquireFocus then Exit;
  3070.   if (ssDouble in Shift) and (Button = mbLeft) then
  3071.   begin
  3072.     DblClick;
  3073.     Exit;
  3074.   end;
  3075.   if Sizing(X, Y) then
  3076.   begin
  3077.     FDatalink.UpdateData;
  3078.     inherited MouseDown(Button, Shift, X, Y)
  3079.   end
  3080.   else
  3081.   begin
  3082.     Cell := MouseCoord(X, Y);
  3083.     if ((csDesigning in ComponentState) or (dgColumnResize in Options)) and
  3084.       (Cell.Y < FTitleOffset) then
  3085.     begin
  3086.       FDataLink.UpdateData;
  3087.       inherited MouseDown(Button, Shift, X, Y)
  3088.     end
  3089.     else
  3090.       if FDatalink.Active then
  3091.         with Cell do
  3092.         begin
  3093.           BeginUpdate;   { eliminates highlight flicker when selection moves }
  3094.           try
  3095.             HideEditor;
  3096.             OldCol := Col;
  3097.             OldRow := Row;
  3098.             if (Y >= FTitleOffset) and (Y - Row <> 0) then
  3099.               FDatalink.Dataset.MoveBy(Y - Row);
  3100.             if X >= FIndicatorOffset then
  3101.               MoveCol(X);
  3102.             if (dgMultiSelect in Options) and FDatalink.Active then
  3103.             with FBookmarks do
  3104.             begin
  3105.               FSelecting := False;
  3106.               if ssCtrl in Shift then
  3107.                 CurrentRowSelected := not CurrentRowSelected
  3108.               else
  3109.               begin
  3110.                 Clear;
  3111.                 CurrentRowSelected := True;
  3112.               end;
  3113.             end;
  3114.             if ((X = OldCol) and (Y = OldRow)) or (dgAlwaysShowEditor in Options) then
  3115.               ShowEditor         { put grid in edit mode }
  3116.             else
  3117.               InvalidateEditor;  { draw editor, if needed }
  3118.           finally
  3119.             EndUpdate;
  3120.           end;
  3121.         end;
  3122.   end;
  3123. end;
  3124.  
  3125. procedure TCustomDBGrid.MoveCol(RawCol: Integer);
  3126. var
  3127.   OldCol: Integer;
  3128. begin
  3129.   FDatalink.UpdateData;
  3130.   if RawCol >= ColCount then
  3131.     RawCol := ColCount - 1;
  3132.   if RawCol < FIndicatorOffset then RawCol := FIndicatorOffset;
  3133.   OldCol := Col;
  3134.   if RawCol <> OldCol then
  3135.   begin
  3136.     if not FInColExit then
  3137.     begin
  3138.       FInColExit := True;
  3139.       try
  3140.         ColExit;
  3141.       finally
  3142.         FInColExit := False;
  3143.       end;
  3144.       if Col <> OldCol then Exit;
  3145.     end;
  3146.     if not (dgAlwaysShowEditor in Options) then HideEditor;
  3147.     Col := RawCol;
  3148.     ColEnter;
  3149.   end;
  3150. end;
  3151.  
  3152. procedure TCustomDBGrid.Notification(AComponent: TComponent;
  3153.   Operation: TOperation);
  3154. var
  3155.   I: Integer;
  3156.   NeedLayout: Boolean;
  3157. begin
  3158.   inherited Notification(AComponent, Operation);
  3159.   if (Operation = opRemove) and (FDataLink <> nil) then
  3160.     if (AComponent = DataSource)  then
  3161.       DataSource := nil
  3162.     else if (AComponent is TField) then
  3163.     begin
  3164.       NeedLayout := False;
  3165.       BeginLayout;
  3166.       try
  3167.         for I := 0 to Columns.Count-1 do
  3168.           with Columns[I] do
  3169.             if Field = AComponent then
  3170.             begin
  3171.               Field := nil;
  3172.               NeedLayout := True;
  3173.             end;
  3174.       finally
  3175.         if NeedLayout and Assigned(FDatalink.Dataset)
  3176.           and not FDatalink.Dataset.ControlsDisabled then
  3177.           EndLayout
  3178.         else
  3179.           DeferLayout;
  3180.       end;
  3181.     end;
  3182. end;
  3183.  
  3184. procedure TCustomDBGrid.RecordChanged(Field: TField);
  3185. var
  3186.   I: Integer;
  3187.   CField: TField;
  3188. begin
  3189.   if not HandleAllocated then Exit;
  3190.   if Field = nil then
  3191.     Invalidate
  3192.   else
  3193.   begin
  3194.     for I := 0 to Columns.Count - 1 do
  3195.       if Columns[I].Field = Field then
  3196.         InvalidateCol(DataToRawColumn(I));
  3197.   end;
  3198.   CField := SelectedField;
  3199.   if ((Field = nil) or (CField = Field)) and
  3200.     (Assigned(CField) and (CField.Text <> FEditText)) then
  3201.   begin
  3202.     InvalidateEditor;
  3203.     if InplaceEditor <> nil then InplaceEditor.Deselect;
  3204.   end;
  3205. end;
  3206.  
  3207. procedure TCustomDBGrid.Scroll(Distance: Integer);
  3208. var
  3209.   OldRect, NewRect: TRect;
  3210.   RowHeight: Integer;
  3211. begin
  3212.   OldRect := BoxRect(0, Row, ColCount - 1, Row);
  3213.   UpdateScrollBar;
  3214.   UpdateActive;
  3215.   NewRect := BoxRect(0, Row, ColCount - 1, Row);
  3216.   ValidateRect(Handle, @OldRect);
  3217.   InvalidateRect(Handle, @OldRect, False);
  3218.   InvalidateRect(Handle, @NewRect, False);
  3219.   if Distance <> 0 then
  3220.   begin
  3221.     HideEditor;
  3222.     try
  3223.       if Abs(Distance) > VisibleRowCount then
  3224.       begin
  3225.         Invalidate;
  3226.         Exit;
  3227.       end
  3228.       else
  3229.       begin
  3230.         RowHeight := DefaultRowHeight;
  3231.         if dgRowLines in Options then Inc(RowHeight, GridLineWidth);
  3232.         NewRect := BoxRect(FIndicatorOffset, FTitleOffset, ColCount - 1, 1000);
  3233.         ScrollWindowEx(Handle, 0, -RowHeight * Distance, @NewRect, @NewRect,
  3234.           0, nil, SW_Invalidate);
  3235.         if dgIndicator in Options then
  3236.         begin
  3237.           OldRect := BoxRect(0, FSelRow, ColCount - 1, FSelRow);
  3238.           InvalidateRect(Handle, @OldRect, False);
  3239.           NewRect := BoxRect(0, Row, ColCount - 1, Row);
  3240.           InvalidateRect(Handle, @NewRect, False);
  3241.         end;
  3242.       end;
  3243.     finally
  3244.       if dgAlwaysShowEditor in Options then ShowEditor;
  3245.     end;
  3246.   end;
  3247.   if UpdateLock = 0 then Update;
  3248. end;
  3249.  
  3250. procedure TCustomDBGrid.SetColumns(Value: TDBGridColumns);
  3251. begin
  3252.   Columns.Assign(Value);
  3253. end;
  3254.  
  3255. function ReadOnlyField(Field: TField): Boolean;
  3256. var
  3257.   MasterField: TField;
  3258. begin
  3259.   Result := Field.ReadOnly;
  3260.   if not Result and Field.Lookup then
  3261.   begin
  3262.     Result := True;
  3263.     if Field.DataSet = nil then Exit;
  3264.     MasterField := Field.Dataset.FindField(Field.KeyFields);
  3265.     if MasterField = nil then Exit;
  3266.     Result := MasterField.ReadOnly;
  3267.   end;
  3268. end;
  3269.  
  3270. procedure TCustomDBGrid.SetColumnAttributes;
  3271. var
  3272.   I: Integer;
  3273. begin
  3274.   for I := 0 to FColumns.Count-1 do
  3275.   with FColumns[I] do
  3276.   begin
  3277.     TabStops[I + FIndicatorOffset] := not ReadOnly and DataLink.Active and
  3278.       Assigned(Field) and not Field.Calculated and not ReadOnlyField(Field);
  3279.     ColWidths[I + FIndicatorOffset] := Width;
  3280.   end;
  3281.   if (dgIndicator in Options) then
  3282.     ColWidths[0] := IndicatorWidth;
  3283. end;
  3284.  
  3285. procedure TCustomDBGrid.SetDataSource(Value: TDataSource);
  3286. begin
  3287.   if Value = FDatalink.Datasource then Exit;
  3288.   FBookmarks.Clear;
  3289.   FDataLink.DataSource := Value;
  3290.   if Value <> nil then Value.FreeNotification(Self);
  3291.   LinkActive(FDataLink.Active);
  3292. end;
  3293.  
  3294. procedure TCustomDBGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  3295. begin
  3296.   FEditText := Value;
  3297. end;
  3298.  
  3299. procedure TCustomDBGrid.SetOptions(Value: TDBGridOptions);
  3300. const
  3301.   LayoutOptions = [dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
  3302.     dgColLines, dgRowLines, dgRowSelect, dgAlwaysShowSelection];
  3303. var
  3304.   NewGridOptions: TGridOptions;
  3305.   ChangedOptions: TDBGridOptions;
  3306. begin
  3307.   if FOptions <> Value then
  3308.   begin
  3309.     NewGridOptions := [];
  3310.     if dgColLines in Value then
  3311.       NewGridOptions := NewGridOptions + [goFixedVertLine, goVertLine];
  3312.     if dgRowLines in Value then
  3313.       NewGridOptions := NewGridOptions + [goFixedHorzLine, goHorzLine];
  3314.     if dgColumnResize in Value then
  3315.       NewGridOptions := NewGridOptions + [goColSizing, goColMoving];
  3316.     if dgTabs in Value then Include(NewGridOptions, goTabs);
  3317.     if dgRowSelect in Value then
  3318.     begin
  3319.       Include(NewGridOptions, goRowSelect);
  3320.       Exclude(Value, dgAlwaysShowEditor);
  3321.       Exclude(Value, dgEditing);
  3322.     end;
  3323.     if dgEditing in Value then Include(NewGridOptions, goEditing);
  3324.     if dgAlwaysShowEditor in Value then Include(NewGridOptions, goAlwaysShowEditor);
  3325.     inherited Options := NewGridOptions;
  3326.     if dgMultiSelect in (FOptions - Value) then FBookmarks.Clear;
  3327.     ChangedOptions := (FOptions + Value) - (FOptions * Value);
  3328.     FOptions := Value;
  3329.     if ChangedOptions * LayoutOptions <> [] then LayoutChanged;
  3330.   end;
  3331. end;
  3332.  
  3333. procedure TCustomDBGrid.SetSelectedField(Value: TField);
  3334. var
  3335.   I: Integer;
  3336. begin
  3337.   if Value = nil then Exit;
  3338.   for I := 0 to Columns.Count - 1 do
  3339.     if Columns[I].Field = Value then
  3340.       MoveCol(DataToRawColumn(I));
  3341. end;
  3342.  
  3343. procedure TCustomDBGrid.SetSelectedIndex(Value: Integer);
  3344. begin
  3345.   MoveCol(DataToRawColumn(Value));
  3346. end;
  3347.  
  3348. procedure TCustomDBGrid.SetTitleFont(Value: TFont);
  3349. begin
  3350.   FTitleFont.Assign(Value);
  3351.   if dgTitles in Options then LayoutChanged;
  3352. end;
  3353.  
  3354. function TCustomDBGrid.StoreColumns: Boolean;
  3355. begin
  3356.   Result := Columns.State = csCustomized;
  3357. end;
  3358.  
  3359. procedure TCustomDBGrid.TimedScroll(Direction: TGridScrollDirection);
  3360. begin
  3361.   if FDatalink.Active then
  3362.   begin
  3363.     with FDatalink do
  3364.     begin
  3365.       if sdUp in Direction then
  3366.       begin
  3367.         DataSet.MoveBy(-ActiveRecord - 1);
  3368.         Exclude(Direction, sdUp);
  3369.       end;
  3370.       if sdDown in Direction then
  3371.       begin
  3372.         DataSet.MoveBy(RecordCount - ActiveRecord);
  3373.         Exclude(Direction, sdDown);
  3374.       end;
  3375.     end;
  3376.     if Direction <> [] then inherited TimedScroll(Direction);
  3377.   end;
  3378. end;
  3379.  
  3380. procedure TCustomDBGrid.TitleFontChanged(Sender: TObject);
  3381. begin
  3382.   if (not FSelfChangingTitleFont) and not (csLoading in ComponentState) then
  3383.     ParentFont := False;
  3384.   if dgTitles in Options then LayoutChanged;
  3385. end;
  3386.  
  3387. procedure TCustomDBGrid.UpdateActive;
  3388. var
  3389.   NewRow: Integer;
  3390.   Field: TField;
  3391. begin
  3392.   if FDatalink.Active and HandleAllocated and not (csLoading in ComponentState) then
  3393.   begin
  3394.     NewRow := FDatalink.ActiveRecord + FTitleOffset;
  3395.     if Row <> NewRow then
  3396.     begin
  3397.       if not (dgAlwaysShowEditor in Options) then HideEditor;
  3398.       MoveColRow(Col, NewRow, False, False);
  3399.       InvalidateEditor;
  3400.     end;
  3401.     Field := SelectedField;
  3402.     if Assigned(Field) and (Field.Text <> FEditText) then
  3403.       InvalidateEditor;
  3404.   end;
  3405. end;
  3406.  
  3407. procedure TCustomDBGrid.UpdateData;
  3408. var
  3409.   Field: TField;
  3410. begin
  3411.   Field := SelectedField;
  3412.   if Assigned(Field) then
  3413.     Field.Text := FEditText;
  3414. end;
  3415.  
  3416. procedure TCustomDBGrid.UpdateRowCount;
  3417. begin
  3418.   if RowCount <= FTitleOffset then RowCount := FTitleOffset + 1;
  3419.   FixedRows := FTitleOffset;
  3420.   with FDataLink do
  3421.     if not Active or (RecordCount = 0) or not HandleAllocated then
  3422.       RowCount := 1 + FTitleOffset
  3423.     else
  3424.     begin
  3425.       RowCount := 1000;
  3426.       FDataLink.BufferCount := VisibleRowCount;
  3427.       RowCount := RecordCount + FTitleOffset;
  3428.       UpdateActive;
  3429.     end;
  3430. end;
  3431.  
  3432. procedure TCustomDBGrid.UpdateScrollBar;
  3433. var
  3434.   Pos: Integer;
  3435. begin
  3436.   if FDatalink.Active and HandleAllocated then
  3437.     with FDatalink.DataSet do
  3438.     begin
  3439.       SetScrollRange(Self.Handle, SB_VERT, 0, 4, False);
  3440.       if BOF then Pos := 0
  3441.       else if EOF then Pos := 4
  3442.       else Pos := 2;
  3443.       if GetScrollPos(Self.Handle, SB_VERT) <> Pos then
  3444.         SetScrollPos(Self.Handle, SB_VERT, Pos, True);
  3445.     end;
  3446. end;
  3447.  
  3448. function TCustomDBGrid.ValidFieldIndex(FieldIndex: Integer): Boolean;
  3449. begin
  3450.   Result := DataLink.GetMappedIndex(FieldIndex) >= 0;
  3451. end;
  3452.  
  3453. procedure TCustomDBGrid.CMParentFontChanged(var Message: TMessage);
  3454. begin
  3455.   inherited;
  3456.   if ParentFont then
  3457.   begin
  3458.     FSelfChangingTitleFont := True;
  3459.     try
  3460.       TitleFont := Font;
  3461.     finally
  3462.       FSelfChangingTitleFont := False;
  3463.     end;
  3464.     LayoutChanged;
  3465.   end;
  3466. end;
  3467.  
  3468. procedure TCustomDBGrid.CMExit(var Message: TMessage);
  3469. begin
  3470.   try
  3471.     if FDatalink.Active then
  3472.       with FDatalink.Dataset do
  3473.         if (dgCancelOnExit in Options) and (State = dsInsert) and
  3474.           not Modified and not FDatalink.FModified then
  3475.           Cancel else
  3476.           FDataLink.UpdateData;
  3477.   except
  3478.     SetFocus;
  3479.     raise;
  3480.   end;
  3481.   inherited;
  3482. end;
  3483.  
  3484. procedure TCustomDBGrid.CMFontChanged(var Message: TMessage);
  3485. var
  3486.   I: Integer;
  3487. begin
  3488.   inherited;
  3489.   BeginLayout;
  3490.   try
  3491.     for I := 0 to Columns.Count-1 do
  3492.       Columns[I].RefreshDefaultFont;
  3493.   finally
  3494.     EndLayout;
  3495.   end;
  3496. end;
  3497.  
  3498. procedure TCustomDBGrid.CMDeferLayout(var Message);
  3499. begin
  3500.   if AcquireLayoutLock then
  3501.     EndLayout
  3502.   else
  3503.     DeferLayout;
  3504. end;
  3505.  
  3506. procedure TCustomDBGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  3507. begin
  3508.   inherited;
  3509.   if Msg.Result = 0 then
  3510.     with MouseCoord(Msg.Pos.X, Msg.Pos.Y) do
  3511.       if (X >= FIndicatorOffset) and (Y < FTitleOffset) then Msg.Result := 1;
  3512.   if (Msg.Result = 1) and ((FDataLink = nil) or
  3513.     ((Columns.State = csDefault) and
  3514.      (FDataLink.DefaultFields or (not FDataLink.Active)))) then
  3515.     Msg.Result := 0;
  3516. end;
  3517.  
  3518. procedure TCustomDBGrid.WMSetCursor(var Msg: TWMSetCursor);
  3519. begin
  3520.   if (csDesigning in ComponentState) and ((FDataLink = nil) or
  3521.     ((Columns.State = csDefault) and
  3522.      (FDataLink.DefaultFields or (not FDataLink.Active)))) then
  3523.     Windows.SetCursor(LoadCursor(0, IDC_ARROW))
  3524.   else inherited;
  3525. end;
  3526.  
  3527. procedure TCustomDBGrid.WMSize(var Message: TWMSize);
  3528. begin
  3529.   inherited;
  3530.   if UpdateLock = 0 then UpdateRowCount;
  3531. end;
  3532.  
  3533. procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll);
  3534. begin
  3535.   if not AcquireFocus then Exit;
  3536.   if FDatalink.Active then
  3537.     with Message, FDataLink.DataSet, FDatalink do
  3538.       case ScrollCode of
  3539.         SB_LINEUP: MoveBy(-ActiveRecord - 1);
  3540.         SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord);
  3541.         SB_PAGEUP: MoveBy(-VisibleRowCount);
  3542.         SB_PAGEDOWN: MoveBy(VisibleRowCount);
  3543.         SB_THUMBPOSITION:
  3544.           begin
  3545.             case Pos of
  3546.               0: First;
  3547.               1: MoveBy(-VisibleRowCount);
  3548.               2: Exit;
  3549.               3: MoveBy(VisibleRowCount);
  3550.               4: Last;
  3551.             end;
  3552.           end;
  3553.         SB_BOTTOM: Last;
  3554.         SB_TOP: First;
  3555.       end;
  3556. end;
  3557.  
  3558. end.
  3559.