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