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