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