home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / Rxdbctrl.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  109KB  |  3,811 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit RXDBCtrl;
  11.  
  12. {$I RX.INC}
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Registry, Variants,
  19.   Messages, Classes, Controls, Forms, Grids, Graphics, Buttons, Menus,
  20.   StdCtrls, Mask, IniFiles, ToolEdit, DB, DBGrids, 
  21.   {$IFNDEF RX_D3} DBTables, {$ENDIF}
  22.   Placemnt, DateUtil, DBCtrls, RxCtrls, CurrEdit;
  23.  
  24. { TRxDBGrid }
  25.  
  26. const
  27.   DefRxGridOptions = [dgEditing, dgTitles, dgIndicator, dgColumnResize,
  28.     dgColLines, dgRowLines, dgConfirmDelete, dgCancelOnExit];
  29.  
  30. {$IFDEF RX_V110}
  31.  {$IFDEF CBUILDER}
  32.   {$NODEFINE DefRxGridOptions}
  33.  {$ENDIF}
  34. {$ENDIF}
  35.  
  36. type
  37.   TTitleClickEvent = procedure (Sender: TObject; ACol: Longint;
  38.     Field: TField) of object;
  39.   TCheckTitleBtnEvent = procedure (Sender: TObject; ACol: Longint;
  40.     Field: TField; var Enabled: Boolean) of object;
  41.   TGetCellParamsEvent = procedure (Sender: TObject; Field: TField;
  42.     AFont: TFont; var Background: TColor; Highlight: Boolean) of object;
  43.   TSortMarker = (smNone, smDown, smUp);
  44.   TGetBtnParamsEvent = procedure (Sender: TObject; Field: TField;
  45.     AFont: TFont; var Background: TColor; var SortMarker: TSortMarker;
  46.     IsDown: Boolean) of object;
  47.   TGetCellPropsEvent = procedure (Sender: TObject; Field: TField;
  48.     AFont: TFont; var Background: TColor) of object; { obsolete }
  49.   TDBEditShowEvent = procedure (Sender: TObject; Field: TField;
  50.     var AllowEdit: Boolean) of object;
  51.  
  52. {$IFNDEF WIN32}
  53.   TBookmarkList = class
  54.   private
  55.     FList: THugeList;
  56.     FGrid: TCustomDBGrid;
  57.     FCache: TBookmark;
  58.     FCacheIndex: Longint;
  59.     FCacheFind: Boolean;
  60.     FLinkActive: Boolean;
  61.     function GetCount: Longint;
  62.     function GetCurrentRowSelected: Boolean;
  63.     function GetItem(Index: Longint): TBookmark;
  64.     procedure SetCurrentRowSelected(Value: Boolean);
  65.     procedure ListChanged;
  66.   protected
  67.     function CurrentRow: TBookmark;
  68.     function Compare(const Item1, Item2: TBookmark): Longint;
  69.     procedure LinkActive(Value: Boolean);
  70.   public
  71.     constructor Create(AGrid: TCustomDBGrid);
  72.     destructor Destroy; override;
  73.     procedure Clear;  { free all bookmarks }
  74.     procedure Delete; { delete all selected rows from dataset }
  75.     function Find(const Item: TBookmark; var Index: Longint): Boolean;
  76.     function IndexOf(const Item: TBookmark): Longint;
  77.     function Refresh: Boolean; { drop orphaned bookmarks; True = orphans found }
  78.     property Count: Longint read GetCount;
  79.     property CurrentRowSelected: Boolean read GetCurrentRowSelected
  80.       write SetCurrentRowSelected;
  81.     property Items[Index: Longint]: TBookmark read GetItem; default;
  82.   end;
  83. {$ENDIF}
  84.  
  85.   TRxDBGrid = class(TDBGrid)
  86.   private
  87.     FShowGlyphs: Boolean;
  88.     FDefaultDrawing: Boolean;
  89.     FMultiSelect: Boolean;
  90.     FSelecting: Boolean;
  91.     FClearSelection: Boolean;
  92.     FTitleButtons: Boolean;
  93. {$IFDEF WIN32}
  94.     FPressedCol: TColumn;
  95. {$ELSE}
  96.     FPressedCol: Longint;
  97. {$ENDIF}
  98.     FPressed: Boolean;
  99.     FTracking: Boolean;
  100.     FSwapButtons: Boolean;
  101.     FIniLink: TIniLink;
  102.     FDisableCount: Integer;
  103.     FFixedCols: Integer;
  104.     FMsIndicators: TImageList;
  105.     FOnCheckButton: TCheckTitleBtnEvent;
  106.     FOnGetCellProps: TGetCellPropsEvent;
  107.     FOnGetCellParams: TGetCellParamsEvent;
  108.     FOnGetBtnParams: TGetBtnParamsEvent;
  109.     FOnEditChange: TNotifyEvent;
  110.     FOnKeyPress: TKeyPressEvent;
  111.     FOnTitleBtnClick: TTitleClickEvent;
  112.     FOnShowEditor: TDbEditShowEvent;
  113.     FOnTopLeftChanged: TNotifyEvent;
  114. {$IFDEF WIN32}
  115.     FSelectionAnchor: TBookmarkStr;
  116. {$ELSE}
  117.     FSelectionAnchor: TBookmark;
  118.     FBookmarks: TBookmarkList;
  119.     FOnColumnMoved: TMovedEvent;
  120. {$ENDIF}
  121.     function GetImageIndex(Field: TField): Integer;
  122.     procedure SetShowGlyphs(Value: Boolean);
  123.     procedure SetRowsHeight(Value: Integer);
  124.     function GetRowsHeight: Integer;
  125.     function GetStorage: TFormPlacement;
  126.     procedure SetStorage(Value: TFormPlacement);
  127.     procedure IniSave(Sender: TObject);
  128.     procedure IniLoad(Sender: TObject);
  129.     procedure SetMultiSelect(Value: Boolean);
  130.     procedure SetTitleButtons(Value: Boolean);
  131.     procedure StopTracking;
  132.     procedure TrackButton(X, Y: Integer);
  133.     function ActiveRowSelected: Boolean;
  134.     function GetSelCount: Longint;
  135.     procedure InternalSaveLayout(IniFile: TObject; const Section: string);
  136.     procedure InternalRestoreLayout(IniFile: TObject; const Section: string);
  137. {$IFDEF WIN32}
  138.     procedure SaveColumnsLayout(IniFile: TObject; const Section: string);
  139.     procedure RestoreColumnsLayout(IniFile: TObject; const Section: string);
  140.     function GetOptions: TDBGridOptions;
  141.     procedure SetOptions(Value: TDBGridOptions);
  142.     function GetMasterColumn(ACol, ARow: Longint): TColumn;
  143. {$ELSE}
  144.     function GetFixedColor: TColor;
  145.     procedure SetFixedColor(Value: TColor);
  146.     function GetIndicatorOffset: Byte;
  147. {$ENDIF}
  148.     function GetTitleOffset: Byte;
  149.     procedure SetFixedCols(Value: Integer);
  150.     function GetFixedCols: Integer;
  151. {$IFDEF RX_D4}
  152.     function CalcLeftColumn: Integer;
  153. {$ENDIF}
  154.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  155.     procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
  156. {$IFDEF WIN32}
  157.     procedure WMRButtonUp(var Message: TWMMouse); message WM_RBUTTONUP;
  158. {$ENDIF}
  159.   protected
  160.     function AcquireFocus: Boolean;
  161.     function CanEditShow: Boolean; override;
  162.     function CreateEditor: TInplaceEdit; override;
  163.     procedure DoTitleClick(ACol: Longint; AField: TField); dynamic;
  164.     procedure CheckTitleButton(ACol, ARow: Longint; var Enabled: Boolean); dynamic;
  165.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  166.     procedure DrawDataCell(const Rect: TRect; Field: TField;
  167.       State: TGridDrawState); override; { obsolete from Delphi 2.0 }
  168.     procedure EditChanged(Sender: TObject); dynamic;
  169.     procedure GetCellProps(Field: TField; AFont: TFont; var Background: TColor;
  170.       Highlight: Boolean); dynamic;
  171.     function HighlightCell(DataCol, DataRow: Integer; const Value: string;
  172.       AState: TGridDrawState): Boolean; override;
  173.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  174.     procedure KeyPress(var Key: Char); override;
  175.     procedure SetColumnAttributes; override;
  176.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  177.       X, Y: Integer); override;
  178.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  179.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  180.       X, Y: Integer); override;
  181. {$IFDEF RX_D4}
  182.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  183.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  184. {$ENDIF}
  185.     procedure Scroll(Distance: Integer); override;
  186.     procedure LayoutChanged; override;
  187.     procedure TopLeftChanged; override;
  188. {$IFDEF WIN32}
  189.     procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
  190.       Column: TColumn; State: TGridDrawState); override;
  191.     procedure ColWidthsChanged; override;
  192. {$ELSE}
  193.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  194.     procedure LinkActive(Value: Boolean); override;
  195. {$ENDIF}
  196.     procedure Paint; override;
  197.   public
  198.     constructor Create(AOwner: TComponent); override;
  199.     destructor Destroy; override;
  200.     procedure DefaultDataCellDraw(const Rect: TRect; Field: TField;
  201.       State: TGridDrawState);
  202.     procedure DisableScroll;
  203.     procedure EnableScroll;
  204.     function ScrollDisabled: Boolean;
  205.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  206.     procedure SaveLayout(IniFile: TIniFile);
  207.     procedure RestoreLayout(IniFile: TIniFile);
  208.     procedure SelectAll;
  209.     procedure UnselectAll;
  210.     procedure ToggleRowSelection;
  211.     procedure GotoSelection(Index: Longint);
  212. {$IFDEF WIN32}
  213.     procedure SaveLayoutReg(IniFile: TRegIniFile);
  214.     procedure RestoreLayoutReg(IniFile: TRegIniFile);
  215.     property SelectedRows;
  216. {$ELSE}
  217.     property SelectedRows: TBookmarkList read FBookmarks;
  218. {$ENDIF WIN32}
  219.     property SelCount: Longint read GetSelCount;
  220.     property Canvas;
  221.     property Col;
  222.     property InplaceEditor;
  223.     property LeftCol;
  224.     property Row;
  225.     property VisibleRowCount;
  226.     property VisibleColCount;
  227.     property IndicatorOffset {$IFNDEF WIN32}: Byte read GetIndicatorOffset {$ENDIF};
  228.     property TitleOffset: Byte read GetTitleOffset;
  229.   published
  230. {$IFDEF WIN32}
  231.     property Options: TDBGridOptions read GetOptions write SetOptions
  232.       default DefRxGridOptions;
  233. {$ELSE}
  234.     property FixedColor: TColor read GetFixedColor write SetFixedColor
  235.       default clBtnFace; { fix Delphi 1.0 bug }
  236.     property Options default DefRxGridOptions;
  237. {$ENDIF}
  238.     property FixedCols: Integer read GetFixedCols write SetFixedCols default 0;
  239.     property ClearSelection: Boolean read FClearSelection write FClearSelection
  240.       default True;
  241.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing
  242.       default True;
  243.     property IniStorage: TFormPlacement read GetStorage write SetStorage;
  244.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect
  245.       default False;
  246.     property ShowGlyphs: Boolean read FShowGlyphs write SetShowGlyphs
  247.       default True;
  248.     property TitleButtons: Boolean read FTitleButtons write SetTitleButtons
  249.       default False;
  250.     property RowsHeight: Integer read GetRowsHeight write SetRowsHeight
  251.       stored False; { obsolete, for backward compatibility only }
  252.     property OnCheckButton: TCheckTitleBtnEvent read FOnCheckButton write FOnCheckButton;
  253.     property OnGetCellProps: TGetCellPropsEvent read FOnGetCellProps
  254.       write FOnGetCellProps; { obsolete }
  255.     property OnGetCellParams: TGetCellParamsEvent read FOnGetCellParams write FOnGetCellParams;
  256.     property OnGetBtnParams: TGetBtnParamsEvent read FOnGetBtnParams write FOnGetBtnParams;
  257.     property OnEditChange: TNotifyEvent read FOnEditChange write FOnEditChange;
  258.     property OnShowEditor: TDBEditShowEvent read FOnShowEditor write FOnShowEditor;
  259.     property OnTitleBtnClick: TTitleClickEvent read FOnTitleBtnClick write FOnTitleBtnClick;
  260.     property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  261.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  262. {$IFNDEF WIN32}
  263.     property OnColumnMoved: TMovedEvent read FOnColumnMoved write FOnColumnMoved;
  264. {$ENDIF}
  265. {$IFDEF RX_D5}
  266.     property OnContextPopup;
  267. {$ENDIF}
  268.     property OnMouseDown;
  269.     property OnMouseMove;
  270.     property OnMouseUp;
  271. {$IFDEF RX_D4}
  272.     property OnMouseWheelDown;
  273.     property OnMouseWheelUp;
  274. {$ENDIF}
  275.   end;
  276.  
  277. { TRxDBComboEdit }
  278.  
  279.   TRxDBComboEdit = class(TCustomComboEdit)
  280.   private
  281.     FDataLink: TFieldDataLink;
  282. {$IFDEF WIN32}
  283.     FCanvas: TControlCanvas;
  284. {$ENDIF}
  285.     FFocused: Boolean;
  286.     procedure DataChange(Sender: TObject);
  287.     procedure EditingChange(Sender: TObject);
  288.     function GetDataField: string;
  289.     function GetDataSource: TDataSource;
  290.     function GetField: TField;
  291.     procedure SetDataField(const Value: string);
  292.     procedure SetDataSource(Value: TDataSource);
  293.     procedure SetFocused(Value: Boolean);
  294.     procedure SetReadOnly(Value: Boolean);
  295.     procedure UpdateData(Sender: TObject);
  296.     procedure WMCut(var Message: TMessage); message WM_CUT;
  297.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  298.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  299.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  300. {$IFDEF WIN32}
  301.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  302.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  303. {$ENDIF}
  304.   protected
  305.     procedure Change; override;
  306.     function EditCanModify: Boolean; override;
  307.     function GetReadOnly: Boolean; override;
  308.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  309.     procedure KeyPress(var Key: Char); override;
  310.     procedure Loaded; override;
  311.     procedure Notification(AComponent: TComponent;
  312.       Operation: TOperation); override;
  313.     procedure Reset; override;
  314.   public
  315.     constructor Create(AOwner: TComponent); override;
  316.     destructor Destroy; override;
  317. {$IFDEF RX_D4}
  318.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  319.     function UpdateAction(Action: TBasicAction): Boolean; override;
  320.     function UseRightToLeftAlignment: Boolean; override;
  321. {$ENDIF}
  322.     property Button;
  323.     property Field: TField read GetField;
  324.   published
  325.     property AutoSelect;
  326.     property BorderStyle;
  327.     property ButtonHint;
  328.     property CharCase;
  329.     property ClickKey;
  330.     property Color;
  331.     property Ctl3D;
  332.     property DataField: string read GetDataField write SetDataField;
  333.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  334.     property DirectInput;
  335.     property DragCursor;
  336.     property DragMode;
  337.     property Enabled;
  338.     property Font;
  339.     property GlyphKind;
  340.     { Ensure GlyphKind is published before Glyph and ButtonWidth }
  341.     property Glyph;
  342.     property ButtonWidth;
  343.     property HideSelection;
  344. {$IFDEF RX_D4}
  345.     property Anchors;
  346.     property BiDiMode;
  347.     property Constraints;
  348.     property DragKind;
  349.     property ParentBiDiMode;
  350. {$ENDIF}
  351. {$IFDEF WIN32}
  352.   {$IFNDEF VER90}
  353.     property ImeMode;
  354.     property ImeName;
  355.   {$ENDIF}
  356. {$ENDIF}
  357.     property MaxLength;
  358.     property NumGlyphs;
  359.     property ParentColor;
  360.     property ParentCtl3D;
  361.     property ParentFont;
  362.     property ParentShowHint;
  363.     property PopupMenu;
  364.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  365.     property ShowHint;
  366.     property TabOrder;
  367.     property TabStop;
  368.     property Visible;
  369.     property OnButtonClick;
  370.     property OnChange;
  371.     property OnClick;
  372.     property OnDblClick;
  373.     property OnDragDrop;
  374.     property OnDragOver;
  375.     property OnEndDrag;
  376.     property OnEnter;
  377.     property OnExit;
  378.     property OnKeyDown;
  379.     property OnKeyPress;
  380.     property OnKeyUp;
  381.     property OnMouseDown;
  382.     property OnMouseMove;
  383.     property OnMouseUp;
  384. {$IFDEF WIN32}
  385.     property OnStartDrag;
  386. {$ENDIF}
  387. {$IFDEF RX_D5}
  388.     property OnContextPopup;
  389. {$ENDIF}
  390. {$IFDEF RX_D4}
  391.     property OnEndDock;
  392.     property OnStartDock;
  393. {$ENDIF}
  394.   end;
  395.  
  396. { TDBDateEdit }
  397.  
  398.   TDBDateEdit = class(TCustomDateEdit)
  399.   private
  400.     FDataLink: TFieldDataLink;
  401. {$IFDEF WIN32}
  402.     FCanvas: TControlCanvas;
  403. {$ENDIF}
  404.     procedure DataChange(Sender: TObject);
  405.     procedure EditingChange(Sender: TObject);
  406.     function GetDataField: string;
  407.     function GetDataSource: TDataSource;
  408.     function GetField: TField;
  409.     procedure SetDataField(const Value: string);
  410.     procedure SetDataSource(Value: TDataSource);
  411.     procedure SetReadOnly(Value: Boolean);
  412.     procedure UpdateData(Sender: TObject);
  413.     procedure AfterPopup(Sender: TObject; var Date: TDateTime; var Action: Boolean);
  414.     procedure WMCut(var Message: TMessage); message WM_CUT;
  415.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  416.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  417.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  418. {$IFDEF WIN32}
  419.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  420.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  421. {$ENDIF}
  422.   protected
  423. {$IFDEF WIN32}
  424.     procedure AcceptValue(const Value: Variant); override;
  425. {$ENDIF}
  426.     procedure ApplyDate(Value: TDateTime); override;
  427.     function GetReadOnly: Boolean; override;
  428.     procedure Change; override;
  429.     function EditCanModify: Boolean; override;
  430.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  431.     procedure KeyPress(var Key: Char); override;
  432.     procedure Notification(AComponent: TComponent;
  433.       Operation: TOperation); override;
  434.     procedure Reset; override;
  435.   public
  436.     constructor Create(AOwner: TComponent); override;
  437.     destructor Destroy; override;
  438.     procedure UpdateMask; override;
  439. {$IFDEF RX_D4}
  440.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  441.     function UpdateAction(Action: TBasicAction): Boolean; override;
  442.     function UseRightToLeftAlignment: Boolean; override;
  443. {$ENDIF}
  444.     property Field: TField read GetField;
  445.   published
  446.     property CalendarHints;
  447.     property DataField: string read GetDataField write SetDataField;
  448.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  449.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  450.     property AutoSelect;
  451.     property BlanksChar;
  452.     property BorderStyle;
  453.     property ButtonHint;
  454.     property CheckOnExit;
  455.     property ClickKey;
  456.     property Color;
  457.     property Ctl3D;
  458.     property DefaultToday;
  459.     property DialogTitle;
  460.     property DirectInput;
  461.     property DragCursor;
  462.     property DragMode;
  463.     property Enabled;
  464.     property Font;
  465.     property GlyphKind;
  466.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  467.     property Glyph;
  468.     property ButtonWidth;
  469.     property HideSelection;
  470. {$IFDEF RX_D4}
  471.     property Anchors;
  472.     property BiDiMode;
  473.     property Constraints;
  474.     property DragKind;
  475.     property ParentBiDiMode;
  476. {$ENDIF}
  477. {$IFDEF WIN32}
  478.   {$IFNDEF VER90}
  479.     property ImeMode;
  480.     property ImeName;
  481.   {$ENDIF}
  482. {$ENDIF}
  483.     property MaxLength;
  484.     property NumGlyphs;
  485.     property ParentColor;
  486.     property ParentCtl3D;
  487.     property ParentFont;
  488.     property ParentShowHint;
  489.     property PopupAlign;
  490.     property PopupColor;
  491.     property PopupMenu;
  492.     property ShowHint;
  493.     property CalendarStyle;
  494.     property TabOrder;
  495.     property TabStop;
  496.     property StartOfWeek;
  497.     property Weekends;
  498.     property WeekendColor;
  499.     property YearDigits;
  500.     property Visible;
  501.     property OnButtonClick;
  502.     property OnChange;
  503.     property OnClick;
  504.     property OnDblClick;
  505.     property OnDragDrop;
  506.     property OnDragOver;
  507.     property OnEndDrag;
  508.     property OnEnter;
  509.     property OnExit;
  510.     property OnKeyDown;
  511.     property OnKeyPress;
  512.     property OnKeyUp;
  513.     property OnMouseDown;
  514.     property OnMouseMove;
  515.     property OnMouseUp;
  516. {$IFDEF WIN32}
  517.     property OnStartDrag;
  518. {$ENDIF}
  519. {$IFDEF RX_D5}
  520.     property OnContextPopup;
  521. {$ENDIF}
  522. {$IFDEF RX_D4}
  523.     property OnEndDock;
  524.     property OnStartDock;
  525. {$ENDIF}
  526.   end;
  527.  
  528. { TRxDBCalcEdit }
  529.  
  530.   TRxDBCalcEdit = class(TRxCustomCalcEdit)
  531.   private
  532.     FDataLink: TFieldDataLink;
  533.     FDefaultParams: Boolean;
  534.     procedure DataChange(Sender: TObject);
  535.     procedure EditingChange(Sender: TObject);
  536.     function GetDataField: string;
  537.     function GetDataSource: TDataSource;
  538.     function GetField: TField;
  539.     procedure SetDataField(const Value: string);
  540.     procedure SetDataSource(Value: TDataSource);
  541.     procedure SetDefaultParams(Value: Boolean);
  542.     procedure SetReadOnly(Value: Boolean);
  543.     procedure UpdateFieldData(Sender: TObject);
  544.     procedure WMCut(var Message: TMessage); message WM_CUT;
  545.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  546.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  547.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  548. {$IFDEF WIN32}
  549.     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  550. {$ENDIF}
  551.   protected
  552. {$IFDEF WIN32}
  553.     procedure AcceptValue(const Value: Variant); override;
  554.     function GetDisplayText: string; override;
  555. {$ENDIF}
  556.     function GetReadOnly: Boolean; override;
  557.     procedure Change; override;
  558.     function EditCanModify: Boolean; override;
  559.     function IsValidChar(Key: Char): Boolean; override;
  560.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  561.     procedure KeyPress(var Key: Char); override;
  562.     procedure Notification(AComponent: TComponent;
  563.       Operation: TOperation); override;
  564.     procedure Reset; override;
  565.     procedure UpdatePopup; override;
  566.   public
  567.     constructor Create(AOwner: TComponent); override;
  568.     destructor Destroy; override;
  569.     procedure UpdateFieldParams;
  570. {$IFDEF RX_D4}
  571.     function ExecuteAction(Action: TBasicAction): Boolean; override;
  572.     function UpdateAction(Action: TBasicAction): Boolean; override;
  573.     function UseRightToLeftAlignment: Boolean; override;
  574. {$ENDIF}
  575.     property Field: TField read GetField;
  576.     property Value;
  577.   published
  578.     property DataField: string read GetDataField write SetDataField;
  579.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  580.     property DefaultParams: Boolean read FDefaultParams write SetDefaultParams default False;
  581.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  582.     property Alignment;
  583.     property AutoSelect;
  584.     property BeepOnError;
  585.     property BorderStyle;
  586.     property ButtonHint;
  587.     property CheckOnExit;
  588.     property ClickKey;
  589.     property Color;
  590.     property Ctl3D;
  591.     property DecimalPlaces;
  592.     property DirectInput;
  593.     property DisplayFormat;
  594.     property DragCursor;
  595.     property DragMode;
  596.     property Enabled;
  597.     property Font;
  598.     property FormatOnEditing;
  599.     property GlyphKind;
  600.     { Ensure GlyphKind is declared before Glyph and ButtonWidth }
  601.     property Glyph;
  602.     property ButtonWidth;
  603.     property HideSelection;
  604. {$IFDEF RX_D4}
  605.     property Anchors;
  606.     property BiDiMode;
  607.     property Constraints;
  608.     property DragKind;
  609.     property ParentBiDiMode;
  610. {$ENDIF}
  611. {$IFDEF WIN32}
  612.   {$IFNDEF VER90}
  613.     property ImeMode;
  614.     property ImeName;
  615.   {$ENDIF}
  616. {$ENDIF}
  617.     property MaxLength;
  618.     property MaxValue;
  619.     property MinValue;
  620.     property NumGlyphs;
  621.     property ParentColor;
  622.     property ParentCtl3D;
  623.     property ParentFont;
  624.     property ParentShowHint;
  625.     property PopupAlign;
  626.     property PopupMenu;
  627.     property ShowHint;
  628.     property TabOrder;
  629.     property TabStop;
  630.     property Visible;
  631.     property ZeroEmpty;
  632.     property OnButtonClick;
  633.     property OnChange;
  634.     property OnClick;
  635.     property OnDblClick;
  636.     property OnDragDrop;
  637.     property OnDragOver;
  638.     property OnEndDrag;
  639.     property OnEnter;
  640.     property OnExit;
  641.     property OnKeyDown;
  642.     property OnKeyPress;
  643.     property OnKeyUp;
  644.     property OnMouseDown;
  645.     property OnMouseMove;
  646.     property OnMouseUp;
  647. {$IFDEF WIN32}
  648.     property OnStartDrag;
  649. {$ENDIF}
  650. {$IFDEF RX_D5}
  651.     property OnContextPopup;
  652. {$ENDIF}
  653. {$IFDEF RX_D4}
  654.     property OnEndDock;
  655.     property OnStartDock;
  656. {$ENDIF}
  657.   end;
  658.  
  659. { TDBStatusLabel }
  660.  
  661.   TGetStringEvent = function(Sender: TObject): string of object;
  662.   TDataValueEvent = procedure(Sender: TObject; DataSet: TDataSet;
  663.     var Value: Longint) of object;
  664.   TDBLabelStyle = (lsState, lsRecordNo, lsRecordSize);
  665.   TGlyphAlign = glGlyphLeft..glGlyphRight;
  666.   TDBStatusKind = dsInactive..dsCalcFields;
  667.   TDBLabelOptions = (doCaption, doGlyph, doBoth);
  668.  
  669.   TDBStatusLabel = class(TRxCustomLabel)
  670.   private
  671.     FDataLink: TDataLink;
  672.     FDataSetName: PString;
  673.     FStyle: TDBLabelStyle;
  674.     FEditColor: TColor;
  675.     FCalcCount: Boolean;
  676.     FCaptions: TStrings;
  677.     FGlyph: TBitmap;
  678.     FCell: TBitmap;
  679.     FGlyphAlign: TGlyphAlign;
  680.     FRecordCount: Longint;
  681.     FRecordNo: Longint;
  682.     FShowOptions: TDBLabelOptions;
  683.     FOnGetDataName: TGetStringEvent;
  684.     FOnGetRecNo: TDataValueEvent;
  685.     FOnGetRecordCount: TDataValueEvent;
  686.     function GetStatusKind(State: TDataSetState): TDBStatusKind;
  687.     procedure CaptionsChanged(Sender: TObject);
  688.     function GetDataSetName: string;
  689.     procedure SetDataSetName(Value: string);
  690.     function GetDataSource: TDataSource;
  691.     procedure SetDataSource(Value: TDataSource);
  692.     function GetDatasetState: TDataSetState;
  693.     procedure SetEditColor(Value: TColor);
  694.     procedure SetStyle(Value: TDBLabelStyle);
  695.     procedure SetShowOptions(Value: TDBLabelOptions);
  696.     procedure SetGlyphAlign(Value: TGlyphAlign);
  697.     procedure SetCaptions(Value: TStrings);
  698.     procedure SetCalcCount(Value: Boolean);
  699.   protected
  700.     procedure Loaded; override;
  701.     function GetDefaultFontColor: TColor; override;
  702.     function GetLabelCaption: string; override;
  703.     function GetCaption(State: TDataSetState): string; virtual;
  704.     procedure Notification(AComponent: TComponent;
  705.       Operation: TOperation); override;
  706.     procedure Paint; override;
  707.     procedure SetName(const Value: TComponentName); override;
  708.   public
  709.     constructor Create(AOwner: TComponent); override;
  710.     destructor Destroy; override;
  711.     procedure UpdateData; virtual;
  712.     procedure UpdateStatus; virtual;
  713.     property Caption;
  714.     property DatasetState: TDataSetState read GetDatasetState;
  715.   published
  716.     property DatasetName: string read GetDataSetName write SetDataSetName;
  717.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  718.     property EditColor: TColor read FEditColor write SetEditColor default clRed;
  719.     property Captions: TStrings read FCaptions write SetCaptions;
  720.     property Style: TDBLabelStyle read FStyle write SetStyle default lsState;
  721.     property CalcRecCount: Boolean read FCalcCount write SetCalcCount default False;
  722.     property ShowOptions: TDBLabelOptions read FShowOptions write SetShowOptions
  723.       default doCaption;
  724.     property GlyphAlign: TGlyphAlign read FGlyphAlign write SetGlyphAlign
  725.       default glGlyphLeft;
  726.     property Layout default tlCenter;
  727.     property ShadowSize default 0;
  728.     property Align;
  729.     property Alignment;
  730.     property AutoSize;
  731.     property Color;
  732.     property DragCursor;
  733.     property DragMode;
  734.     property Font;
  735. {$IFDEF RX_D4}
  736.     property Anchors;
  737.     property BiDiMode;
  738.     property Constraints;
  739.     property DragKind;
  740.     property ParentBiDiMode;
  741. {$ENDIF}
  742.     property ParentColor;
  743.     property ParentFont;
  744.     property ParentShowHint;
  745.     property PopupMenu;
  746.     property ShadowColor;
  747.     property ShadowPos;
  748.     property ShowHint;
  749.     property Transparent;
  750.     property Visible;
  751.     property WordWrap;
  752.     property OnGetDataName: TGetStringEvent read FOnGetDataName write FOnGetDataName;
  753.     property OnGetRecordCount: TDataValueEvent read FOnGetRecordCount
  754.       write FOnGetRecordCount;
  755.     property OnGetRecNo: TDataValueEvent read FOnGetRecNo write FOnGetRecNo;
  756.     property OnClick;
  757.     property OnDblClick;
  758.     property OnDragDrop;
  759.     property OnDragOver;
  760.     property OnEndDrag;
  761.     property OnMouseDown;
  762.     property OnMouseMove;
  763.     property OnMouseUp;
  764.     property OnMouseEnter;
  765.     property OnMouseLeave;
  766. {$IFDEF WIN32}
  767.     property OnStartDrag;
  768. {$ENDIF}
  769. {$IFDEF RX_D5}
  770.     property OnContextPopup;
  771. {$ENDIF}
  772. {$IFDEF RX_D4}
  773.     property OnEndDock;
  774.     property OnStartDock;
  775. {$ENDIF}
  776.   end;
  777.  
  778. implementation
  779.  
  780. uses SysUtils, rxStrUtils, Dialogs, ExtCtrls, DbConsts, AppUtils, VCLUtils,
  781.   DbUtils, {$IFNDEF RX_D3} BdeUtils, {$ENDIF} PickDate, RxCalc, MaxMin,
  782.   RxDConst;
  783.  
  784. {$IFDEF WIN32}
  785.   {$R *.R32}
  786. {$ELSE}
  787.   {$R *.R16}
  788. {$ENDIF}
  789.  
  790. type
  791.   TGridPicture = (gpBlob, gpMemo, gpPicture, gpOle, gpObject, gpData,
  792.     gpNotEmpty, gpMarkDown, gpMarkUp);
  793.  
  794. const
  795.   GridBmpNames: array[TGridPicture] of PChar =
  796.     ('DBG_BLOB', 'DBG_MEMO', 'DBG_PICT', 'DBG_OLE', 'DBG_OBJECT', 'DBG_DATA',
  797.      'DBG_NOTEMPTY', 'DBG_SMDOWN', 'DBG_SMUP');
  798.   GridBitmaps: array[TGridPicture] of TBitmap =
  799.     (nil, nil, nil, nil, nil, nil, nil, nil, nil);
  800.   bmMultiDot = 'DBG_MSDOT';
  801.   bmMultiArrow = 'DBG_MSARROW';
  802.  
  803. function GetGridBitmap(BmpType: TGridPicture): TBitmap;
  804. begin
  805.   if GridBitmaps[BmpType] = nil then begin
  806.     GridBitmaps[BmpType] := TBitmap.Create;
  807.     GridBitmaps[BmpType].Handle := LoadBitmap(HInstance, GridBmpNames[BmpType]);
  808.   end;
  809.   Result := GridBitmaps[BmpType];
  810. end;
  811.  
  812. procedure DestroyLocals; far;
  813. var
  814.   I: TGridPicture;
  815. begin
  816.   for I := Low(TGridPicture) to High(TGridPicture) do GridBitmaps[I].Free;
  817. end;
  818.  
  819. procedure GridInvalidateRow(Grid: TRxDBGrid; Row: Longint);
  820. var
  821.   I: Longint;
  822. begin
  823.   for I := 0 to Grid.ColCount - 1 do Grid.InvalidateCell(I, Row);
  824. end;
  825.  
  826. {$IFNDEF WIN32}
  827.  
  828. { TBookmarkList }
  829.  
  830. constructor TBookmarkList.Create(AGrid: TCustomDBGrid);
  831. begin
  832.   inherited Create;
  833.   FList := THugeList.Create;
  834.   FGrid := AGrid;
  835. end;
  836.  
  837. destructor TBookmarkList.Destroy;
  838. begin
  839.   Clear;
  840.   FList.Free;
  841.   inherited Destroy;
  842. end;
  843.  
  844. procedure TBookmarkList.Clear;
  845. var
  846.   I: Longint;
  847. begin
  848.   if FList.Count = 0 then Exit;
  849.   for I := FList.Count - 1 downto 0 do StrDispose(FList[I]);
  850.   FList.Clear;
  851.   ListChanged;
  852.   FGrid.Invalidate;
  853. end;
  854.  
  855. function TBookmarkList.Compare(const Item1, Item2: TBookmark): Longint;
  856. begin
  857.   Result := BookmarksCompare(TRxDBGrid(FGrid).Datalink.Dataset,
  858.     Item1, Item2);
  859. end;
  860.  
  861. function TBookmarkList.CurrentRow: TBookmark;
  862. begin
  863.   if not FLinkActive then _DBError(sDataSetClosed);
  864.   Result := TRxDBGrid(FGrid).Datalink.Dataset.GetBookmark;
  865. end;
  866.  
  867. function TBookmarkList.GetCurrentRowSelected: Boolean;
  868. var
  869.   Index: Longint;
  870.   Row: TBookmark;
  871. begin
  872.   Row := CurrentRow;
  873.   try
  874.     Result := Find(Row, Index);
  875.   finally
  876.     StrDispose(Row);
  877.   end;
  878. end;
  879.  
  880. function TBookmarkList.Find(const Item: TBookmark; var Index: Longint): Boolean;
  881. var
  882.   L, H, I, C: Longint;
  883.   P: PChar;
  884. begin
  885.   if (Compare(Item, FCache) = 0) and (FCacheIndex >= 0) then begin
  886.     Index := FCacheIndex;
  887.     Result := FCacheFind;
  888.     Exit;
  889.   end;
  890.   Result := False;
  891.   L := 0;
  892.   H := FList.Count - 1;
  893.   while L <= H do begin
  894.     I := (L + H) shr 1;
  895.     C := Compare(TBookmark(FList[I]), Item);
  896.     if C < 0 then L := I + 1
  897.     else begin
  898.       H := I - 1;
  899.       if C = 0 then begin
  900.         Result := True;
  901.         L := I;
  902.       end;
  903.     end;
  904.   end;
  905.   Index := L;
  906.   StrDispose(FCache);
  907.   FCache := nil;
  908.   P := PChar(Item);
  909.   if P <> nil then begin
  910.     Dec(P, 2);
  911.     FCache := StrAlloc(Word(Pointer(P)^));
  912.     Move(Item^, FCache^, Word(Pointer(P)^));
  913.   end;
  914.   FCacheIndex := Index;
  915.   FCacheFind := Result;
  916. end;
  917.  
  918. function TBookmarkList.GetCount: Longint;
  919. begin
  920.   Result := FList.Count;
  921. end;
  922.  
  923. function TBookmarkList.GetItem(Index: Longint): TBookmark;
  924. begin
  925.   Result := TBookmark(FList[Index]);
  926. end;
  927.  
  928. function TBookmarkList.IndexOf(const Item: TBookmark): Longint;
  929. begin
  930.   if not Find(Item, Result) then Result := -1;
  931. end;
  932.  
  933. procedure TBookmarkList.LinkActive(Value: Boolean);
  934. begin
  935.   Clear;
  936.   FLinkActive := Value;
  937. end;
  938.  
  939. procedure TBookmarkList.Delete;
  940. var
  941.   I: Longint;
  942. begin
  943.   with TRxDBGrid(FGrid).Datalink.Dataset do begin
  944.     DisableControls;
  945.     try
  946.       for I := FList.Count - 1 downto 0 do begin
  947.         if FList[I] <> nil then begin
  948.           GotoBookmark(TBookmark(FList[I]));
  949.           Delete;
  950.           StrDispose(FList[I]);
  951.         end;
  952.         FList.Delete(I);
  953.       end;
  954.       ListChanged;
  955.     finally
  956.       EnableControls;
  957.     end;
  958.   end;
  959. end;
  960.  
  961. function TBookmarkList.Refresh: Boolean;
  962. var
  963.   I: Longint;
  964. begin
  965.   Result := False;
  966.   with TRxDBGrid(FGrid).DataLink.Dataset do
  967.   try
  968.     CheckBrowseMode;
  969.     for I := FList.Count - 1 downto 0 do
  970.       if DbiSetToBookmark(Handle, Pointer(FList[I])) <> 0 then begin
  971.         Result := True;
  972.         StrDispose(FList[I]);
  973.         FList.Delete(I);
  974.       end;
  975.     ListChanged;
  976.   finally
  977.     UpdateCursorPos;
  978.     if Result then FGrid.Invalidate;
  979.   end;
  980. end;
  981.  
  982. procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
  983. var
  984.   Index: Longint;
  985.   Current: TBookmark;
  986. begin
  987.   Current := CurrentRow;
  988.   Index := 0;
  989.   if (Current = nil) or (Find(Current, Index) = Value) then begin
  990.     if Current <> nil then StrDispose(Current);
  991.     Exit;
  992.   end;
  993.   if Value then begin
  994.     try
  995.       FList.Insert(Index, Current);
  996.     except
  997.       StrDispose(Current);
  998.       raise;
  999.     end;
  1000.   end
  1001.   else begin
  1002.     if (Index < FList.Count) and (Index >= 0) then begin
  1003.       StrDispose(FList[Index]);
  1004.       FList.Delete(Index);
  1005.     end;
  1006.     StrDispose(Current);
  1007.   end;
  1008.   ListChanged;
  1009.   TRxDBGrid(FGrid).InvalidateRow(TRxDBGrid(FGrid).Row);
  1010.   GridInvalidateRow(TRxDBGrid(FGrid), TRxDBGrid(FGrid).Row);
  1011. end;
  1012.  
  1013. procedure TBookmarkList.ListChanged;
  1014. begin
  1015.   if FCache <> nil then StrDispose(FCache);
  1016.   FCache := nil;
  1017.   FCacheIndex := -1;
  1018. end;
  1019.  
  1020. {$ENDIF WIN32}
  1021.  
  1022. type
  1023.   TBookmarks = class(TBookmarkList);
  1024.  
  1025. { TRxDBGrid }
  1026.  
  1027. constructor TRxDBGrid.Create(AOwner: TComponent);
  1028. var
  1029.   Bmp: TBitmap;
  1030. begin
  1031.   inherited Create(AOwner);
  1032.   inherited DefaultDrawing := False;
  1033.   Options := DefRxGridOptions;
  1034.   Bmp := TBitmap.Create;
  1035.   try
  1036.     Bmp.Handle := LoadBitmap(hInstance, bmMultiDot);
  1037. {$IFDEF WIN32}
  1038.     FMsIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
  1039. {$ELSE}
  1040.     FMsIndicators := TImageList.Create(Bmp.Width, Bmp.Height);
  1041.     Bmp.Monochrome := False;
  1042. {$ENDIF}
  1043.     FMsIndicators.AddMasked(Bmp, clWhite);
  1044.     Bmp.Handle := LoadBitmap(hInstance, bmMultiArrow);
  1045. {$IFNDEF WIN32}
  1046.     Bmp.Monochrome := False;
  1047. {$ENDIF}
  1048.     FMsIndicators.AddMasked(Bmp, clWhite);
  1049.   finally
  1050.     Bmp.Free;
  1051.   end;
  1052.   FIniLink := TIniLink.Create;
  1053.   FIniLink.OnSave := IniSave;
  1054.   FIniLink.OnLoad := IniLoad;
  1055.   FShowGlyphs := True;
  1056.   FDefaultDrawing := True;
  1057.   FClearSelection := True;
  1058. {$IFNDEF WIN32}
  1059.   FBookmarks := TBookmarkList.Create(Self);
  1060.   FPressedCol := -1;
  1061. {$ENDIF}
  1062. end;
  1063.  
  1064. destructor TRxDBGrid.Destroy;
  1065. begin
  1066.   FIniLink.Free;
  1067. {$IFNDEF WIN32}
  1068.   if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
  1069.   FSelectionAnchor := nil;
  1070.   FBookmarks.Free;
  1071.   FBookmarks := nil;
  1072. {$ENDIF}
  1073.   FMsIndicators.Free;
  1074.   inherited Destroy;
  1075. end;
  1076.  
  1077. function TRxDBGrid.GetImageIndex(Field: TField): Integer;
  1078. var
  1079.   AOnGetText: TFieldGetTextEvent;
  1080.   AOnSetText: TFieldSetTextEvent;
  1081. begin
  1082.   Result := -1;
  1083.   if FShowGlyphs and Assigned(Field) then begin
  1084.     if (not ReadOnly) and Field.CanModify then begin
  1085.       { Allow editing of memo fields if OnSetText and OnGetText
  1086.         events are assigned }
  1087.       AOnGetText := Field.OnGetText;
  1088.       AOnSetText := Field.OnSetText;
  1089.       if Assigned(AOnSetText) and Assigned(AOnGetText) then Exit;
  1090.     end;
  1091.     case Field.DataType of
  1092.       ftBytes, ftVarBytes, ftBlob: Result := Ord(gpBlob);
  1093.       ftMemo: Result := Ord(gpMemo);
  1094.       ftGraphic: Result := Ord(gpPicture);
  1095. {$IFDEF WIN32}
  1096.       ftTypedBinary: Result := Ord(gpBlob);
  1097.       ftFmtMemo: Result := Ord(gpMemo);
  1098.       ftParadoxOle, ftDBaseOle: Result := Ord(gpOle);
  1099. {$ENDIF}
  1100. {$IFDEF RX_D3}
  1101.       ftCursor: Result := Ord(gpData);
  1102. {$ENDIF}
  1103. {$IFDEF RX_D4}
  1104.       ftReference, ftDataSet: Result := Ord(gpData);
  1105. {$ENDIF}
  1106. {$IFDEF RX_D5}
  1107.       ftOraClob: Result := Ord(gpMemo);
  1108.       ftOraBlob: Result := Ord(gpBlob);
  1109. {$ENDIF}
  1110.     end;
  1111.   end;
  1112. end;
  1113.  
  1114. function TRxDBGrid.ActiveRowSelected: Boolean;
  1115. var
  1116. {$IFDEF WIN32}
  1117.   Index: Integer;
  1118. {$ELSE}
  1119.   Index: Longint;
  1120.   Bookmark: TBookmark;
  1121. {$ENDIF}
  1122. begin
  1123.   Result := False;
  1124.   if MultiSelect and Datalink.Active then begin
  1125. {$IFDEF WIN32}
  1126.     Result := SelectedRows.Find(Datalink.DataSet.Bookmark, Index);
  1127. {$ELSE}
  1128.     Bookmark := Datalink.Dataset.GetBookmark;
  1129.     try
  1130.       Result := SelectedRows.Find(Bookmark, Index);
  1131.     finally
  1132.       StrDispose(Bookmark);
  1133.     end;
  1134. {$ENDIF}
  1135.   end;
  1136. end;
  1137.  
  1138. function TRxDBGrid.HighlightCell(DataCol, DataRow: Integer;
  1139.   const Value: string; AState: TGridDrawState): Boolean;
  1140. begin
  1141.   Result := ActiveRowSelected;
  1142.   if not Result then
  1143.     Result := inherited HighlightCell(DataCol, DataRow, Value, AState);
  1144. end;
  1145.  
  1146. procedure TRxDBGrid.ToggleRowSelection;
  1147. begin
  1148.   if MultiSelect and Datalink.Active then
  1149.     with SelectedRows do CurrentRowSelected := not CurrentRowSelected;
  1150. end;
  1151.  
  1152. function TRxDBGrid.GetSelCount: Longint;
  1153. begin
  1154.   if MultiSelect and (Datalink <> nil) and Datalink.Active then
  1155.     Result := SelectedRows.Count
  1156.   else Result := 0;
  1157. end;
  1158.  
  1159. procedure TRxDBGrid.SelectAll;
  1160. var
  1161.   ABookmark: TBookmark;
  1162. begin
  1163.   if MultiSelect and DataLink.Active then begin
  1164.     with Datalink.Dataset do begin
  1165.       if (BOF and EOF) then Exit;
  1166.       DisableControls;
  1167.       try
  1168.         ABookmark := GetBookmark;
  1169.         try
  1170.           First;
  1171.           while not EOF do begin
  1172.             SelectedRows.CurrentRowSelected := True;
  1173.             Next;
  1174.           end;
  1175.         finally
  1176.           try
  1177.             GotoBookmark(ABookmark);
  1178.           except
  1179.           end;
  1180.           FreeBookmark(ABookmark);
  1181.         end;
  1182.       finally
  1183.         EnableControls;
  1184.       end;
  1185.     end;
  1186.   end;
  1187. end;
  1188.  
  1189. procedure TRxDBGrid.UnselectAll;
  1190. begin
  1191.   if MultiSelect then begin
  1192.     SelectedRows.Clear;
  1193.     FSelecting := False;
  1194.   end;
  1195. end;
  1196.  
  1197. procedure TRxDBGrid.GotoSelection(Index: Longint);
  1198. begin
  1199.   if MultiSelect and DataLink.Active and (Index < SelectedRows.Count) and
  1200.     (Index >= 0) then
  1201.     Datalink.DataSet.GotoBookmark(Pointer(SelectedRows[Index]));
  1202. end;
  1203.  
  1204. {$IFNDEF WIN32}
  1205. function TRxDBGrid.GetIndicatorOffset: Byte;
  1206. begin
  1207.   Result := 0;
  1208.   if dgIndicator in Options then Inc(Result);
  1209. end;
  1210. {$ENDIF WIN32}
  1211.  
  1212. procedure TRxDBGrid.LayoutChanged;
  1213. var
  1214.   ACol: Longint;
  1215. begin
  1216.   ACol := Col;
  1217.   inherited LayoutChanged;
  1218.   if Datalink.Active and (FixedCols > 0) then
  1219. {$IFDEF RX_D4}
  1220.     Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
  1221. {$ELSE}
  1222.     Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
  1223. {$ENDIF}
  1224. end;
  1225.  
  1226. {$IFDEF WIN32}
  1227. procedure TRxDBGrid.ColWidthsChanged;
  1228. var
  1229.   ACol: Longint;
  1230. begin
  1231.   ACol := Col;
  1232.   inherited ColWidthsChanged;
  1233.   if Datalink.Active and (FixedCols > 0) then
  1234. {$IFDEF RX_D4}
  1235.     Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
  1236. {$ELSE}
  1237.     Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
  1238. {$ENDIF}
  1239. end;
  1240. {$ENDIF}
  1241.  
  1242. function TRxDBGrid.CreateEditor: TInplaceEdit;
  1243. begin
  1244.   Result := inherited CreateEditor;
  1245.   TEdit(Result).OnChange := EditChanged;
  1246. end;
  1247.  
  1248. function TRxDBGrid.GetTitleOffset: Byte;
  1249. {$IFDEF RX_D4}
  1250. var
  1251.   I, J: Integer;
  1252. {$ENDIF}
  1253. begin
  1254.   Result := 0;
  1255.   if dgTitles in Options then begin
  1256.     Result := 1;
  1257. {$IFDEF RX_D4}
  1258.     if (Datalink <> nil) and (Datalink.Dataset <> nil) and
  1259.       Datalink.Dataset.ObjectView then
  1260.     begin
  1261.       for I := 0 to Columns.Count - 1 do begin
  1262.         if Columns[I].Showing then begin
  1263.           J := Columns[I].Depth;
  1264.           if J >= Result then Result := J + 1;
  1265.         end;
  1266.       end;
  1267.     end;
  1268. {$ENDIF}
  1269.   end;
  1270. end;
  1271.  
  1272. procedure TRxDBGrid.SetColumnAttributes;
  1273. begin
  1274.   inherited SetColumnAttributes;
  1275.   SetFixedCols(FFixedCols);
  1276. end;
  1277.  
  1278. procedure TRxDBGrid.SetFixedCols(Value: Integer);
  1279. var
  1280.   FixCount, I: Integer;
  1281. begin
  1282.   FixCount := Max(Value, 0) + IndicatorOffset;
  1283.   if DataLink.Active and not (csLoading in ComponentState) and
  1284.     (ColCount > IndicatorOffset + 1) then
  1285.   begin
  1286.     FixCount := Min(FixCount, ColCount - 1);
  1287.     inherited FixedCols := FixCount;
  1288.     for I := 1 to Min(FixedCols, ColCount - 1) do
  1289.       TabStops[I] := False;
  1290.   end;
  1291.   FFixedCols := FixCount - IndicatorOffset;
  1292. end;
  1293.  
  1294. function TRxDBGrid.GetFixedCols: Integer;
  1295. begin
  1296.   if DataLink.Active then Result := inherited FixedCols - IndicatorOffset
  1297.   else Result := FFixedCols;
  1298. end;
  1299.  
  1300. {$IFDEF RX_D4}
  1301. function TRxDBGrid.CalcLeftColumn: Integer;
  1302. begin
  1303.   Result := FixedCols + IndicatorOffset;
  1304.   while (Result < ColCount) and (ColWidths[Result] <= 0) do
  1305.     Inc(Result);
  1306. end;
  1307. {$ENDIF}
  1308.  
  1309. procedure TRxDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
  1310. var
  1311.   KeyDownEvent: TKeyEvent;
  1312.  
  1313.   procedure ClearSelections;
  1314.   begin
  1315.     if FMultiSelect then begin
  1316.       if FClearSelection then SelectedRows.Clear;
  1317.       FSelecting := False;
  1318.     end;
  1319.   end;
  1320.  
  1321.   procedure DoSelection(Select: Boolean; Direction: Integer);
  1322.   var
  1323.     AddAfter: Boolean;
  1324. {$IFNDEF WIN32}
  1325.     CurRow: TBookmark;
  1326. {$ENDIF}
  1327.   begin
  1328.     AddAfter := False;
  1329. {$IFDEF WIN32}
  1330.     BeginUpdate;
  1331.     try
  1332. {$ENDIF}
  1333.       if MultiSelect and DataLink.Active then
  1334.         if Select and (ssShift in Shift) then begin
  1335.           if not FSelecting then begin
  1336. {$IFNDEF WIN32}
  1337.             if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
  1338. {$ENDIF}
  1339.             FSelectionAnchor := TBookmarks(SelectedRows).CurrentRow;
  1340.             SelectedRows.CurrentRowSelected := True;
  1341.             FSelecting := True;
  1342.             AddAfter := True;
  1343.           end
  1344.           else with TBookmarks(SelectedRows) do begin
  1345. {$IFDEF WIN32}
  1346.             AddAfter := Compare(CurrentRow, FSelectionAnchor) <> -Direction;
  1347. {$ELSE}
  1348.             CurRow := CurrentRow;
  1349.             try
  1350.               AddAfter := Compare(CurRow, FSelectionAnchor) <> -Direction;
  1351.             finally
  1352.               StrDispose(CurRow);
  1353.             end;
  1354. {$ENDIF}
  1355.             if not AddAfter then CurrentRowSelected := False;
  1356.           end
  1357.         end
  1358.         else ClearSelections;
  1359.       if Direction <> 0 then Datalink.DataSet.MoveBy(Direction);
  1360.       if AddAfter then SelectedRows.CurrentRowSelected := True;
  1361. {$IFDEF WIN32}
  1362.     finally
  1363.       EndUpdate;
  1364.     end;
  1365. {$ENDIF}
  1366.   end;
  1367.  
  1368.   procedure NextRow(Select: Boolean);
  1369.   begin
  1370.     with Datalink.Dataset do begin
  1371.       DoSelection(Select, 1);
  1372.       if EOF and CanModify and (not ReadOnly) and (dgEditing in Options) then
  1373.         Append;
  1374.     end;
  1375.   end;
  1376.  
  1377.   procedure PriorRow(Select: Boolean);
  1378.   begin
  1379.     DoSelection(Select, -1);
  1380.   end;
  1381.  
  1382.   procedure CheckTab(GoForward: Boolean);
  1383.   var
  1384.     ACol, Original: Integer;
  1385.   begin
  1386.     ACol := Col;
  1387.     Original := ACol;
  1388.     if MultiSelect and DataLink.Active then
  1389.       while True do begin
  1390.         if GoForward then Inc(ACol) else Dec(ACol);
  1391.         if ACol >= ColCount then begin
  1392.           ClearSelections;
  1393.           ACol := IndicatorOffset;
  1394.         end
  1395.         else if ACol < IndicatorOffset then begin
  1396.           ClearSelections;
  1397.           ACol := ColCount;
  1398.         end;
  1399.         if ACol = Original then Exit;
  1400.         if TabStops[ACol] then Exit;
  1401.       end;
  1402.   end;
  1403.  
  1404.   function DeletePrompt: Boolean;
  1405.   var
  1406.     S: string;
  1407.   begin
  1408.     if (SelectedRows.Count > 1) then
  1409. {$IFDEF WIN32}
  1410.       S := ResStr(SDeleteMultipleRecordsQuestion)
  1411. {$ELSE}
  1412.       S := LoadStr(SDeleteMultipleRecords)
  1413. {$ENDIF}
  1414.     else S := ResStr(SDeleteRecordQuestion);
  1415.     Result := not (dgConfirmDelete in Options) or
  1416.       (MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0) = mrYes);
  1417.   end;
  1418.  
  1419. begin
  1420.   KeyDownEvent := OnKeyDown;
  1421.   if Assigned(KeyDownEvent) then KeyDownEvent(Self, Key, Shift);
  1422.   if not Datalink.Active or not CanGridAcceptKey(Key, Shift) then Exit;
  1423.   with Datalink.DataSet do
  1424.     if ssCtrl in Shift then begin
  1425.       if (Key in [VK_UP, VK_PRIOR, VK_DOWN, VK_NEXT, VK_HOME, VK_END]) then
  1426.         ClearSelections;
  1427.       case Key of
  1428.         VK_LEFT:
  1429.           if FixedCols > 0 then begin
  1430. {$IFDEF RX_D4}
  1431.             SelectedIndex := CalcLeftColumn - IndicatorOffset;
  1432. {$ELSE}
  1433.             SelectedIndex := FixedCols;
  1434. {$ENDIF}
  1435.             Exit;
  1436.           end;
  1437.         VK_DELETE:
  1438.           if not ReadOnly and CanModify and not
  1439.             IsDataSetEmpty(Datalink.DataSet) then
  1440.           begin
  1441.             if DeletePrompt then begin
  1442.               if SelectedRows.Count > 0 then SelectedRows.Delete
  1443.               else Delete;
  1444.             end;
  1445.             Exit;
  1446.           end;
  1447.       end
  1448.     end
  1449.     else begin
  1450.       case Key of
  1451.         VK_LEFT:
  1452.           if (FixedCols > 0) and not (dgRowSelect in Options) then begin
  1453. {$IFDEF RX_D4}
  1454.             if SelectedIndex <= CalcLeftColumn - IndicatorOffset then
  1455.               Exit;
  1456. {$ELSE}
  1457.             if SelectedIndex <= FFixedCols then Exit;
  1458. {$ENDIF}
  1459.           end;
  1460.         VK_HOME:
  1461.           if (FixedCols > 0) and (ColCount <> IndicatorOffset + 1) and
  1462.             not (dgRowSelect in Options) then
  1463.           begin
  1464. {$IFDEF RX_D4}
  1465.             SelectedIndex := CalcLeftColumn - IndicatorOffset;
  1466. {$ELSE}
  1467.             SelectedIndex := FixedCols;
  1468. {$ENDIF}
  1469.             Exit;
  1470.           end;
  1471.       end;
  1472.       if (Datalink.DataSet.State = dsBrowse) then begin
  1473.         case Key of
  1474.           VK_UP:
  1475.             begin
  1476.               PriorRow(True); Exit;
  1477.             end;
  1478.           VK_DOWN:
  1479.             begin
  1480.               NextRow(True); Exit;
  1481.             end;
  1482.         end;
  1483.       end;
  1484.       if ((Key in [VK_LEFT, VK_RIGHT]) and (dgRowSelect in Options)) or
  1485.         ((Key in [VK_HOME, VK_END]) and ((ColCount = IndicatorOffset + 1)
  1486.           or (dgRowSelect in Options))) or (Key in [VK_ESCAPE, VK_NEXT,
  1487.           VK_PRIOR]) or ((Key = VK_INSERT) and (CanModify and
  1488.           (not ReadOnly) and (dgEditing in Options))) then
  1489.         ClearSelections
  1490.       else if ((Key = VK_TAB) and not (ssAlt in Shift)) then
  1491.         CheckTab(not (ssShift in Shift));
  1492.     end;
  1493.   OnKeyDown := nil;
  1494.   try
  1495.     inherited KeyDown(Key, Shift);
  1496.   finally
  1497.     OnKeyDown := KeyDownEvent;
  1498.   end;
  1499. end;
  1500.  
  1501. procedure TRxDBGrid.SetShowGlyphs(Value: Boolean);
  1502. begin
  1503.   if FShowGlyphs <> Value then begin
  1504.     FShowGlyphs := Value;
  1505.     Invalidate;
  1506.   end;
  1507. end;
  1508.  
  1509. procedure TRxDBGrid.SetRowsHeight(Value: Integer);
  1510. begin
  1511.   if not (csDesigning in ComponentState) and (DefaultRowHeight <> Value) then
  1512.   begin
  1513.     DefaultRowHeight := Value;
  1514.     if dgTitles in Options then RowHeights[0] := Value + 2;
  1515.     if HandleAllocated then
  1516.       Perform(WM_SIZE, SIZE_RESTORED, MakeLong(ClientWidth, ClientHeight));
  1517.   end;
  1518. end;
  1519.  
  1520. function TRxDBGrid.GetRowsHeight: Integer;
  1521. begin
  1522.   Result := DefaultRowHeight;
  1523. end;
  1524.  
  1525. {$IFDEF WIN32}
  1526.  
  1527. function TRxDBGrid.GetOptions: TDBGridOptions;
  1528. begin
  1529.   Result := inherited Options;
  1530.   if FMultiSelect then Result := Result + [dgMultiSelect]
  1531.   else Result := Result - [dgMultiSelect];
  1532. end;
  1533.  
  1534. procedure TRxDBGrid.SetOptions(Value: TDBGridOptions);
  1535. var
  1536.   NewOptions: TGridOptions;
  1537. begin
  1538.   inherited Options := Value - [dgMultiSelect];
  1539.   NewOptions := TDrawGrid(Self).Options;
  1540.   if FTitleButtons then begin
  1541.     TDrawGrid(Self).Options := NewOptions + [goFixedHorzLine, goFixedVertLine];
  1542.   end
  1543.   else begin
  1544.     if not (dgColLines in Value) then
  1545.       NewOptions := NewOptions - [goFixedVertLine];
  1546.     if not (dgRowLines in Value) then
  1547.       NewOptions := NewOptions - [goFixedHorzLine];
  1548.     TDrawGrid(Self).Options := NewOptions;
  1549.   end;
  1550.   SetMultiSelect(dgMultiSelect in Value);
  1551. end;
  1552.  
  1553. {$ELSE}
  1554.  
  1555. procedure TRxDBGrid.LinkActive(Value: Boolean);
  1556. begin
  1557.   SelectedRows.LinkActive(Value);
  1558.   inherited LinkActive(Value);
  1559. end;
  1560.  
  1561. function TRxDBGrid.GetFixedColor: TColor;
  1562. begin
  1563.   Result := inherited TitleColor;
  1564. end;
  1565.  
  1566. procedure TRxDBGrid.SetFixedColor(Value: TColor);
  1567. begin
  1568.   if FixedColor <> Value then begin
  1569.     inherited TitleColor := Value;
  1570.     inherited FixedColor := Value;
  1571.     Invalidate;
  1572.   end;
  1573. end;
  1574.  
  1575. procedure TRxDBGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1576. begin
  1577.   inherited ColumnMoved(FromIndex, ToIndex);
  1578.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  1579. end;
  1580.  
  1581. {$ENDIF WIN32}
  1582.  
  1583. procedure TRxDBGrid.Paint;
  1584. begin
  1585.   inherited Paint;
  1586.   if not (csDesigning in ComponentState) and
  1587.     (dgRowSelect in Options) and DefaultDrawing and Focused then
  1588.   begin
  1589.     Canvas.Font.Color := clWindowText;
  1590.     with Selection do
  1591.       DrawFocusRect(Canvas.Handle, BoxRect(Left, Top, Right, Bottom));
  1592.   end;
  1593. end;
  1594.  
  1595. procedure TRxDBGrid.SetTitleButtons(Value: Boolean);
  1596. begin
  1597.   if FTitleButtons <> Value then begin
  1598.     FTitleButtons := Value;
  1599.     Invalidate;
  1600. {$IFDEF WIN32}
  1601.     SetOptions(Options);
  1602. {$ENDIF}
  1603.   end;
  1604. end;
  1605.  
  1606. procedure TRxDBGrid.SetMultiSelect(Value: Boolean);
  1607. begin
  1608.   if FMultiSelect <> Value then begin
  1609.     FMultiSelect := Value;
  1610.     if not Value then SelectedRows.Clear;
  1611.   end;
  1612. end;
  1613.  
  1614. function TRxDBGrid.GetStorage: TFormPlacement;
  1615. begin
  1616.   Result := FIniLink.Storage;
  1617. end;
  1618.  
  1619. procedure TRxDBGrid.SetStorage(Value: TFormPlacement);
  1620. begin
  1621.   FIniLink.Storage := Value;
  1622. end;
  1623.  
  1624. function TRxDBGrid.AcquireFocus: Boolean;
  1625. begin
  1626.   Result := True;
  1627.   if FAcquireFocus and CanFocus and not (csDesigning in ComponentState) then
  1628.   begin
  1629.     SetFocus;
  1630.     Result := Focused or (InplaceEditor <> nil) and InplaceEditor.Focused;
  1631.   end;
  1632. end;
  1633.  
  1634. function TRxDBGrid.CanEditShow: Boolean;
  1635. var
  1636.   F: TField;
  1637. begin
  1638.   Result := inherited CanEditShow;
  1639.   F := nil;
  1640.   if Result and (Datalink <> nil) and Datalink.Active and (FieldCount > 0) and
  1641.     (SelectedIndex < FieldCount) and (SelectedIndex >= 0) and
  1642.     (FieldCount <= DataSource.DataSet.FieldCount) then
  1643.   begin
  1644.     F := Fields[SelectedIndex];
  1645.     if F <> nil then Result := GetImageIndex(F) < 0;
  1646.   end;
  1647.   if Result and Assigned(FOnShowEditor) then
  1648.     FOnShowEditor(Self, F, Result);
  1649. end;
  1650.  
  1651. procedure TRxDBGrid.GetCellProps(Field: TField; AFont: TFont;
  1652.   var Background: TColor; Highlight: Boolean);
  1653. var
  1654.   AColor, ABack: TColor;
  1655. begin
  1656.   if Assigned(FOnGetCellParams) then
  1657.     FOnGetCellParams(Self, Field, AFont, Background, Highlight)
  1658.   else if Assigned(FOnGetCellProps) then begin
  1659.     if Highlight then begin
  1660.       AColor := AFont.Color;
  1661.       FOnGetCellProps(Self, Field, AFont, ABack);
  1662.       AFont.Color := AColor;
  1663.     end
  1664.     else FOnGetCellProps(Self, Field, AFont, Background);
  1665.   end;
  1666. end;
  1667.  
  1668. procedure TRxDBGrid.DoTitleClick(ACol: Longint; AField: TField);
  1669. begin
  1670.   if Assigned(FOnTitleBtnClick) then FOnTitleBtnClick(Self, ACol, AField);
  1671. end;
  1672.  
  1673. procedure TRxDBGrid.CheckTitleButton(ACol, ARow: Longint; var Enabled: Boolean);
  1674. var
  1675.   Field: TField;
  1676. begin
  1677.   if (ACol >= 0) and (ACol < {$IFDEF WIN32} Columns.Count {$ELSE}
  1678.     FieldCount {$ENDIF}) then
  1679.   begin
  1680.     if Assigned(FOnCheckButton) then begin
  1681. {$IFDEF WIN32}
  1682.       Field := Columns[ACol].Field;
  1683.   {$IFDEF RX_D4}
  1684.       if ColumnAtDepth(Columns[ACol], ARow) <> nil then
  1685.         Field := ColumnAtDepth(Columns[ACol], ARow).Field;
  1686.   {$ENDIF}
  1687. {$ELSE}
  1688.       Field := Fields[ACol];
  1689. {$ENDIF}
  1690.       FOnCheckButton(Self, ACol, Field, Enabled);
  1691.     end;
  1692.   end
  1693.   else Enabled := False;
  1694. end;
  1695.  
  1696. procedure TRxDBGrid.DisableScroll;
  1697. begin
  1698.   Inc(FDisableCount);
  1699. end;
  1700.  
  1701. type
  1702.   THackLink = class(TGridDataLink);
  1703.  
  1704. procedure TRxDBGrid.EnableScroll;
  1705. begin
  1706.   if FDisableCount <> 0 then begin
  1707.     Dec(FDisableCount);
  1708.     if FDisableCount = 0 then
  1709.       THackLink(DataLink).DataSetScrolled(0);
  1710.   end;
  1711. end;
  1712.  
  1713. function TRxDBGrid.ScrollDisabled: Boolean;
  1714. begin
  1715.   Result := FDisableCount <> 0;
  1716. end;
  1717.  
  1718. procedure TRxDBGrid.Scroll(Distance: Integer);
  1719. {$IFNDEF RX_D3}
  1720. var
  1721.   IndicatorRect: TRect;
  1722. {$ENDIF}
  1723. begin
  1724.   if FDisableCount = 0 then begin
  1725.     inherited Scroll(Distance);
  1726. {$IFNDEF RX_D3}
  1727.     if (dgIndicator in Options) and HandleAllocated and MultiSelect then
  1728.     begin
  1729.       IndicatorRect := BoxRect(0, 0, 0, RowCount - 1);
  1730.       InvalidateRect(Handle, @IndicatorRect, False);
  1731.     end;
  1732. {$ENDIF}
  1733.   end;
  1734. end;
  1735.  
  1736. {$IFDEF RX_D4}
  1737.  
  1738. function TRxDBGrid.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
  1739. begin
  1740.   Result := False;
  1741.   if Assigned(OnMouseWheelDown) then
  1742.     OnMouseWheelDown(Self, Shift, MousePos, Result);
  1743.   if not Result then begin
  1744.     if not AcquireFocus then Exit;
  1745.     if Datalink.Active then begin
  1746.       Result := Datalink.DataSet.MoveBy(1) <> 0;
  1747.     end;
  1748.   end;
  1749. end;
  1750.  
  1751. function TRxDBGrid.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
  1752. begin
  1753.   Result := False;
  1754.   if Assigned(OnMouseWheelUp) then
  1755.     OnMouseWheelUp(Self, Shift, MousePos, Result);
  1756.   if not Result then begin
  1757.     if not AcquireFocus then Exit;
  1758.     if Datalink.Active then begin
  1759.       Result := Datalink.DataSet.MoveBy(-1) <> 0;
  1760.     end;
  1761.   end;
  1762. end;
  1763.  
  1764. {$ENDIF RX_D4}
  1765.  
  1766. procedure TRxDBGrid.EditChanged(Sender: TObject);
  1767. begin
  1768.   if Assigned(FOnEditChange) then FOnEditChange(Self);
  1769. end;
  1770.  
  1771. procedure TRxDBGrid.TopLeftChanged;
  1772. begin
  1773.   if (dgRowSelect in Options) and DefaultDrawing then
  1774.     GridInvalidateRow(Self, Self.Row);
  1775.   inherited TopLeftChanged;
  1776.   if FTracking then StopTracking;
  1777.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  1778. end;
  1779.  
  1780. procedure TRxDBGrid.StopTracking;
  1781. begin
  1782.   if FTracking then begin
  1783.     TrackButton(-1, -1);
  1784.     FTracking := False;
  1785.     MouseCapture := False;
  1786.   end;
  1787. end;
  1788.  
  1789. procedure TRxDBGrid.TrackButton(X, Y: Integer);
  1790. var
  1791.   Cell: TGridCoord;
  1792.   NewPressed: Boolean;
  1793.   I, Offset: Integer;
  1794. begin
  1795.   Cell := MouseCoord(X, Y);
  1796.   Offset := TitleOffset;
  1797.   NewPressed := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y)) and
  1798.     (FPressedCol = {$IFDEF WIN32} GetMasterColumn(Cell.X, Cell.Y) {$ELSE}
  1799.     Cell.X {$ENDIF}) and (Cell.Y < Offset);
  1800.   if FPressed <> NewPressed then begin
  1801.     FPressed := NewPressed;
  1802.     for I := 0 to Offset - 1 do
  1803.       GridInvalidateRow(Self, I);
  1804.   end;
  1805. end;
  1806.  
  1807. procedure TRxDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  1808.   X, Y: Integer);
  1809. var
  1810.   Cell: TGridCoord;
  1811.   MouseDownEvent: TMouseEvent;
  1812.   EnableClick: Boolean;
  1813. begin
  1814.   if not AcquireFocus then Exit;
  1815.   if (ssDouble in Shift) and (Button = mbLeft) then begin
  1816.     DblClick;
  1817.     Exit;
  1818.   end;
  1819.   if Sizing(X, Y) then
  1820.     inherited MouseDown(Button, Shift, X, Y)
  1821.   else begin
  1822.     Cell := MouseCoord(X, Y);
  1823. {$IFDEF RX_D4}
  1824.     if (DragKind = dkDock) and (Cell.X < IndicatorOffset) and
  1825.       (Cell.Y < TitleOffset) and (not (csDesigning in ComponentState)) then
  1826.     begin
  1827.       BeginDrag(False);
  1828.       Exit;
  1829.     end;
  1830. {$ENDIF}
  1831.     if FTitleButtons and (Datalink <> nil) and Datalink.Active and
  1832.       (Cell.Y < TitleOffset) and (Cell.X >= IndicatorOffset) and
  1833.       not (csDesigning in ComponentState) then
  1834.     begin
  1835.       if (dgColumnResize in Options) and (Button = mbRight) then begin
  1836.         Button := mbLeft;
  1837.         FSwapButtons := True;
  1838.         MouseCapture := True;
  1839.       end
  1840.       else if Button = mbLeft then begin
  1841.         EnableClick := True;
  1842.         CheckTitleButton(Cell.X - IndicatorOffset, Cell.Y, EnableClick);
  1843.         if EnableClick then begin
  1844.           MouseCapture := True;
  1845.           FTracking := True;
  1846. {$IFDEF WIN32}
  1847.           FPressedCol := GetMasterColumn(Cell.X, Cell.Y);
  1848. {$ELSE}
  1849.           FPressedCol := Cell.X;
  1850. {$ENDIF}
  1851.           TrackButton(X, Y);
  1852.         end else Beep;
  1853.         Exit;
  1854.       end;
  1855.     end;
  1856.     if (Cell.X < FixedCols + IndicatorOffset) and Datalink.Active then begin
  1857.       if (dgIndicator in Options) then
  1858.         inherited MouseDown(Button, Shift, 1, Y)
  1859.       else if Cell.Y >= TitleOffset then
  1860.         if Cell.Y - Row <> 0 then Datalink.Dataset.MoveBy(Cell.Y - Row);
  1861.     end
  1862.     else inherited MouseDown(Button, Shift, X, Y);
  1863.     MouseDownEvent := OnMouseDown;
  1864.     if Assigned(MouseDownEvent) then MouseDownEvent(Self, Button, Shift, X, Y);
  1865.     if not (((csDesigning in ComponentState) or (dgColumnResize in Options)) and
  1866.       (Cell.Y < TitleOffset)) and (Button = mbLeft) then
  1867.     begin
  1868.       if MultiSelect and Datalink.Active then
  1869.         with SelectedRows do begin
  1870.           FSelecting := False;
  1871.           if ssCtrl in Shift then
  1872.             CurrentRowSelected := not CurrentRowSelected
  1873.           else begin
  1874.             Clear;
  1875.             if FClearSelection then CurrentRowSelected := True;
  1876.           end;
  1877.         end;
  1878.     end;
  1879.   end;
  1880. end;
  1881.  
  1882. procedure TRxDBGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  1883. begin
  1884.   if FTracking then TrackButton(X, Y);
  1885.   inherited MouseMove(Shift, X, Y);
  1886. end;
  1887.  
  1888. procedure TRxDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1889.   X, Y: Integer);
  1890. var
  1891.   Cell: TGridCoord;
  1892.   ACol: Longint;
  1893.   DoClick: Boolean;
  1894. begin
  1895.   if FTracking and {$IFDEF WIN32} (FPressedCol <> nil) {$ELSE}
  1896.     (FPressedCol >= 0) {$ENDIF} then
  1897.   begin
  1898.     Cell := MouseCoord(X, Y);
  1899.     DoClick := PtInRect(Rect(0, 0, ClientWidth, ClientHeight), Point(X, Y))
  1900.       and (Cell.Y < TitleOffset) and
  1901. {$IFDEF WIN32}
  1902.       (FPressedCol = GetMasterColumn(Cell.X, Cell.Y));
  1903. {$ELSE}
  1904.       (Cell.X = FPressedCol);
  1905. {$ENDIF}
  1906.     StopTracking;
  1907.     if DoClick then begin
  1908.       ACol := Cell.X;
  1909.       if (dgIndicator in Options) then Dec(ACol);
  1910.       if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
  1911.         (ACol < {$IFDEF WIN32} Columns.Count {$ELSE} FieldCount {$ENDIF}) then
  1912.       begin
  1913. {$IFDEF WIN32}
  1914.         DoTitleClick(FPressedCol.Index, FPressedCol.Field);
  1915. {$ELSE}
  1916.         DoTitleClick(ACol, Fields[ACol]);
  1917. {$ENDIF}
  1918.       end;
  1919.     end;
  1920.   end
  1921.   else if FSwapButtons then begin
  1922.     FSwapButtons := False;
  1923.     MouseCapture := False;
  1924.     if Button = mbRight then Button := mbLeft;
  1925.   end;
  1926.   inherited MouseUp(Button, Shift, X, Y);
  1927. end;
  1928.  
  1929. {$IFDEF WIN32}
  1930. procedure TRxDBGrid.WMRButtonUp(var Message: TWMMouse);
  1931. begin
  1932.   if not (FGridState in [gsColMoving, gsRowMoving]) then
  1933.     inherited
  1934.   else if not (csNoStdEvents in ControlStyle) then
  1935.     with Message do MouseUp(mbRight, KeysToShiftState(Keys), XPos, YPos);
  1936. end;
  1937. {$ENDIF}
  1938.  
  1939. procedure TRxDBGrid.WMCancelMode(var Message: TMessage);
  1940. begin
  1941.   StopTracking;
  1942.   inherited;
  1943. end;
  1944.  
  1945. type
  1946.   THack = class(TWinControl);
  1947.  
  1948. procedure TRxDBGrid.WMChar(var Msg: TWMChar);
  1949.  
  1950.   function DoKeyPress(var Msg: TWMChar): Boolean;
  1951.   var
  1952.     Form: TCustomForm;
  1953.     Ch: Char;
  1954.   begin
  1955.     Result := True;
  1956.     Form := GetParentForm(Self);
  1957.     if (Form <> nil) and TForm(Form).KeyPreview and
  1958.       THack(Form).DoKeyPress(Msg) then Exit;
  1959.     with Msg do begin
  1960.       if Assigned(FOnKeyPress) then begin
  1961.         Ch := Char(CharCode);
  1962.         FOnKeyPress(Self, Ch);
  1963.         CharCode := Word(Ch);
  1964.       end;
  1965.       if Char(CharCode) = #0 then Exit;
  1966.     end;
  1967.     Result := False;
  1968.   end;
  1969.  
  1970. begin
  1971.   if EditorMode or not DoKeyPress(Msg) then inherited;
  1972. end;
  1973.  
  1974. procedure TRxDBGrid.KeyPress(var Key: Char);
  1975. begin
  1976.   if EditorMode then inherited OnKeyPress := FOnKeyPress;
  1977.   try
  1978.     inherited KeyPress(Key);
  1979.   finally
  1980.     inherited OnKeyPress := nil;
  1981.   end;
  1982. end;
  1983.  
  1984. procedure TRxDBGrid.DefaultDataCellDraw(const Rect: TRect; Field: TField;
  1985.   State: TGridDrawState);
  1986. begin
  1987.   DefaultDrawDataCell(Rect, Field, State);
  1988. end;
  1989.  
  1990. {$IFDEF WIN32}
  1991. function TRxDBGrid.GetMasterColumn(ACol, ARow: Longint): TColumn;
  1992. begin
  1993.   if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
  1994.   if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  1995.     (ACol < Columns.Count) then
  1996.   begin
  1997.     Result := Columns[ACol];
  1998. {$IFDEF RX_D4}
  1999.     Result := ColumnAtDepth(Result, ARow);
  2000. {$ENDIF}
  2001.   end
  2002.   else Result := nil;
  2003. end;
  2004. {$ENDIF}
  2005.  
  2006. procedure TRxDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  2007.   AState: TGridDrawState);
  2008.  
  2009. {$IFDEF RX_D4}
  2010.   function CalcTitleRect(Col: TColumn; ARow: Integer; var MasterCol: TColumn): TRect;
  2011.     { copied from Inprise's DbGrids.pas }
  2012.   var
  2013.     I,J: Integer;
  2014.     InBiDiMode: Boolean;
  2015.     DrawInfo: TGridDrawInfo;
  2016.   begin
  2017.     MasterCol := ColumnAtDepth(Col, ARow);
  2018.     if MasterCol = nil then Exit;
  2019.     I := DataToRawColumn(MasterCol.Index);
  2020.     if I >= LeftCol then J := MasterCol.Depth
  2021.     else begin
  2022.       if (FixedCols > 0) and (MasterCol.Index < FixedCols) then begin
  2023.         J := MasterCol.Depth;
  2024.       end
  2025.       else begin
  2026.         I := LeftCol;
  2027.         if Col.Depth > ARow then J := ARow
  2028.         else J := Col.Depth;
  2029.       end;
  2030.     end;
  2031.     Result := CellRect(I, J);
  2032.     InBiDiMode := UseRightToLeftAlignment and (Canvas.CanvasOrientation = coLeftToRight);
  2033.     for I := Col.Index to Columns.Count - 1 do begin
  2034.       if ColumnAtDepth(Columns[I], ARow) <> MasterCol then Break;
  2035.       if not InBiDiMode then begin
  2036.         J := CellRect(DataToRawColumn(I), ARow).Right;
  2037.         if J = 0 then Break;
  2038.         Result.Right := Max(Result.Right, J);
  2039.       end
  2040.       else begin
  2041.         J := CellRect(DataToRawColumn(I), ARow).Left;
  2042.         if J >= ClientWidth then Break;
  2043.         Result.Left := J;
  2044.       end;
  2045.     end;
  2046.     J := Col.Depth;
  2047.     if (J <= ARow) and (J < FixedRows - 1) then begin
  2048.       CalcFixedInfo(DrawInfo);
  2049.       Result.Bottom := DrawInfo.Vert.FixedBoundary -
  2050.         DrawInfo.Vert.EffectiveLineWidth;
  2051.     end;
  2052.   end;
  2053.  
  2054.   procedure DrawExpandBtn(var TitleRect, TextRect: TRect; InBiDiMode: Boolean;
  2055.     Expanded: Boolean); { copied from Inprise's DbGrids.pas }
  2056.   const
  2057.     ScrollArrows: array [Boolean, Boolean] of Integer =
  2058.       ((DFCS_SCROLLRIGHT, DFCS_SCROLLLEFT), (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT));
  2059.   var
  2060.     ButtonRect: TRect;
  2061.     I: Integer;
  2062.   begin
  2063.     I := GetSystemMetrics(SM_CXHSCROLL);
  2064.     if ((TextRect.Right - TextRect.Left) > I) then begin
  2065.       Dec(TextRect.Right, I);
  2066.       ButtonRect := TitleRect;
  2067.       ButtonRect.Left := TextRect.Right;
  2068.       I := SaveDC(Canvas.Handle);
  2069.       try
  2070.         Canvas.FillRect(ButtonRect);
  2071.         InflateRect(ButtonRect, -1, -1);
  2072.         with ButtonRect do
  2073.           IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
  2074.         InflateRect(ButtonRect, 1, 1);
  2075.         { DrawFrameControl doesn't draw properly when orienatation has changed.
  2076.           It draws as ExtTextOut does. }
  2077.         if InBiDiMode then { stretch the arrows box }
  2078.           Inc(ButtonRect.Right, GetSystemMetrics(SM_CXHSCROLL) + 4);
  2079.         DrawFrameControl(Canvas.Handle, ButtonRect, DFC_SCROLL,
  2080.           ScrollArrows[InBiDiMode, Expanded] or DFCS_FLAT);
  2081.       finally
  2082.         RestoreDC(Canvas.Handle, I);
  2083.       end;
  2084.       TitleRect.Right := ButtonRect.Left;
  2085.     end;
  2086.   end;
  2087. {$ENDIF RX_D4}
  2088.  
  2089. var
  2090.   FrameOffs: Byte;
  2091.   BackColor: TColor;
  2092.   SortMarker: TSortMarker;
  2093.   Indicator, ALeft: Integer;
  2094.   Down: Boolean;
  2095.   Bmp: TBitmap;
  2096.   SavePen: TColor;
  2097.   OldActive: Longint;
  2098.   MultiSelected: Boolean;
  2099.   FixRect: TRect;
  2100.   TitleRect, TextRect: TRect;
  2101.   AField: TField;
  2102. {$IFDEF RX_D4}
  2103.   MasterCol: TColumn;
  2104.   InBiDiMode: Boolean;
  2105. {$ENDIF}
  2106. {$IFDEF WIN32}
  2107.   DrawColumn: TColumn;
  2108. const
  2109.   EdgeFlag: array[Boolean] of UINT = (BDR_RAISEDINNER, BDR_SUNKENINNER);
  2110. {$ENDIF}
  2111. begin
  2112.   inherited DrawCell(ACol, ARow, ARect, AState);
  2113. {$IFDEF RX_D4}
  2114.   InBiDiMode := Canvas.CanvasOrientation = coRightToLeft;
  2115. {$ENDIF}
  2116.   if (dgIndicator in Options) and (ACol = 0) and (ARow - TitleOffset >= 0)
  2117.     and MultiSelect and (DataLink <> nil) and DataLink.Active and
  2118.     (Datalink.DataSet.State = dsBrowse) then
  2119.   begin { draw multiselect indicators if needed }
  2120.     FixRect := ARect;
  2121.     if ([dgRowLines, dgColLines] * Options = [dgRowLines, dgColLines]) then
  2122.     begin
  2123.       InflateRect(FixRect, -1, -1);
  2124.       FrameOffs := 1;
  2125.     end
  2126.     else FrameOffs := 2;
  2127.     OldActive := DataLink.ActiveRecord;
  2128.     try
  2129.       Datalink.ActiveRecord := ARow - TitleOffset;
  2130.       MultiSelected := ActiveRowSelected;
  2131.     finally
  2132.       Datalink.ActiveRecord := OldActive;
  2133.     end;
  2134.     if MultiSelected then begin
  2135.       if (ARow - TitleOffset <> Datalink.ActiveRecord) then Indicator := 0
  2136.       else Indicator := 1;  { multiselected and current row }
  2137. {$IFDEF WIN32}
  2138.       FMsIndicators.BkColor := FixedColor;
  2139. {$ELSE}
  2140.       Canvas.Brush.Color := TitleColor;
  2141.       Canvas.FillRect(FixRect);
  2142. {$ENDIF}
  2143.       ALeft := FixRect.Right - FMsIndicators.Width - FrameOffs;
  2144. {$IFDEF RX_D4}
  2145.       if InBiDiMode then Inc(ALeft);
  2146. {$ENDIF}
  2147.       FMsIndicators.Draw(Self.Canvas, ALeft, (FixRect.Top +
  2148.         FixRect.Bottom - FMsIndicators.Height) shr 1, Indicator);
  2149.     end;
  2150.   end
  2151.   else if not (csLoading in ComponentState) and
  2152.     (FTitleButtons {$IFDEF RX_D4} or (FixedCols > 0) {$ENDIF}) and
  2153.     (gdFixed in AState) and (dgTitles in Options) and (ARow < TitleOffset) then
  2154.   begin
  2155.     SavePen := Canvas.Pen.Color;
  2156.     try
  2157.       Canvas.Pen.Color := clWindowFrame;
  2158.       if (dgIndicator in Options) then Dec(ACol, IndicatorOffset);
  2159.       AField := nil;
  2160.       SortMarker := smNone;
  2161. {$IFDEF WIN32}
  2162.       if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  2163.         (ACol < Columns.Count) then
  2164.       begin
  2165.         DrawColumn := Columns[ACol];
  2166.         AField := DrawColumn.Field;
  2167.       end
  2168.       else DrawColumn := nil;
  2169. {$IFDEF RX_D4}
  2170.       if Assigned(DrawColumn) and not DrawColumn.Showing then Exit;
  2171.       TitleRect := CalcTitleRect(DrawColumn, ARow, MasterCol);
  2172.       if TitleRect.Right < ARect.Right then
  2173.         TitleRect.Right := ARect.Right;
  2174.       if MasterCol = nil then
  2175.         Exit
  2176.       else if MasterCol <> DrawColumn then
  2177.         AField := MasterCol.Field;
  2178.       DrawColumn := MasterCol;
  2179.       if ((dgColLines in Options) or FTitleButtons) and (ACol = FixedCols - 1) then
  2180.       begin
  2181.         if (ACol < Columns.Count - 1) and not (Columns[ACol + 1].Showing) then
  2182.         begin
  2183.           Canvas.MoveTo(TitleRect.Right, TitleRect.Top);
  2184.           Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
  2185.         end;
  2186.       end;
  2187.       if ((dgRowLines in Options) or FTitleButtons) and not MasterCol.Showing then
  2188.       begin
  2189.         Canvas.MoveTo(TitleRect.Left, TitleRect.Bottom);
  2190.         Canvas.LineTo(TitleRect.Right, TitleRect.Bottom);
  2191.       end;
  2192. {$ELSE}
  2193.       TitleRect := ARect;
  2194. {$ENDIF RX_D4}
  2195.       Down := FPressed and FTitleButtons and (FPressedCol = DrawColumn);
  2196.       if FTitleButtons or ([dgRowLines, dgColLines] * Options =
  2197.         [dgRowLines, dgColLines]) then
  2198.       begin
  2199.         DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_BOTTOMRIGHT);
  2200.         DrawEdge(Canvas.Handle, TitleRect, EdgeFlag[Down], BF_TOPLEFT);
  2201.         InflateRect(TitleRect, -1, -1);
  2202.       end;
  2203.       Canvas.Font := TitleFont;
  2204.       Canvas.Brush.Color := FixedColor;
  2205.       if (DrawColumn <> nil) then begin
  2206.         Canvas.Font := DrawColumn.Title.Font;
  2207.         Canvas.Brush.Color := DrawColumn.Title.Color;
  2208.       end;
  2209.       if FTitleButtons and (AField <> nil) and Assigned(FOnGetBtnParams) then
  2210.       begin
  2211.         BackColor := Canvas.Brush.Color;
  2212.         FOnGetBtnParams(Self, AField, Canvas.Font, BackColor, SortMarker, Down);
  2213.         Canvas.Brush.Color := BackColor;
  2214.       end;
  2215.       if Down then begin
  2216.         Inc(TitleRect.Left); Inc(TitleRect.Top);
  2217.       end;
  2218.       ARect := TitleRect;
  2219.       if (DataLink = nil) or not DataLink.Active then
  2220.         Canvas.FillRect(TitleRect)
  2221.       else if (DrawColumn <> nil) then begin
  2222.         case SortMarker of
  2223.           smDown: Bmp := GetGridBitmap(gpMarkDown);
  2224.           smUp: Bmp := GetGridBitmap(gpMarkUp);
  2225.           else Bmp := nil;
  2226.         end;
  2227.         if Bmp <> nil then Indicator := Bmp.Width + 6
  2228.         else Indicator := 1;
  2229.         TextRect := TitleRect;
  2230. {$IFDEF RX_D4}
  2231.         if DrawColumn.Expandable then
  2232.           DrawExpandBtn(TitleRect, TextRect, InBiDiMode, DrawColumn.Expanded);
  2233. {$ENDIF}
  2234.         with DrawColumn.Title do
  2235.           DrawCellText(Self, ACol, ARow, MinimizeText(Caption, Canvas,
  2236.             WidthOf(TextRect) - Indicator), TextRect, Alignment, vaCenter
  2237.             {$IFDEF RX_D4}, IsRightToLeft {$ENDIF});
  2238.         if Bmp <> nil then begin
  2239.           ALeft := TitleRect.Right - Bmp.Width - 3;
  2240.           if Down then Inc(ALeft);
  2241. {$IFDEF RX_D4}
  2242.           if IsRightToLeft then ALeft := TitleRect.Left + 3;
  2243. {$ENDIF}
  2244.           if (ALeft > TitleRect.Left) and (ALeft + Bmp.Width < TitleRect.Right) then
  2245.             DrawBitmapTransparent(Canvas, ALeft, (TitleRect.Bottom +
  2246.               TitleRect.Top - Bmp.Height) div 2, Bmp, clFuchsia);
  2247.         end;
  2248.       end
  2249. {$ELSE WIN32}
  2250.       if not (dgColLines in Options) then begin
  2251.         Canvas.MoveTo(ARect.Right - 1, ARect.Top);
  2252.         Canvas.LineTo(ARect.Right - 1, ARect.Bottom);
  2253.         Dec(ARect.Right);
  2254.       end;
  2255.       if not (dgRowLines in Options) then begin
  2256.         Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
  2257.         Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
  2258.         Dec(ARect.Bottom);
  2259.       end;
  2260.       Down := FPressed and FTitleButtons and (FPressedCol = ACol);
  2261.       if (Datalink <> nil) and Datalink.Active and (ACol >= 0) and
  2262.         (ACol < FieldCount) then
  2263.       begin
  2264.         AField := Fields[ACol];
  2265.       end;
  2266.       if Down then begin
  2267.         with ARect do begin
  2268.           Canvas.Pen.Color := clBtnShadow;
  2269.           Canvas.PolyLine([Point(Left, Bottom - 1), Point(Left, Top),
  2270.             Point(Right, Top)]);
  2271.           Inc(Left, 2); Inc(Top, 2);
  2272.         end;
  2273.       end
  2274.       else Frame3D(Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
  2275.       Canvas.Font := TitleFont;
  2276.       Canvas.Brush.Color := TitleColor;
  2277.       if FTitleButtons and (AField <> nil) and Assigned(FOnGetBtnParams) then
  2278.       begin
  2279.         BackColor := Canvas.Brush.Color;
  2280.         FOnGetBtnParams(Self, AField, Canvas.Font, BackColor, SortMarker, Down);
  2281.         Canvas.Brush.Color := BackColor;
  2282.       end;
  2283.       if (DataLink = nil) or not DataLink.Active then
  2284.         Canvas.FillRect(ARect)
  2285.       else if (AField <> nil) then begin
  2286.         case SortMarker of
  2287.           smDown: Bmp := GetGridBitmap(gpMarkDown);
  2288.           smUp: Bmp := GetGridBitmap(gpMarkUp);
  2289.           else Bmp := nil;
  2290.         end;
  2291.         if Bmp <> nil then Indicator := Bmp.Width + 8
  2292.         else Indicator := 1;
  2293.         DrawCellText(Self, ACol, ARow, MinimizeText(AField.DisplayLabel,
  2294.           Canvas, WidthOf(ARect) - Indicator), ARect, taLeftJustify, vaCenter);
  2295.         if Bmp <> nil then begin
  2296.           ALeft := ARect.Right - Bmp.Width - 4;
  2297.           if Down then Inc(ALeft);
  2298.           DrawBitmapTransparent(Canvas, ALeft,
  2299.             (ARect.Bottom + ARect.Top - Bmp.Height) div 2, Bmp, clFuchsia);
  2300.         end;
  2301.       end
  2302. {$ENDIF WIN32}
  2303.       else DrawCellText(Self, ACol, ARow, '', ARect, taLeftJustify, vaCenter);
  2304.     finally
  2305.       Canvas.Pen.Color := SavePen;
  2306.     end;
  2307.   end
  2308.   else begin
  2309. {$IFDEF RX_D4}
  2310.     Canvas.Font := Self.Font;
  2311.     if (DataLink <> nil) and DataLink.Active and (ACol >= 0) and
  2312.       (ACol < Columns.Count) then
  2313.     begin
  2314.       DrawColumn := Columns[ACol];
  2315.       if DrawColumn <> nil then Canvas.Font := DrawColumn.Font;
  2316.     end;
  2317. {$ENDIF}
  2318.   end;
  2319. end;
  2320.  
  2321. {$IFDEF WIN32}
  2322. procedure TRxDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  2323.   Column: TColumn; State: TGridDrawState);
  2324. {$ELSE}
  2325. procedure TRxDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2326.   State: TGridDrawState);
  2327. {$ENDIF}
  2328. var
  2329.   I: Integer;
  2330.   NewBackgrnd: TColor;
  2331.   Highlight: Boolean;
  2332.   Bmp: TBitmap;
  2333. {$IFDEF WIN32}
  2334.   Field: TField;
  2335. {$ENDIF}
  2336. begin
  2337. {$IFDEF WIN32}
  2338.   Field := Column.Field;
  2339. {$ENDIF}
  2340.   NewBackgrnd := Canvas.Brush.Color;
  2341.   Highlight := (gdSelected in State) and ((dgAlwaysShowSelection in Options) or
  2342.     Focused);
  2343.   GetCellProps(Field, Canvas.Font, NewBackgrnd, Highlight or ActiveRowSelected);
  2344.   Canvas.Brush.Color := NewBackgrnd;
  2345.   if FDefaultDrawing then begin
  2346.     I := GetImageIndex(Field);
  2347.     if I >= 0 then begin
  2348.       Bmp := GetGridBitmap(TGridPicture(I));
  2349.       Canvas.FillRect(Rect);
  2350.       DrawBitmapTransparent(Canvas, (Rect.Left + Rect.Right - Bmp.Width) div 2,
  2351.         (Rect.Top + Rect.Bottom - Bmp.Height) div 2, Bmp, clOlive);
  2352.     end else
  2353. {$IFDEF WIN32}
  2354.     DefaultDrawColumnCell(Rect, DataCol, Column, State);
  2355. {$ELSE}
  2356.     DefaultDrawDataCell(Rect, Field, State);
  2357. {$ENDIF}
  2358.   end;
  2359. {$IFDEF WIN32}
  2360.   if Columns.State = csDefault then
  2361.     inherited DrawDataCell(Rect, Field, State);
  2362.   inherited DrawColumnCell(Rect, DataCol, Column, State);
  2363. {$ELSE}
  2364.   inherited DrawDataCell(Rect, Field, State);
  2365. {$ENDIF}
  2366.   if FDefaultDrawing and Highlight and not (csDesigning in ComponentState)
  2367.     and not (dgRowSelect in Options)
  2368.     and (ValidParentForm(Self).ActiveControl = Self) then
  2369.     Canvas.DrawFocusRect(Rect);
  2370. end;
  2371.  
  2372. {$IFDEF WIN32}
  2373. procedure TRxDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
  2374.   State: TGridDrawState);
  2375. begin
  2376. end;
  2377. {$ENDIF}
  2378.  
  2379. procedure TRxDBGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  2380. var
  2381.   Coord: TGridCoord;
  2382. begin
  2383.   Coord := MouseCoord(X, Y);
  2384.   ACol := Coord.X;
  2385.   ARow := Coord.Y;
  2386. end;
  2387.  
  2388. {$IFDEF WIN32}
  2389.  
  2390. procedure TRxDBGrid.SaveColumnsLayout(IniFile: TObject;
  2391.   const Section: string);
  2392. var
  2393.   I: Integer;
  2394.   S: string;
  2395. begin
  2396.   if Section <> '' then S := Section
  2397.   else S := GetDefaultSection(Self);
  2398.   IniEraseSection(IniFile, S);
  2399.   with Columns do begin
  2400.     for I := 0 to Count - 1 do begin
  2401.       IniWriteString(IniFile, S, Format('%s.%s', [Name, Items[I].FieldName]),
  2402.         Format('%d,%d', [Items[I].Index, Items[I].Width]));
  2403.     end;
  2404.   end;
  2405. end;
  2406.  
  2407. procedure TRxDBGrid.RestoreColumnsLayout(IniFile: TObject;
  2408.   const Section: string);
  2409. type
  2410.   TColumnInfo = record
  2411.     Column: TColumn;
  2412.     EndIndex: Integer;
  2413.   end;
  2414.   PColumnArray = ^TColumnArray;
  2415.   TColumnArray = array[0..0] of TColumnInfo;
  2416. const
  2417.   Delims = [' ',','];
  2418. var
  2419.   I, J: Integer;
  2420.   SectionName, S: string;
  2421.   ColumnArray: PColumnArray;
  2422. begin
  2423.   if Section <> '' then SectionName := Section
  2424.   else SectionName := GetDefaultSection(Self);
  2425.   with Columns do begin
  2426.     ColumnArray := AllocMemo(Count * SizeOf(TColumnInfo));
  2427.     try
  2428.       for I := 0 to Count - 1 do begin
  2429.         S := IniReadString(IniFile, SectionName,
  2430.           Format('%s.%s', [Name, Items[I].FieldName]), '');
  2431.         ColumnArray^[I].Column := Items[I];
  2432.         ColumnArray^[I].EndIndex := Items[I].Index;
  2433.         if S <> '' then begin
  2434.           ColumnArray^[I].EndIndex := StrToIntDef(ExtractWord(1, S, Delims),
  2435.             ColumnArray^[I].EndIndex);
  2436.           Items[I].Width := StrToIntDef(ExtractWord(2, S, Delims),
  2437.             Items[I].Width);
  2438.         end;
  2439.       end;
  2440.       for I := 0 to Count - 1 do begin
  2441.         for J := 0 to Count - 1 do begin
  2442.           if ColumnArray^[J].EndIndex = I then begin
  2443.             ColumnArray^[J].Column.Index := ColumnArray^[J].EndIndex;
  2444.             Break;
  2445.           end;
  2446.         end;
  2447.       end;
  2448.     finally
  2449.       FreeMemo(Pointer(ColumnArray));
  2450.     end;
  2451.   end;
  2452. end;
  2453.  
  2454. procedure TRxDBGrid.SaveLayoutReg(IniFile: TRegIniFile);
  2455. begin
  2456.   InternalSaveLayout(IniFile, '');
  2457. end;
  2458.  
  2459. procedure TRxDBGrid.RestoreLayoutReg(IniFile: TRegIniFile);
  2460. begin
  2461.   InternalRestoreLayout(IniFile, '');
  2462. end;
  2463.  
  2464. {$ENDIF WIN32}
  2465.  
  2466. procedure TRxDBGrid.InternalSaveLayout(IniFile: TObject;
  2467.   const Section: string);
  2468. begin
  2469.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then
  2470. {$IFDEF WIN32}
  2471.     if StoreColumns then SaveColumnsLayout(IniFile, Section) else
  2472. {$ENDIF}
  2473.     InternalSaveFields(DataSource.DataSet, IniFile, Section);
  2474. end;
  2475.  
  2476. procedure TRxDBGrid.InternalRestoreLayout(IniFile: TObject;
  2477.   const Section: string);
  2478. begin
  2479.   if (DataSource <> nil) and (DataSource.DataSet <> nil) then begin
  2480.     HandleNeeded;
  2481. {$IFDEF WIN32}
  2482.     BeginLayout;
  2483.     try
  2484.       if StoreColumns then RestoreColumnsLayout(IniFile, Section) else
  2485. {$ENDIF}
  2486.       InternalRestoreFields(DataSource.DataSet, IniFile, Section, False);
  2487. {$IFDEF WIN32}
  2488.     finally
  2489.       EndLayout;
  2490.     end;
  2491. {$ENDIF}
  2492.   end;
  2493. end;
  2494.  
  2495. procedure TRxDBGrid.SaveLayout(IniFile: TIniFile);
  2496. begin
  2497.   InternalSaveLayout(IniFile, '');
  2498. end;
  2499.  
  2500. procedure TRxDBGrid.RestoreLayout(IniFile: TIniFile);
  2501. begin
  2502.   InternalRestoreLayout(IniFile, '');
  2503. end;
  2504.  
  2505. procedure TRxDBGrid.IniSave(Sender: TObject);
  2506. var
  2507.   Section: string;
  2508. begin
  2509.   if (Name <> '') and (FIniLink.IniObject <> nil) then begin
  2510. {$IFDEF WIN32}
  2511.     if StoreColumns then
  2512.       Section := FIniLink.RootSection + GetDefaultSection(Self) else
  2513. {$ENDIF}
  2514.     if (FIniLink.RootSection <> '') and (DataSource <> nil) and
  2515.       (DataSource.DataSet <> nil) then
  2516.       Section := FIniLink.RootSection + DataSetSectionName(DataSource.DataSet)
  2517.     else Section := '';
  2518.     InternalSaveLayout(FIniLink.IniObject, Section);
  2519.   end;
  2520. end;
  2521.  
  2522. procedure TRxDBGrid.IniLoad(Sender: TObject);
  2523. var
  2524.   Section: string;
  2525. begin
  2526.   if (Name <> '') and (FIniLink.IniObject <> nil) then begin
  2527. {$IFDEF WIN32}
  2528.     if StoreColumns then
  2529.       Section := FIniLink.RootSection + GetDefaultSection(Self) else
  2530. {$ENDIF}
  2531.     if (FIniLink.RootSection <> '') and (DataSource <> nil) and
  2532.       (DataSource.DataSet <> nil) then
  2533.       Section := FIniLink.RootSection + DataSetSectionName(DataSource.DataSet)
  2534.     else Section := '';
  2535.     InternalRestoreLayout(FIniLink.IniObject, Section);
  2536.   end;
  2537. end;
  2538.  
  2539. { TRxDBComboEdit }
  2540.  
  2541. procedure ResetMaxLength(DBEdit: TRxDBComboEdit);
  2542. var
  2543.   F: TField;
  2544. begin
  2545.   with DBEdit do
  2546.     if (MaxLength > 0) and (DataSource <> nil) and
  2547.       (DataSource.DataSet <> nil) then
  2548.     begin
  2549.       F := DataSource.DataSet.FindField(DataField);
  2550.       if Assigned(F) and (F.DataType = ftString) and
  2551.         (F.Size = MaxLength) then MaxLength := 0;
  2552.     end;
  2553. end;
  2554.  
  2555. constructor TRxDBComboEdit.Create(AOwner: TComponent);
  2556. begin
  2557.   inherited Create(AOwner);
  2558. {$IFDEF WIN32}
  2559.   ControlStyle := ControlStyle + [csReplicatable];
  2560. {$ENDIF}
  2561.   inherited ReadOnly := True;
  2562.   FDataLink := TFieldDataLink.Create;
  2563.   FDataLink.Control := Self;
  2564.   FDataLink.OnDataChange := DataChange;
  2565.   FDataLink.OnEditingChange := EditingChange;
  2566.   FDataLink.OnUpdateData := UpdateData;
  2567.   AlwaysEnable := True;
  2568. end;
  2569.  
  2570. destructor TRxDBComboEdit.Destroy;
  2571. begin
  2572.   FDataLink.Free;
  2573.   FDataLink := nil;
  2574. {$IFDEF WIN32}
  2575.   FCanvas.Free;
  2576. {$ENDIF}
  2577.   inherited Destroy;
  2578. end;
  2579.  
  2580. procedure TRxDBComboEdit.Loaded;
  2581. begin
  2582.   inherited Loaded;
  2583.   ResetMaxLength(Self);
  2584.   if (csDesigning in ComponentState) then DataChange(Self);
  2585. end;
  2586.  
  2587. procedure TRxDBComboEdit.Notification(AComponent: TComponent;
  2588.   Operation: TOperation);
  2589. begin
  2590.   inherited Notification(AComponent, Operation);
  2591.   if (Operation = opRemove) and (FDataLink <> nil) and
  2592.     (AComponent = DataSource) then DataSource := nil;
  2593. end;
  2594.  
  2595. procedure TRxDBComboEdit.KeyDown(var Key: Word; Shift: TShiftState);
  2596. begin
  2597.   inherited KeyDown(Key, Shift);
  2598.   if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  2599.     FDataLink.Edit;
  2600. end;
  2601.  
  2602. procedure TRxDBComboEdit.KeyPress(var Key: Char);
  2603. begin
  2604.   inherited KeyPress(Key);
  2605.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  2606.     not FDataLink.Field.IsValidChar(Key) then
  2607.   begin
  2608.     Beep;
  2609.     Key := #0;
  2610.   end;
  2611.   case Key of
  2612.     ^H, ^V, ^X, #32..#255:
  2613.       FDataLink.Edit;
  2614.     #27:
  2615.       begin
  2616.         FDataLink.Reset;
  2617.         SelectAll;
  2618.         Key := #0;
  2619.       end;
  2620.   end;
  2621. end;
  2622.  
  2623. function TRxDBComboEdit.EditCanModify: Boolean;
  2624. begin
  2625.   Result := FDataLink.Edit;
  2626. end;
  2627.  
  2628. procedure TRxDBComboEdit.Reset;
  2629. begin
  2630.   FDataLink.Reset;
  2631.   SelectAll;
  2632. end;
  2633.  
  2634. procedure TRxDBComboEdit.SetFocused(Value: Boolean);
  2635. begin
  2636.   if FFocused <> Value then begin
  2637.     FFocused := Value;
  2638.     if (Alignment <> taLeftJustify) and not IsMasked then Invalidate;
  2639.     FDataLink.Reset;
  2640.   end;
  2641. end;
  2642.  
  2643. procedure TRxDBComboEdit.Change;
  2644. begin
  2645.   FDataLink.Modified;
  2646.   inherited Change;
  2647. end;
  2648.  
  2649. function TRxDBComboEdit.GetDataSource: TDataSource;
  2650. begin
  2651.   Result := FDataLink.DataSource;
  2652. end;
  2653.  
  2654. procedure TRxDBComboEdit.SetDataSource(Value: TDataSource);
  2655. begin
  2656. {$IFDEF RX_D4}
  2657.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  2658. {$ENDIF}
  2659.     FDataLink.DataSource := Value;
  2660. {$IFDEF WIN32}
  2661.   if Value <> nil then Value.FreeNotification(Self);
  2662. {$ENDIF}
  2663. end;
  2664.  
  2665. function TRxDBComboEdit.GetDataField: string;
  2666. begin
  2667.   Result := FDataLink.FieldName;
  2668. end;
  2669.  
  2670. procedure TRxDBComboEdit.SetDataField(const Value: string);
  2671. begin
  2672.   if not (csDesigning in ComponentState) then ResetMaxLength(Self);
  2673.   FDataLink.FieldName := Value;
  2674. end;
  2675.  
  2676. function TRxDBComboEdit.GetReadOnly: Boolean;
  2677. begin
  2678.   Result := FDataLink.ReadOnly;
  2679. end;
  2680.  
  2681. procedure TRxDBComboEdit.SetReadOnly(Value: Boolean);
  2682. begin
  2683.   FDataLink.ReadOnly := Value;
  2684. end;
  2685.  
  2686. function TRxDBComboEdit.GetField: TField;
  2687. begin
  2688.   Result := FDataLink.Field;
  2689. end;
  2690.  
  2691. procedure TRxDBComboEdit.DataChange(Sender: TObject);
  2692. begin
  2693.   if FDataLink.Field <> nil then begin
  2694.     if Alignment <> FDataLink.Field.Alignment then begin
  2695.       EditText := '';  {forces update}
  2696.       Alignment := FDataLink.Field.Alignment;
  2697.     end;
  2698.     EditMask := FDataLink.Field.EditMask;
  2699.     if not (csDesigning in ComponentState) then begin
  2700.       if (FDataLink.Field.DataType = ftString) and (MaxLength = 0) then
  2701.         MaxLength := FDataLink.Field.Size;
  2702.     end;
  2703.     if FFocused and FDataLink.CanModify then
  2704.       Text := FDataLink.Field.Text
  2705.     else begin
  2706.       EditText := FDataLink.Field.DisplayText;
  2707.       {if FDataLink.Editing then Modified := True;}
  2708.     end;
  2709.   end
  2710.   else begin
  2711.     Alignment := taLeftJustify;
  2712.     EditMask := '';
  2713.     if csDesigning in ComponentState then EditText := Name
  2714.     else EditText := '';
  2715.   end;
  2716. end;
  2717.  
  2718. procedure TRxDBComboEdit.EditingChange(Sender: TObject);
  2719. begin
  2720.   inherited ReadOnly := not FDataLink.Editing;
  2721. end;
  2722.  
  2723. procedure TRxDBComboEdit.UpdateData(Sender: TObject);
  2724. begin
  2725.   ValidateEdit;
  2726.   FDataLink.Field.Text := Text;
  2727. end;
  2728.  
  2729. procedure TRxDBComboEdit.WMPaste(var Message: TMessage);
  2730. begin
  2731.   FDataLink.Edit;
  2732.   inherited;
  2733. end;
  2734.  
  2735. procedure TRxDBComboEdit.WMCut(var Message: TMessage);
  2736. begin
  2737.   FDataLink.Edit;
  2738.   inherited;
  2739. end;
  2740.  
  2741. procedure TRxDBComboEdit.CMEnter(var Message: TCMEnter);
  2742. begin
  2743.   SetFocused(True);
  2744.   inherited;
  2745. {$IFDEF RX_D3}
  2746.   if SysLocale.FarEast and FDataLink.CanModify then
  2747.     inherited ReadOnly := False;
  2748. {$ENDIF}
  2749. end;
  2750.  
  2751. procedure TRxDBComboEdit.CMExit(var Message: TCMExit);
  2752. begin
  2753.   try
  2754.     FDataLink.UpdateRecord;
  2755.   except
  2756.     SelectAll;
  2757.     if CanFocus then SetFocus;
  2758.     raise;
  2759.   end;
  2760.   SetFocused(False);
  2761.   CheckCursor;
  2762.   DoExit;
  2763. end;
  2764.  
  2765. {$IFDEF WIN32}
  2766. procedure TRxDBComboEdit.WMPaint(var Message: TWMPaint);
  2767. var
  2768.   S: string;
  2769. begin
  2770.   if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then
  2771.   begin
  2772.     S := FDataLink.Field.DisplayText;
  2773.     case CharCase of
  2774.       ecUpperCase: S := AnsiUpperCase(S);
  2775.       ecLowerCase: S := AnsiLowerCase(S);
  2776.     end;
  2777.   end
  2778.   else S := EditText;
  2779.   if not PaintComboEdit(Self, S, Alignment, True, FCanvas, Message) then
  2780.     inherited;
  2781. end;
  2782.  
  2783. procedure TRxDBComboEdit.CMGetDataLink(var Message: TMessage);
  2784. begin
  2785.   Message.Result := Integer(FDataLink);
  2786. end;
  2787. {$ENDIF}
  2788.  
  2789. {$IFDEF RX_D4}
  2790. function TRxDBComboEdit.UseRightToLeftAlignment: Boolean;
  2791. begin
  2792.   Result := DBUseRightToLeftAlignment(Self, Field);
  2793. end;
  2794.  
  2795. function TRxDBComboEdit.ExecuteAction(Action: TBasicAction): Boolean;
  2796. begin
  2797.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  2798.     FDataLink.ExecuteAction(Action);
  2799. end;
  2800.  
  2801. function TRxDBComboEdit.UpdateAction(Action: TBasicAction): Boolean;
  2802. begin
  2803.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  2804.     FDataLink.UpdateAction(Action);
  2805. end;
  2806. {$ENDIF}
  2807.  
  2808. { TDBDateEdit }
  2809.  
  2810. constructor TDBDateEdit.Create(AOwner: TComponent);
  2811. begin
  2812.   inherited Create(AOwner);
  2813. {$IFDEF WIN32}
  2814.   ControlStyle := ControlStyle + [csReplicatable];
  2815. {$ENDIF}
  2816.   inherited ReadOnly := True;
  2817.   FDataLink := TFieldDataLink.Create;
  2818.   FDataLink.Control := Self;
  2819.   FDataLink.OnDataChange := DataChange;
  2820.   FDataLink.OnEditingChange := EditingChange;
  2821.   FDataLink.OnUpdateData := UpdateData;
  2822.   Self.OnAcceptDate := AfterPopup;
  2823.   AlwaysEnable := True;
  2824.   UpdateMask;
  2825. end;
  2826.  
  2827. destructor TDBDateEdit.Destroy;
  2828. begin
  2829.   FDataLink.Free;
  2830.   FDataLink := nil;
  2831. {$IFDEF WIN32}
  2832.   FCanvas.Free;
  2833. {$ENDIF}
  2834.   inherited Destroy;
  2835. end;
  2836.  
  2837. procedure TDBDateEdit.AfterPopup(Sender: TObject; var Date: TDateTime;
  2838.   var Action: Boolean);
  2839. begin
  2840.   Action := Action and (DataSource <> nil) and (DataSource.DataSet <> nil) and
  2841.     DataSource.DataSet.CanModify;
  2842.   if Action then Action := EditCanModify;
  2843. end;
  2844.  
  2845. procedure TDBDateEdit.Notification(AComponent: TComponent;
  2846.   Operation: TOperation);
  2847. begin
  2848.   inherited Notification(AComponent, Operation);
  2849.   if (Operation = opRemove) and (FDataLink <> nil) and
  2850.     (AComponent = DataSource) then DataSource := nil;
  2851. end;
  2852.  
  2853. procedure TDBDateEdit.KeyDown(var Key: Word; Shift: TShiftState);
  2854. begin
  2855.   inherited KeyDown(Key, Shift);
  2856.   if not ReadOnly and ((Key = VK_DELETE) or ((Key = VK_INSERT)
  2857.     and (ssShift in Shift))) then
  2858.     FDataLink.Edit;
  2859. end;
  2860.  
  2861. procedure TDBDateEdit.KeyPress(var Key: Char);
  2862. begin
  2863.   inherited KeyPress(Key);
  2864.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  2865.     not (Key in ['0'..'9']) and (Key <> DateSeparator) then
  2866.   begin
  2867.     Beep;
  2868.     Key := #0;
  2869.   end;
  2870.   case Key of
  2871.     ^H, ^V, ^X, '0'..'9': FDataLink.Edit;
  2872.     #27:
  2873.       begin
  2874.         Reset;
  2875.         Key := #0;
  2876.       end;
  2877.   end;
  2878. end;
  2879.  
  2880. function TDBDateEdit.EditCanModify: Boolean;
  2881. begin
  2882.   Result := FDataLink.Edit;
  2883. end;
  2884.  
  2885. procedure TDBDateEdit.Reset;
  2886. begin
  2887.   FDataLink.Reset;
  2888.   SelectAll;
  2889. end;
  2890.  
  2891. procedure TDBDateEdit.Change;
  2892. begin
  2893.   if not Formatting then FDataLink.Modified;
  2894.   inherited Change;
  2895. end;
  2896.  
  2897. function TDBDateEdit.GetDataSource: TDataSource;
  2898. begin
  2899.   Result := FDataLink.DataSource;
  2900. end;
  2901.  
  2902. procedure TDBDateEdit.SetDataSource(Value: TDataSource);
  2903. begin
  2904. {$IFDEF RX_D4}
  2905.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  2906. {$ENDIF}
  2907.     FDataLink.DataSource := Value;
  2908. {$IFDEF WIN32}
  2909.   if Value <> nil then Value.FreeNotification(Self);
  2910. {$ENDIF}
  2911. end;
  2912.  
  2913. function TDBDateEdit.GetDataField: string;
  2914. begin
  2915.   Result := FDataLink.FieldName;
  2916. end;
  2917.  
  2918. procedure TDBDateEdit.SetDataField(const Value: string);
  2919. begin
  2920.   FDataLink.FieldName := Value;
  2921. end;
  2922.  
  2923. function TDBDateEdit.GetReadOnly: Boolean;
  2924. begin
  2925.   Result := FDataLink.ReadOnly;
  2926. end;
  2927.  
  2928. procedure TDBDateEdit.SetReadOnly(Value: Boolean);
  2929. begin
  2930.   FDataLink.ReadOnly := Value;
  2931. end;
  2932.  
  2933. function TDBDateEdit.GetField: TField;
  2934. begin
  2935.   Result := FDataLink.Field;
  2936. end;
  2937.  
  2938. procedure TDBDateEdit.UpdateMask;
  2939. begin
  2940.   UpdateFormat;
  2941.   UpdatePopup;
  2942.   DataChange(nil);
  2943. end;
  2944.  
  2945. procedure TDBDateEdit.DataChange(Sender: TObject);
  2946. begin
  2947.   if FDataLink.Field <> nil then begin
  2948.     EditMask := GetDateMask;
  2949.     Self.Date := FDataLink.Field.AsDateTime;
  2950.   end
  2951.   else begin
  2952.     if csDesigning in ComponentState then begin
  2953.       EditMask := '';
  2954.       EditText := Name;
  2955.     end
  2956.     else begin
  2957.       EditMask := GetDateMask;
  2958.       if DefaultToday then Date := SysUtils.Date
  2959.       else Date := NullDate;
  2960.     end;
  2961.   end;
  2962. end;
  2963.  
  2964. procedure TDBDateEdit.EditingChange(Sender: TObject);
  2965. begin
  2966.   inherited ReadOnly := not FDataLink.Editing;
  2967.   if FDataLink.Editing and DefaultToday and (FDataLink.Field <> nil) and
  2968.     (FDataLink.Field.AsDateTime = NullDate) then
  2969.     FDataLink.Field.AsDateTime := SysUtils.Now;
  2970. end;
  2971.  
  2972. procedure TDBDateEdit.UpdateData(Sender: TObject);
  2973. var
  2974.   D: TDateTime;
  2975. begin
  2976.   ValidateEdit;
  2977.   D := Self.Date;
  2978.   if D <> NullDate then
  2979.     FDataLink.Field.AsDateTime := D + Frac(FDataLink.Field.AsDateTime)
  2980.   else FDataLink.Field.Clear;
  2981. end;
  2982.  
  2983. {$IFDEF WIN32}
  2984. procedure TDBDateEdit.CMGetDataLink(var Message: TMessage);
  2985. begin
  2986.   Message.Result := Integer(FDataLink);
  2987. end;
  2988.  
  2989. procedure TDBDateEdit.WMPaint(var Message: TWMPaint);
  2990. var
  2991.   S: string;
  2992. begin
  2993.   if (csPaintCopy in ControlState) and (FDataLink.Field <> nil) then begin
  2994.     if FDataLink.Field.IsNull then begin
  2995.       S := GetDateFormat;
  2996.       S := ReplaceStr(ReplaceStr(ReplaceStr(ReplaceStr(S, '/', DateSeparator),
  2997.         'Y', ' '), 'M', ' '), 'D', ' ');
  2998.     end
  2999.     else
  3000.       S := FormatDateTime(GetDateFormat, FDataLink.Field.AsDateTime);
  3001.   end else S := EditText;
  3002.   if not PaintComboEdit(Self, S, Alignment, True, FCanvas, Message) then
  3003.     inherited;
  3004. end;
  3005.  
  3006. procedure TDBDateEdit.AcceptValue(const Value: Variant);
  3007. begin
  3008.   if VarIsNull(Value) or VarIsEmpty(Value) then FDataLink.Field.Clear
  3009.   else FDataLink.Field.AsDateTime :=
  3010.     VarToDateTime(Value) + Frac(FDataLink.Field.AsDateTime);
  3011.   DoChange;
  3012. end;
  3013. {$ENDIF}
  3014.  
  3015. procedure TDBDateEdit.ApplyDate(Value: TDateTime);
  3016. begin
  3017.   FDataLink.Edit;
  3018.   inherited ApplyDate(Value);
  3019. end;
  3020.  
  3021. procedure TDBDateEdit.WMPaste(var Message: TMessage);
  3022. begin
  3023.   FDataLink.Edit;
  3024.   inherited;
  3025. end;
  3026.  
  3027. procedure TDBDateEdit.WMCut(var Message: TMessage);
  3028. begin
  3029.   FDataLink.Edit;
  3030.   inherited;
  3031. end;
  3032.  
  3033. procedure TDBDateEdit.CMEnter(var Message: TCMEnter);
  3034. begin
  3035.   inherited;
  3036. end;
  3037.  
  3038. procedure TDBDateEdit.CMExit(var Message: TCMExit);
  3039. begin
  3040.   try
  3041.     if not (csDesigning in ComponentState) and CheckOnExit then
  3042.       CheckValidDate;
  3043.     FDataLink.UpdateRecord;
  3044.   except
  3045.     SelectAll;
  3046.     if CanFocus then SetFocus;
  3047.     raise;
  3048.   end;
  3049.   CheckCursor;
  3050.   DoExit;
  3051. end;
  3052.  
  3053. {$IFDEF RX_D4}
  3054. function TDBDateEdit.UseRightToLeftAlignment: Boolean;
  3055. begin
  3056.   Result := DBUseRightToLeftAlignment(Self, Field);
  3057. end;
  3058.  
  3059. function TDBDateEdit.ExecuteAction(Action: TBasicAction): Boolean;
  3060. begin
  3061.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  3062.     FDataLink.ExecuteAction(Action);
  3063. end;
  3064.  
  3065. function TDBDateEdit.UpdateAction(Action: TBasicAction): Boolean;
  3066. begin
  3067.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  3068.     FDataLink.UpdateAction(Action);
  3069. end;
  3070. {$ENDIF}
  3071.  
  3072. { TRxDBCalcEdit }
  3073.  
  3074. constructor TRxDBCalcEdit.Create(AOwner: TComponent);
  3075. begin
  3076.   inherited Create(AOwner);
  3077. {$IFDEF WIN32}
  3078.   ControlStyle := ControlStyle + [csReplicatable];
  3079. {$ENDIF}
  3080.   inherited ReadOnly := True;
  3081.   FDataLink := TFieldDataLink.Create;
  3082.   FDataLink.Control := Self;
  3083.   FDataLink.OnDataChange := DataChange;
  3084.   FDataLink.OnEditingChange := EditingChange;
  3085.   FDataLink.OnUpdateData := UpdateFieldData;
  3086.   AlwaysEnable := True;
  3087. end;
  3088.  
  3089. destructor TRxDBCalcEdit.Destroy;
  3090. begin
  3091.   FDataLink.Free;
  3092.   FDataLink := nil;
  3093.   inherited Destroy;
  3094. end;
  3095.  
  3096. procedure TRxDBCalcEdit.Notification(AComponent: TComponent;
  3097.   Operation: TOperation);
  3098. begin
  3099.   inherited Notification(AComponent, Operation);
  3100.   if (Operation = opRemove) and (FDataLink <> nil) and
  3101.     (AComponent = DataSource) then DataSource := nil;
  3102. end;
  3103.  
  3104. procedure TRxDBCalcEdit.KeyDown(var Key: Word; Shift: TShiftState);
  3105. begin
  3106.   inherited KeyDown(Key, Shift);
  3107.   if not ReadOnly and ((Key = VK_DELETE) or ((Key = VK_INSERT)
  3108.     and (ssShift in Shift))) then FDataLink.Edit;
  3109. end;
  3110.  
  3111. procedure TRxDBCalcEdit.KeyPress(var Key: Char);
  3112. begin
  3113.   inherited KeyPress(Key);
  3114.   case Key of
  3115.     ^H, ^V, ^X, #32..#255:
  3116.       if not PopupVisible then FDataLink.Edit;
  3117.     #27:
  3118.       begin
  3119.         FDataLink.Reset;
  3120.         SelectAll;
  3121.         Key := #0;
  3122.       end;
  3123.   end;
  3124. end;
  3125.  
  3126. function TRxDBCalcEdit.IsValidChar(Key: Char): Boolean;
  3127. begin
  3128.   Result := inherited IsValidChar(Key);
  3129.   if Result and (FDatalink.Field <> nil) then
  3130.     Result := FDatalink.Field.IsValidChar(Key);
  3131. end;
  3132.  
  3133. procedure TRxDBCalcEdit.UpdatePopup;
  3134. var
  3135.   Precision: Byte;
  3136. begin
  3137.   Precision := DefCalcPrecision;
  3138.   if (FDatalink <> nil) and (FDatalink.Field <> nil) and
  3139.     (FDatalink.Field is TFloatField) then
  3140.     Precision := TFloatField(FDatalink.Field).Precision;
  3141.   if FPopup <> nil then
  3142.     SetupPopupCalculator(FPopup, Precision, BeepOnError);
  3143. end;
  3144.  
  3145. function TRxDBCalcEdit.EditCanModify: Boolean;
  3146. begin
  3147.   Result := FDataLink.Edit;
  3148. end;
  3149.  
  3150. {$IFDEF WIN32}
  3151. function TRxDBCalcEdit.GetDisplayText: string;
  3152. var
  3153.   E: Extended;
  3154. begin
  3155.   if (csPaintCopy in ControlState) and (FDatalink.Field <> nil) then begin
  3156.     if FDataLink.Field.IsNull then E := 0.0
  3157.     else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3158.       E := FDataLink.Field.AsInteger
  3159.     else if FDataLink.Field.DataType = ftBoolean then
  3160.       E := Ord(FDataLink.Field.AsBoolean)
  3161. {$IFDEF RX_D4}
  3162.     else if FDataLink.Field is TLargeintField then
  3163.       E := TLargeintField(FDataLink.Field).AsLargeInt
  3164. {$ENDIF}
  3165.     else E := FDataLink.Field.AsFloat;
  3166.     if FDataLink.Field.IsNull then Result := ''
  3167.     else Result := FormatDisplayText(E);
  3168.   end
  3169.   else begin
  3170.     if (FDataLink.Field = nil) then begin
  3171.       if (csDesigning in ComponentState) then Result := Format('(%s)', [Name])
  3172.       else Result := '';
  3173.     end
  3174.     else Result := inherited GetDisplayText;
  3175.   end;
  3176. end;
  3177. {$ENDIF}
  3178.  
  3179. procedure TRxDBCalcEdit.Reset;
  3180. begin
  3181.   FDataLink.Reset;
  3182.   inherited Reset;
  3183. end;
  3184.  
  3185. procedure TRxDBCalcEdit.Change;
  3186. begin
  3187.   if not Formatting then FDataLink.Modified;
  3188.   inherited Change;
  3189. end;
  3190.  
  3191. function TRxDBCalcEdit.GetDataSource: TDataSource;
  3192. begin
  3193.   Result := FDataLink.DataSource;
  3194. end;
  3195.  
  3196. procedure TRxDBCalcEdit.SetDataSource(Value: TDataSource);
  3197. begin
  3198.   if FDataLink.DataSource <> Value then begin
  3199. {$IFDEF RX_D4}
  3200.     if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  3201. {$ENDIF}
  3202.       FDataLink.DataSource := Value;
  3203. {$IFDEF WIN32}
  3204.     if Value <> nil then Value.FreeNotification(Self);
  3205. {$ENDIF}
  3206.     UpdateFieldParams;
  3207.   end;
  3208. end;
  3209.  
  3210. function TRxDBCalcEdit.GetDataField: string;
  3211. begin
  3212.   Result := FDataLink.FieldName;
  3213. end;
  3214.  
  3215. procedure TRxDBCalcEdit.SetDataField(const Value: string);
  3216. begin
  3217.   if FDataLink.FieldName <> Value then begin
  3218.     FDataLink.FieldName := Value;
  3219.     UpdateFieldParams;
  3220.   end;
  3221. end;
  3222.  
  3223. procedure TRxDBCalcEdit.SetDefaultParams(Value: Boolean);
  3224. begin
  3225.   if DefaultParams <> Value then begin
  3226.     FDefaultParams := Value;
  3227.     if FDefaultParams then UpdateFieldParams;
  3228.   end;
  3229. end;
  3230.  
  3231. procedure TRxDBCalcEdit.UpdateFieldParams;
  3232. begin
  3233.   if FDatalink.Field <> nil then begin
  3234.     if FDatalink.Field is TNumericField then begin
  3235.       if TNumericField(FDatalink.Field).DisplayFormat <> '' then
  3236.         DisplayFormat := TNumericField(FDatalink.Field).DisplayFormat;
  3237.       Alignment := TNumericField(FDatalink.Field).Alignment;
  3238.     end;
  3239. {$IFDEF RX_D4}
  3240.     if FDatalink.Field is TLargeintField then begin
  3241.       MaxValue := TLargeintField(FDatalink.Field).MaxValue;
  3242.       MinValue := TLargeintField(FDatalink.Field).MinValue;
  3243.       DecimalPlaces := 0;
  3244.       if DisplayFormat = '' then DisplayFormat := ',#';
  3245.     end else
  3246. {$ENDIF}
  3247.     if FDatalink.Field is TIntegerField then begin
  3248.       MaxValue := TIntegerField(FDatalink.Field).MaxValue;
  3249.       MinValue := TIntegerField(FDatalink.Field).MinValue;
  3250.       DecimalPlaces := 0;
  3251.       if DisplayFormat = '' then DisplayFormat := ',#';
  3252.     end
  3253. {$IFDEF WIN32}
  3254.     else if FDatalink.Field is TBCDField then begin
  3255.       MaxValue := TBCDField(FDatalink.Field).MaxValue;
  3256.       MinValue := TBCDField(FDatalink.Field).MinValue;
  3257.     end
  3258. {$ENDIF}
  3259.     else if FDatalink.Field is TFloatField then begin
  3260.       MaxValue := TFloatField(FDatalink.Field).MaxValue;
  3261.       MinValue := TFloatField(FDatalink.Field).MinValue;
  3262.       DecimalPlaces := TFloatField(FDatalink.Field).Precision;
  3263.     end
  3264.     else if FDatalink.Field is TBooleanField then begin
  3265.       MinValue := 0;
  3266.       MaxValue := 1;
  3267.       DecimalPlaces := 0;
  3268.       if DisplayFormat = '' then DisplayFormat := ',#';
  3269.     end;
  3270.   end;
  3271.   UpdatePopup;
  3272. end;
  3273.  
  3274. function TRxDBCalcEdit.GetReadOnly: Boolean;
  3275. begin
  3276.   Result := FDataLink.ReadOnly;
  3277. end;
  3278.  
  3279. procedure TRxDBCalcEdit.SetReadOnly(Value: Boolean);
  3280. begin
  3281.   FDataLink.ReadOnly := Value;
  3282. end;
  3283.  
  3284. function TRxDBCalcEdit.GetField: TField;
  3285. begin
  3286.   Result := FDataLink.Field;
  3287. end;
  3288.  
  3289. procedure TRxDBCalcEdit.DataChange(Sender: TObject);
  3290. begin
  3291.   if FDefaultParams then UpdateFieldParams;
  3292.   if FDataLink.Field <> nil then begin
  3293.     if FDataLink.Field.IsNull then begin
  3294.       Self.Value := 0.0;
  3295.       EditText := '';
  3296.     end
  3297.     else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3298.       Self.AsInteger := FDataLink.Field.AsInteger
  3299.     else if FDataLink.Field.DataType = ftBoolean then
  3300.       Self.AsInteger := Ord(FDataLink.Field.AsBoolean)
  3301. {$IFDEF RX_D4}
  3302.     else if FDataLink.Field is TLargeintField then
  3303.       Self.Value := TLargeintField(FDataLink.Field).AsLargeInt
  3304. {$ENDIF}
  3305.     else Self.Value := FDataLink.Field.AsFloat;
  3306.     DataChanged;
  3307.   end
  3308.   else begin
  3309.     if csDesigning in ComponentState then begin
  3310.       Self.Value := 0;
  3311.       EditText := Format('(%s)', [Name]);
  3312.     end
  3313.     else Self.Value := 0;
  3314.   end;
  3315. end;
  3316.  
  3317. procedure TRxDBCalcEdit.EditingChange(Sender: TObject);
  3318. begin
  3319.   inherited ReadOnly := not FDataLink.Editing;
  3320. end;
  3321.  
  3322. procedure TRxDBCalcEdit.UpdateFieldData(Sender: TObject);
  3323. begin
  3324.   inherited UpdateData;
  3325.   if (Value = 0) and ZeroEmpty then FDataLink.Field.Clear
  3326.   else if FDataLink.Field.DataType in [ftSmallint, ftInteger, ftWord] then
  3327.     FDataLink.Field.AsInteger := Self.AsInteger
  3328.   else if FDataLink.Field.DataType = ftBoolean then
  3329.     FDataLink.Field.AsBoolean := Boolean(Self.AsInteger)
  3330.   else FDataLink.Field.AsFloat := Self.Value;
  3331. end;
  3332.  
  3333. {$IFDEF WIN32}
  3334. procedure TRxDBCalcEdit.CMGetDataLink(var Message: TMessage);
  3335. begin
  3336.   Message.Result := Integer(FDataLink);
  3337. end;
  3338.  
  3339. procedure TRxDBCalcEdit.AcceptValue(const Value: Variant);
  3340. begin
  3341.   if VarIsNull(Value) or VarIsEmpty(Value) then FDataLink.Field.Clear
  3342.   else FDataLink.Field.Value := Value;
  3343.   DoChange;
  3344. end;
  3345. {$ENDIF}
  3346.  
  3347. procedure TRxDBCalcEdit.WMPaste(var Message: TMessage);
  3348. begin
  3349.   FDataLink.Edit;
  3350.   inherited;
  3351. end;
  3352.  
  3353. procedure TRxDBCalcEdit.WMCut(var Message: TMessage);
  3354. begin
  3355.   FDataLink.Edit;
  3356.   inherited;
  3357. end;
  3358.  
  3359. procedure TRxDBCalcEdit.CMEnter(var Message: TCMEnter);
  3360. begin
  3361.   inherited;
  3362. end;
  3363.  
  3364. procedure TRxDBCalcEdit.CMExit(var Message: TCMExit);
  3365. begin
  3366.   try
  3367.     CheckRange;
  3368.     FDataLink.UpdateRecord;
  3369.   except
  3370.     SelectAll;
  3371.     if CanFocus then SetFocus;
  3372.     raise;
  3373.   end;
  3374.   inherited;
  3375. end;
  3376.  
  3377. {$IFDEF RX_D4}
  3378. function TRxDBCalcEdit.UseRightToLeftAlignment: Boolean;
  3379. begin
  3380.   Result := DBUseRightToLeftAlignment(Self, Field);
  3381. end;
  3382.  
  3383. function TRxDBCalcEdit.ExecuteAction(Action: TBasicAction): Boolean;
  3384. begin
  3385.   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
  3386.     FDataLink.ExecuteAction(Action);
  3387. end;
  3388.  
  3389. function TRxDBCalcEdit.UpdateAction(Action: TBasicAction): Boolean;
  3390. begin
  3391.   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
  3392.     FDataLink.UpdateAction(Action);
  3393. end;
  3394. {$ENDIF}
  3395.  
  3396. { TStatusDataLink }
  3397.  
  3398. type
  3399.   TStatusDataLink = class(TDataLink)
  3400.   private
  3401.     FLabel: TDBStatusLabel;
  3402.   protected
  3403.     procedure ActiveChanged; override;
  3404.     procedure EditingChanged; override;
  3405.     procedure DataSetChanged; override;
  3406.     procedure DataSetScrolled(Distance: Integer); override;
  3407.     procedure LayoutChanged; override;
  3408.   public
  3409.     constructor Create(ALabel: TDBStatusLabel);
  3410.     destructor Destroy; override;
  3411.   end;
  3412.  
  3413. constructor TStatusDataLink.Create(ALabel: TDBStatusLabel);
  3414. begin
  3415.   inherited Create;
  3416.   FLabel := ALabel;
  3417. end;
  3418.  
  3419. destructor TStatusDataLink.Destroy;
  3420. begin
  3421.   FLabel := nil;
  3422.   inherited Destroy;
  3423. end;
  3424.  
  3425. procedure TStatusDataLink.ActiveChanged;
  3426. begin
  3427.   DataSetChanged;
  3428. end;
  3429.  
  3430. procedure TStatusDataLink.DataSetScrolled(Distance: Integer);
  3431. begin
  3432.   if (FLabel <> nil) and (FLabel.Style = lsRecordNo) then
  3433.     FLabel.UpdateStatus;
  3434. end;
  3435.  
  3436. procedure TStatusDataLink.EditingChanged;
  3437. begin
  3438.   if (FLabel <> nil) and (FLabel.Style <> lsRecordSize) then
  3439.     FLabel.UpdateStatus;
  3440. end;
  3441.  
  3442. procedure TStatusDataLink.DataSetChanged;
  3443. begin
  3444.   if (FLabel <> nil) then FLabel.UpdateData;
  3445. end;
  3446.  
  3447. procedure TStatusDataLink.LayoutChanged;
  3448. begin
  3449.   if (FLabel <> nil) and (FLabel.Style <> lsRecordSize) then
  3450.     DataSetChanged; { ??? }
  3451. end;
  3452.  
  3453. { TDBStatusLabel }
  3454.  
  3455. const
  3456.   GlyphSpacing = 2;
  3457.   GlyphColumns = 7;
  3458.  
  3459. constructor TDBStatusLabel.Create(AOwner: TComponent);
  3460. begin
  3461.   inherited Create(AOwner);
  3462.   ShadowSize := 0;
  3463.   Layout := tlCenter;
  3464.   ControlStyle := ControlStyle - [csSetCaption {$IFDEF WIN32},
  3465.     csReplicatable {$ENDIF}];
  3466.   FRecordCount := -1;
  3467.   FRecordNo := -1;
  3468.   ShowAccelChar := False;
  3469.   FDataSetName := NullStr;
  3470.   FDataLink := TStatusDataLink.Create(Self);
  3471.   FStyle := lsState;
  3472.   GlyphAlign := glGlyphLeft;
  3473.   FEditColor := clRed;
  3474.   FCaptions := TStringList.Create;
  3475.   TStringList(FCaptions).OnChange := CaptionsChanged;
  3476.   FGlyph := TBitmap.Create;
  3477.   FGlyph.Handle := LoadBitmap(HInstance, 'DS_STATES');
  3478.   Caption := '';
  3479. end;
  3480.  
  3481. destructor TDBStatusLabel.Destroy;
  3482. begin
  3483.   FDataLink.Free;
  3484.   FDataLink := nil;
  3485.   DisposeStr(FDataSetName);
  3486.   TStringList(FCaptions).OnChange := nil;
  3487.   FCaptions.Free;
  3488.   FCaptions := nil;
  3489.   FCell.Free;
  3490.   FCell := nil;
  3491.   FGlyph.Free;
  3492.   FGlyph := nil;
  3493.   inherited Destroy;
  3494. end;
  3495.  
  3496. procedure TDBStatusLabel.Loaded;
  3497. begin
  3498.   inherited Loaded;
  3499.   UpdateData;
  3500. end;
  3501.  
  3502. function TDBStatusLabel.GetDefaultFontColor: TColor;
  3503. begin
  3504.   if (FStyle = lsState) and (FDatalink <> nil) and
  3505.     (GetDatasetState in [dsEdit, dsInsert]) then
  3506.     Result := FEditColor
  3507.   else Result := inherited GetDefaultFontColor;
  3508. end;
  3509.  
  3510. function TDBStatusLabel.GetLabelCaption: string;
  3511. begin
  3512.   if (csDesigning in ComponentState) and ((FStyle = lsState) or
  3513.     (FDatalink = nil) or not FDatalink.Active) then
  3514.     Result := Format('(%s)', [Name])
  3515.   else if ((FDatalink = nil) or (DataSource = nil)) then
  3516.     Result := ''
  3517.   else begin
  3518.     case FStyle of
  3519.       lsState:
  3520.         if FShowOptions in [doCaption, doBoth] then begin
  3521.           if DataSetName = '' then Result := GetCaption(DataSource.State)
  3522.           else Result := Format('%s: %s', [DataSetName, GetCaption(DataSource.State)]);
  3523.         end
  3524.         else { doGlyph } Result := '';
  3525.       lsRecordNo:
  3526.         if FDataLink.Active then begin
  3527.           if FRecordNo >= 0 then begin
  3528.             if FRecordCount >= 0 then
  3529.               Result := Format('%d:%d', [FRecordNo, FRecordCount])
  3530.             else Result := IntToStr(FRecordNo);
  3531.           end
  3532.           else begin
  3533.             if FRecordCount >= 0 then
  3534.               Result := Format('( %d )', [FRecordCount])
  3535.             else Result := '';
  3536.           end;
  3537.         end
  3538.         else Result := '';
  3539.       lsRecordSize:
  3540.         if FDatalink.Active then
  3541.           Result := IntToStr(FDatalink.DataSet.RecordSize)
  3542.         else Result := '';
  3543.     end;
  3544.   end;
  3545. end;
  3546.  
  3547. function TDBStatusLabel.GetDatasetState: TDataSetState;
  3548. begin
  3549.   if DataSource <> nil then
  3550.     Result := DataSource.State
  3551.   else Result := dsInactive;
  3552. end;
  3553.  
  3554. procedure TDBStatusLabel.SetName(const Value: TComponentName);
  3555. begin
  3556.   inherited SetName(Value);
  3557.   if (csDesigning in ComponentState) then Invalidate;
  3558. end;
  3559.  
  3560. procedure TDBStatusLabel.SetCaptions(Value: TStrings);
  3561. begin
  3562.   FCaptions.Assign(Value);
  3563. end;
  3564.  
  3565. function TDBStatusLabel.GetStatusKind(State: TDataSetState): TDBStatusKind;
  3566. begin
  3567. {$IFDEF WIN32}
  3568.   if not (State in [Low(TDBStatusKind)..High(TDBStatusKind)]) then begin
  3569.     case State of
  3570.       dsFilter: Result := dsSetKey;
  3571. {$IFDEF RX_D3}
  3572.       dsNewValue, dsOldValue, dsCurValue: Result := dsEdit;
  3573. {$ELSE}
  3574.       dsUpdateNew, dsUpdateOld: Result := dsEdit;
  3575. {$ENDIF}
  3576.       else Result := TDBStatusKind(State);
  3577.     end;
  3578.   end
  3579.   else
  3580. {$ENDIF WIN32}
  3581.     Result := TDBStatusKind(State);
  3582. end;
  3583.  
  3584. function TDBStatusLabel.GetCaption(State: TDataSetState): string;
  3585. const
  3586.   StrIds: array[TDBStatusKind] of Word = (SInactiveData, SBrowseData,
  3587.     SEditData, SInsertData, SSetKeyData, SCalcFieldsData);
  3588. var
  3589.   Kind: TDBStatusKind;
  3590. begin
  3591.   Kind := GetStatusKind(State);
  3592.   if (FCaptions <> nil) and (Ord(Kind) < FCaptions.Count) and
  3593.     (FCaptions[Ord(Kind)] <> '') then Result := FCaptions[Ord(Kind)]
  3594.   else Result := LoadStr(StrIds[Kind]);
  3595. end;
  3596.  
  3597. procedure TDBStatusLabel.Paint;
  3598. var
  3599.   GlyphOrigin: TPoint;
  3600. begin
  3601.   inherited Paint;
  3602.   if (FStyle = lsState) and (FShowOptions in [doGlyph, doBoth]) and
  3603.     (FCell <> nil) then
  3604.   begin
  3605.     if GlyphAlign = glGlyphLeft then
  3606.       GlyphOrigin.X := GlyphSpacing
  3607.     else {glGlyphRight}
  3608.       GlyphOrigin.X := Left + ClientWidth - RightMargin + GlyphSpacing;
  3609.     case Layout of
  3610.       tlTop: GlyphOrigin.Y := 0;
  3611.       tlCenter: GlyphOrigin.Y := (ClientHeight - FCell.Height) div 2;
  3612.       else { tlBottom } GlyphOrigin.Y := ClientHeight - FCell.Height;
  3613.     end;
  3614.     DrawBitmapTransparent(Canvas, GlyphOrigin.X, GlyphOrigin.Y,
  3615.       FCell, FGlyph.TransparentColor);
  3616.   end;
  3617. end;
  3618.  
  3619. procedure TDBStatusLabel.CaptionsChanged(Sender: TObject);
  3620. begin
  3621.   TStringList(FCaptions).OnChange := nil;
  3622.   try
  3623.     while (Pred(FCaptions.Count) > Ord(High(TDBStatusKind))) do
  3624.       FCaptions.Delete(FCaptions.Count - 1);
  3625.   finally
  3626.     TStringList(FCaptions).OnChange := CaptionsChanged;
  3627.   end;
  3628.   if not (csDesigning in ComponentState) then Invalidate;
  3629. end;
  3630.  
  3631. procedure TDBStatusLabel.UpdateData;
  3632.  
  3633.   function IsSequenced: Boolean;
  3634.   begin
  3635. {$IFDEF RX_D3}
  3636.     Result := FDatalink.DataSet.IsSequenced;
  3637. {$ELSE}
  3638.     Result := not ((FDatalink.DataSet is TDBDataSet) and
  3639.       TDBDataSet(FDatalink.DataSet).Database.IsSQLBased);
  3640. {$ENDIF}
  3641.   end;
  3642.  
  3643. begin
  3644.   FRecordCount := -1;
  3645.   if (FStyle = lsRecordNo) and FDataLink.Active and
  3646.     (DataSource.State in [dsBrowse, dsEdit]) then
  3647.   begin
  3648.     if Assigned(FOnGetRecordCount) then
  3649.       FOnGetRecordCount(Self, FDataLink.DataSet, FRecordCount)
  3650.     else if (FCalcCount or IsSequenced) then
  3651. {$IFDEF RX_D3}
  3652.       FRecordCount := FDataLink.DataSet.RecordCount;
  3653. {$ELSE}
  3654.       FRecordCount := DataSetRecordCount(FDataLink.DataSet)
  3655. {$ENDIF}
  3656.   end;
  3657.   UpdateStatus;
  3658. end;
  3659.  
  3660. procedure TDBStatusLabel.UpdateStatus;
  3661. begin
  3662.   if DataSource <> nil then begin
  3663.     case FStyle of
  3664.       lsState:
  3665.         if FShowOptions in [doGlyph, doBoth] then begin
  3666.           if GlyphAlign = glGlyphLeft then begin
  3667.             RightMargin := 0;
  3668.             LeftMargin := (FGlyph.Width div GlyphColumns) + GlyphSpacing * 2;
  3669.           end
  3670.           else {glGlyphRight} begin
  3671.             LeftMargin := 0;
  3672.             RightMargin := (FGlyph.Width div GlyphColumns) + GlyphSpacing * 2;
  3673.           end;
  3674.           if FCell = nil then FCell := TBitmap.Create;
  3675.           AssignBitmapCell(FGlyph, FCell, GlyphColumns, 1,
  3676.             Ord(GetStatusKind(DataSource.State)));
  3677.         end
  3678.         else { doCaption } begin
  3679.           FCell.Free;
  3680.           FCell := nil;
  3681.           LeftMargin := 0;
  3682.           RightMargin := 0;
  3683.         end;
  3684.       lsRecordNo:
  3685.         begin
  3686.           FCell.Free;
  3687.           FCell := nil;
  3688.           LeftMargin := 0;
  3689.           RightMargin := 0;
  3690.           FRecordNo := -1;
  3691.           if FDataLink.Active then begin
  3692.             if Assigned(FOnGetRecNo) then
  3693.               FOnGetRecNo(Self, FDataLink.DataSet, FRecordNo) else
  3694.             try
  3695. {$IFDEF RX_D3}
  3696.               with FDatalink.DataSet do
  3697.                 if not IsEmpty then FRecordNo := RecNo;
  3698. {$ELSE}
  3699.               FRecordNo := DataSetRecNo(FDatalink.DataSet);
  3700. {$ENDIF}
  3701.             except
  3702.             end;
  3703.           end;
  3704.         end;
  3705.       lsRecordSize:
  3706.         begin
  3707.           FCell.Free;
  3708.           FCell := nil;
  3709.           LeftMargin := 0;
  3710.           RightMargin := 0;
  3711.         end;
  3712.     end;
  3713.   end
  3714.   else begin
  3715.     FCell.Free;
  3716.     FCell := nil;
  3717.   end;
  3718.   AdjustBounds;
  3719.   Invalidate;
  3720. end;
  3721.  
  3722. procedure TDBStatusLabel.Notification(AComponent: TComponent;
  3723.   Operation: TOperation);
  3724. begin
  3725.   inherited Notification(AComponent, Operation);
  3726.   if (Operation = opRemove) and (FDataLink <> nil) and
  3727.     (AComponent = DataSource) then DataSource := nil;
  3728. end;
  3729.  
  3730. function TDBStatusLabel.GetDataSetName: string;
  3731. begin
  3732.   Result := FDataSetName^;
  3733.   if not (csDesigning in ComponentState) then begin
  3734.     if Assigned(FOnGetDataName) then Result := FOnGetDataName(Self)
  3735.     else if (Result = '') and (DataSource <> nil) and
  3736.       (DataSource.DataSet <> nil) then Result := DataSource.DataSet.Name;
  3737.   end;
  3738. end;
  3739.  
  3740. procedure TDBStatusLabel.SetDataSetName(Value: string);
  3741. begin
  3742.   AssignStr(FDataSetName, Value);
  3743.   Invalidate;
  3744. end;
  3745.  
  3746. function TDBStatusLabel.GetDataSource: TDataSource;
  3747. begin
  3748.   Result := FDataLink.DataSource;
  3749. end;
  3750.  
  3751. procedure TDBStatusLabel.SetDataSource(Value: TDataSource);
  3752. begin
  3753. {$IFDEF RX_D4}
  3754.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  3755. {$ENDIF}
  3756.     FDataLink.DataSource := Value;
  3757. {$IFDEF WIN32}
  3758.   if Value <> nil then Value.FreeNotification(Self);
  3759. {$ENDIF}
  3760.   if not (csLoading in ComponentState) then UpdateData;
  3761. end;
  3762.  
  3763. procedure TDBStatusLabel.SetEditColor(Value: TColor);
  3764. begin
  3765.   if FEditColor <> Value then begin
  3766.     FEditColor := Value;
  3767.     if Style = lsState then Invalidate;
  3768.   end;
  3769. end;
  3770.  
  3771. procedure TDBStatusLabel.SetGlyphAlign(Value: TGlyphAlign);
  3772. begin
  3773.   if FGlyphAlign <> Value then begin
  3774.     FGlyphAlign := Value;
  3775.     UpdateStatus;
  3776.   end;
  3777. end;
  3778.  
  3779. procedure TDBStatusLabel.SetShowOptions(Value: TDBLabelOptions);
  3780. begin
  3781.   if FShowOptions <> Value then begin
  3782.     FShowOptions := Value;
  3783.     UpdateStatus;
  3784.   end;
  3785. end;
  3786.  
  3787. procedure TDBStatusLabel.SetCalcCount(Value: Boolean);
  3788. begin
  3789.   if FCalcCount <> Value then begin
  3790.     FCalcCount := Value;
  3791.     if not (csLoading in ComponentState) then UpdateData;
  3792.   end;
  3793. end;
  3794.  
  3795. procedure TDBStatusLabel.SetStyle(Value: TDBLabelStyle);
  3796. begin
  3797.   if FStyle <> Value then begin
  3798.     FStyle := Value;
  3799.     if not (csLoading in ComponentState) then UpdateData;
  3800.   end;
  3801. end;
  3802.  
  3803. {$IFDEF WIN32}
  3804. initialization
  3805. finalization
  3806.   DestroyLocals;
  3807. {$ELSE}
  3808. initialization
  3809.   AddExitProc(DestroyLocals);
  3810. {$ENDIF}
  3811. end.