home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / vcl.pak / DBCTRLS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  68.8 KB  |  2,737 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit DBCtrls;
  11.  
  12. interface
  13.  
  14. uses SysUtils, WinTypes, WinProcs, Messages, Classes, Controls, Forms,
  15.   Graphics, Menus, StdCtrls, ExtCtrls, DB, DBTables, Mask, Buttons;
  16.  
  17. type
  18.  
  19. { TDBEdit }
  20.  
  21.   TDBEdit = class(TCustomMaskEdit)
  22.   private
  23.     FDataLink: TFieldDataLink;
  24.     FCanvas: TControlCanvas;
  25.     FAlignment: TAlignment;
  26.     FFocused: Boolean;
  27.     FTextMargin: Integer;
  28.     procedure CalcTextMargin;
  29.     procedure DataChange(Sender: TObject);
  30.     procedure EditingChange(Sender: TObject);
  31.     function GetDataField: string;
  32.     function GetDataSource: TDataSource;
  33.     function GetField: TField;
  34.     function GetReadOnly: Boolean;
  35.     procedure SetDataField(const Value: string);
  36.     procedure SetDataSource(Value: TDataSource);
  37.     procedure SetFocused(Value: Boolean);
  38.     procedure SetReadOnly(Value: Boolean);
  39.     procedure UpdateData(Sender: TObject);
  40.     procedure WMCut(var Message: TMessage); message WM_CUT;
  41.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  42.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  43.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  44.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  45.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  46.   protected
  47.     procedure Change; override;
  48.     function EditCanModify: Boolean; override;
  49.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  50.     procedure KeyPress(var Key: Char); override;
  51.     procedure Notification(AComponent: TComponent;
  52.       Operation: TOperation); override;
  53.     procedure Reset; override;
  54.   public
  55.     constructor Create(AOwner: TComponent); override;
  56.     destructor Destroy; override;
  57.     property Field: TField read GetField;
  58.   published
  59.     property AutoSelect;
  60.     property AutoSize;
  61.     property BorderStyle;
  62.     property CharCase;
  63.     property Color;
  64.     property Ctl3D;
  65.     property DataField: string read GetDataField write SetDataField;
  66.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  67.     property DragCursor;
  68.     property DragMode;
  69.     property Enabled;
  70.     property Font;
  71.     property MaxLength;
  72.     property ParentColor;
  73.     property ParentCtl3D;
  74.     property ParentFont;
  75.     property ParentShowHint;
  76.     property PasswordChar;
  77.     property PopupMenu;
  78.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  79.     property ShowHint;
  80.     property TabOrder;
  81.     property TabStop;
  82.     property Visible;
  83.     property OnChange;
  84.     property OnClick;
  85.     property OnDblClick;
  86.     property OnDragDrop;
  87.     property OnDragOver;
  88.     property OnEndDrag;
  89.     property OnEnter;
  90.     property OnExit;
  91.     property OnKeyDown;
  92.     property OnKeyPress;
  93.     property OnKeyUp;
  94.     property OnMouseDown;
  95.     property OnMouseMove;
  96.     property OnMouseUp;
  97.   end;
  98.  
  99. { TDBText }
  100.  
  101.   TDBText = class(TCustomLabel)
  102.   private
  103.     FDataLink: TFieldDataLink;
  104.     procedure DataChange(Sender: TObject);
  105.     function GetDataField: string;
  106.     function GetDataSource: TDataSource;
  107.     function GetField: TField;
  108.     procedure SetDataField(const Value: string);
  109.     procedure SetDataSource(Value: TDataSource);
  110.   protected
  111.     procedure Notification(AComponent: TComponent;
  112.       Operation: TOperation); override;
  113.   public
  114.     constructor Create(AOwner: TComponent); override;
  115.     destructor Destroy; override;
  116.     property Field: TField read GetField;
  117.   published
  118.     property Align;
  119.     property Alignment;
  120.     property AutoSize default False;
  121.     property Color;
  122.     property DataField: string read GetDataField write SetDataField;
  123.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  124.     property DragCursor;
  125.     property DragMode;
  126.     property Enabled;
  127.     property Font;
  128.     property ParentColor;
  129.     property ParentFont;
  130.     property ParentShowHint;
  131.     property PopupMenu;
  132.     property Transparent;
  133.     property ShowHint;
  134.     property Visible;
  135.     property WordWrap;
  136.     property OnClick;
  137.     property OnDblClick;
  138.     property OnDragDrop;
  139.     property OnDragOver;
  140.     property OnEndDrag;
  141.     property OnMouseDown;
  142.     property OnMouseMove;
  143.     property OnMouseUp;
  144.   end;
  145.  
  146. { TDBCheckBox }
  147.  
  148.   TDBCheckBox = class(TCustomCheckBox)
  149.   private
  150.     FDataLink: TFieldDataLink;
  151.     FValueCheck: PString;
  152.     FValueUncheck: PString;
  153.     procedure DataChange(Sender: TObject);
  154.     function GetDataField: string;
  155.     function GetDataSource: TDataSource;
  156.     function GetField: TField;
  157.     function GetReadOnly: Boolean;
  158.     function GetValueCheck: string;
  159.     function GetValueUncheck: string;
  160.     procedure SetDataField(const Value: string);
  161.     procedure SetDataSource(Value: TDataSource);
  162.     procedure SetReadOnly(Value: Boolean);
  163.     procedure SetValueCheck(const Value: string);
  164.     procedure SetValueUncheck(const Value: string);
  165.     procedure UpdateData(Sender: TObject);
  166.     function ValueMatch(const ValueList, Value: string): Boolean;
  167.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  168.   protected
  169.     procedure Toggle; override;
  170.     procedure KeyPress(var Key: Char); override;
  171.     procedure Notification(AComponent: TComponent;
  172.       Operation: TOperation); override;
  173.   public
  174.     constructor Create(AOwner: TComponent); override;
  175.     destructor Destroy; override;
  176.     property Checked;
  177.     property Field: TField read GetField;
  178.     property State;
  179.   published
  180.     property Alignment;
  181.     property AllowGrayed;
  182.     property Caption;
  183.     property Color;
  184.     property Ctl3D;
  185.     property DataField: string read GetDataField write SetDataField;
  186.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  187.     property DragCursor;
  188.     property DragMode;
  189.     property Enabled;
  190.     property Font;
  191.     property ParentColor;
  192.     property ParentCtl3D;
  193.     property ParentFont;
  194.     property ParentShowHint;
  195.     property PopupMenu;
  196.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  197.     property ShowHint;
  198.     property TabOrder;
  199.     property TabStop;
  200.     property ValueChecked: string read GetValueCheck write SetValueCheck;
  201.     property ValueUnchecked: string read GetValueUncheck write SetValueUncheck;
  202.     property Visible;
  203.     property OnClick;
  204.     property OnDragDrop;
  205.     property OnDragOver;
  206.     property OnEndDrag;
  207.     property OnEnter;
  208.     property OnExit;
  209.     property OnKeyDown;
  210.     property OnKeyPress;
  211.     property OnKeyUp;
  212.     property OnMouseDown;
  213.     property OnMouseMove;
  214.     property OnMouseUp;
  215.   end;
  216.  
  217. { TDBComboBox }
  218.  
  219.   TDBComboBox = class(TCustomComboBox)
  220.   private
  221.     FDataLink: TFieldDataLink;
  222.     procedure DataChange(Sender: TObject);
  223.     procedure EditingChange(Sender: TObject);
  224.     function GetComboText: string;
  225.     function GetDataField: string;
  226.     function GetDataSource: TDataSource;
  227.     function GetField: TField;
  228.     function GetReadOnly: Boolean;
  229.     procedure SetComboText(const Value: string);
  230.     procedure SetDataField(const Value: string);
  231.     procedure SetDataSource(Value: TDataSource);
  232.     procedure SetEditReadOnly;
  233.     procedure SetItems(Value: TStrings);
  234.     procedure SetReadOnly(Value: Boolean);
  235.     procedure UpdateData(Sender: TObject);
  236.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  237.   protected
  238.     procedure Change; override;
  239.     procedure Click; override;
  240.     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  241.       ComboProc: Pointer); override;
  242.     procedure CreateWnd; override;
  243.     procedure DropDown; override;
  244.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  245.     procedure KeyPress(var Key: Char); override;
  246.     procedure Notification(AComponent: TComponent;
  247.       Operation: TOperation); override;
  248.     procedure WndProc(var Message: TMessage); override;
  249.   public
  250.     constructor Create(AOwner: TComponent); override;
  251.     destructor Destroy; override;
  252.     property Field: TField read GetField;
  253.     property Text;
  254.   published
  255.     property Style; {Must be published before Items}
  256.     property Color;
  257.     property Ctl3D;
  258.     property DataField: string read GetDataField write SetDataField;
  259.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  260.     property DragMode;
  261.     property DragCursor;
  262.     property DropDownCount;
  263.     property Enabled;
  264.     property Font;
  265.     property ItemHeight;
  266.     property Items write SetItems;
  267.     property ParentColor;
  268.     property ParentCtl3D;
  269.     property ParentFont;
  270.     property ParentShowHint;
  271.     property PopupMenu;
  272.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  273.     property ShowHint;
  274.     property Sorted;
  275.     property TabOrder;
  276.     property TabStop;
  277.     property Visible;
  278.     property OnChange;
  279.     property OnClick;
  280.     property OnDblClick;
  281.     property OnDragDrop;
  282.     property OnDragOver;
  283.     property OnDrawItem;
  284.     property OnDropDown;
  285.     property OnEndDrag;
  286.     property OnEnter;
  287.     property OnExit;
  288.     property OnKeyDown;
  289.     property OnKeyPress;
  290.     property OnKeyUp;
  291.     property OnMeasureItem;
  292.   end;
  293.  
  294. { TDBListBox }
  295.  
  296.   TDBListBox = class(TCustomListBox)
  297.   private
  298.     FDataLink: TFieldDataLink;
  299.     procedure DataChange(Sender: TObject);
  300.     procedure UpdateData(Sender: TObject);
  301.     function GetDataField: string;
  302.     function GetDataSource: TDataSource;
  303.     function GetField: TField;
  304.     function GetReadOnly: Boolean;
  305.     procedure SetDataField(const Value: string);
  306.     procedure SetDataSource(Value: TDataSource);
  307.     procedure SetReadOnly(Value: Boolean);
  308.     procedure SetItems(Value: TStrings);
  309.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  310.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  311.   protected
  312.     procedure Click; override;
  313.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  314.     procedure KeyPress(var Key: Char); override;
  315.     procedure Notification(AComponent: TComponent;
  316.       Operation: TOperation); override;
  317.   public
  318.     constructor Create(AOwner: TComponent); override;
  319.     destructor Destroy; override;
  320.     property Field: TField read GetField;
  321.   published
  322.     property Align;
  323.     property BorderStyle;
  324.     property Color;
  325.     property Ctl3D default True;
  326.     property DataField: string read GetDataField write SetDataField;
  327.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  328.     property DragCursor;
  329.     property DragMode;
  330.     property Enabled;
  331.     property Font;
  332.     property IntegralHeight;
  333.     property ItemHeight;
  334.     property Items write SetItems;
  335.     property ParentColor;
  336.     property ParentCtl3D;
  337.     property ParentFont;
  338.     property ParentShowHint;
  339.     property PopupMenu;
  340.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  341.     property ShowHint;
  342.     property TabOrder;
  343.     property TabStop;
  344.     property Visible;
  345.     property OnClick;
  346.     property OnDblClick;
  347.     property OnDragDrop;
  348.     property OnDragOver;
  349.     property OnDrawItem;
  350.     property OnEndDrag;
  351.     property OnEnter;
  352.     property OnExit;
  353.     property OnKeyDown;
  354.     property OnKeyPress;
  355.     property OnKeyUp;
  356.     property OnMeasureItem;
  357.     property OnMouseDown;
  358.     property OnMouseMove;
  359.     property OnMouseUp;
  360.   end;
  361.  
  362. { TDBRadioGroup }
  363.  
  364.   TDBRadioGroup = class(TCustomRadioGroup)
  365.   private
  366.     FDataLink: TFieldDataLink;
  367.     FValue: PString;
  368.     FValues: TStrings;
  369.     FOnChange: TNotifyEvent;
  370.     procedure DataChange(Sender: TObject);
  371.     procedure UpdateData(Sender: TObject);
  372.     function GetDataField: string;
  373.     function GetDataSource: TDataSource;
  374.     function GetField: TField;
  375.     function GetReadOnly: Boolean;
  376.     function GetValue: string;
  377.     function GetButtonValue(Index: Integer): string;
  378.     procedure SetDataField(const Value: string);
  379.     procedure SetDataSource(Value: TDataSource);
  380.     procedure SetReadOnly(Value: Boolean);
  381.     procedure SetValue(const Value: string);
  382.     procedure SetItems(Value: TStrings);
  383.     procedure SetValues(Value: TStrings);
  384.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  385.   protected
  386.     procedure Change; dynamic;
  387.     procedure Click; override;
  388.     procedure KeyPress(var Key: Char); override;
  389.     function CanModify: Boolean; override;
  390.     procedure Notification(AComponent: TComponent;
  391.       Operation: TOperation); override;
  392.     property DataLink: TFieldDataLink read FDataLink;
  393.   public
  394.     constructor Create(AOwner: TComponent); override;
  395.     destructor Destroy; override;
  396.     property Field: TField read GetField;
  397.     property ItemIndex;
  398.     property Value: string read GetValue write SetValue;
  399.   published
  400.     property Align;
  401.     property Caption;
  402.     property Color;
  403.     property Columns;
  404.     property Ctl3D;
  405.     property DataField: string read GetDataField write SetDataField;
  406.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  407.     property DragCursor;
  408.     property DragMode;
  409.     property Enabled;
  410.     property Font;
  411.     property Items write SetItems;
  412.     property ParentColor;
  413.     property ParentCtl3D;
  414.     property ParentFont;
  415.     property ParentShowHint;
  416.     property PopupMenu;
  417.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  418.     property ShowHint;
  419.     property TabOrder;
  420.     property TabStop;
  421.     property Values: TStrings read FValues write SetValues;
  422.     property Visible;
  423.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  424.     property OnClick;
  425.     property OnDragDrop;
  426.     property OnDragOver;
  427.     property OnEndDrag;
  428.     property OnEnter;
  429.     property OnExit;
  430.   end;
  431.  
  432. { TDBMemo }
  433.  
  434.   TDBMemo = class(TCustomMemo)
  435.   private
  436.     FDataLink: TFieldDataLink;
  437.     FAutoDisplay: Boolean;
  438.     FFocused: Boolean;
  439.     FMemoLoaded: Boolean;
  440.     FReserved: Byte;
  441.     procedure DataChange(Sender: TObject);
  442.     procedure EditingChange(Sender: TObject);
  443.     function GetDataField: string;
  444.     function GetDataSource: TDataSource;
  445.     function GetField: TField;
  446.     function GetReadOnly: Boolean;
  447.     procedure SetDataField(const Value: string);
  448.     procedure SetDataSource(Value: TDataSource);
  449.     procedure SetReadOnly(Value: Boolean);
  450.     procedure SetAutoDisplay(Value: Boolean);
  451.     procedure SetFocused(Value: Boolean);
  452.     procedure UpdateData(Sender: TObject);
  453.     procedure WMCut(var Message: TMessage); message WM_CUT;
  454.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  455.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  456.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  457.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  458.   protected
  459.     procedure Change; override;
  460.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  461.     procedure KeyPress(var Key: Char); override;
  462.     procedure Notification(AComponent: TComponent;
  463.       Operation: TOperation); override;
  464.   public
  465.     constructor Create(AOwner: TComponent); override;
  466.     destructor Destroy; override;
  467.     procedure LoadMemo;
  468.     property Field: TField read GetField;
  469.   published
  470.     property Align;
  471.     property Alignment;
  472.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  473.     property BorderStyle;
  474.     property Color;
  475.     property Ctl3D;
  476.     property DataField: string read GetDataField write SetDataField;
  477.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  478.     property DragCursor;
  479.     property DragMode;
  480.     property Enabled;
  481.     property Font;
  482.     property MaxLength;
  483.     property ParentColor;
  484.     property ParentCtl3D;
  485.     property ParentFont;
  486.     property ParentShowHint;
  487.     property PopupMenu;
  488.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  489.     property ScrollBars;
  490.     property ShowHint;
  491.     property TabOrder;
  492.     property TabStop;
  493.     property Visible;
  494.     property WantTabs;
  495.     property WordWrap;
  496.     property OnChange;
  497.     property OnClick;
  498.     property OnDblClick;
  499.     property OnDragDrop;
  500.     property OnDragOver;
  501.     property OnEndDrag;
  502.     property OnEnter;
  503.     property OnExit;
  504.     property OnKeyDown;
  505.     property OnKeyPress;
  506.     property OnKeyUp;
  507.     property OnMouseDown;
  508.     property OnMouseMove;
  509.     property OnMouseUp;
  510.   end;
  511.  
  512. { TDBImage }
  513.  
  514.   TDBImage = class(TCustomControl)
  515.   private
  516.     FDataLink: TFieldDataLink;
  517.     FPicture: TPicture;
  518.     FBorderStyle: TBorderStyle;
  519.     FAutoDisplay: Boolean;
  520.     FStretch: Boolean;
  521.     FCenter: Boolean;
  522.     FPictureLoaded: Boolean;
  523.     FReserved: Byte;
  524.     procedure DataChange(Sender: TObject);
  525.     function GetDataField: string;
  526.     function GetDataSource: TDataSource;
  527.     function GetField: TField;
  528.     function GetReadOnly: Boolean;
  529.     procedure PictureChanged(Sender: TObject);
  530.     procedure SetAutoDisplay(Value: Boolean);
  531.     procedure SetBorderStyle(Value: TBorderStyle);
  532.     procedure SetCenter(Value: Boolean);
  533.     procedure SetDataField(const Value: string);
  534.     procedure SetDataSource(Value: TDataSource);
  535.     procedure SetPicture(Value: TPicture);
  536.     procedure SetReadOnly(Value: Boolean);
  537.     procedure SetStretch(Value: Boolean);
  538.     procedure UpdateData(Sender: TObject);
  539.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  540.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  541.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  542.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  543.     procedure WMCut(var Message: TMessage); message WM_CUT;
  544.     procedure WMCopy(var Message: TMessage); message WM_COPY;
  545.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  546.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  547.   protected
  548.     procedure CreateParams(var Params: TCreateParams); override;
  549.     function GetPalette: HPALETTE; override;
  550.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  551.     procedure KeyPress(var Key: Char); override;
  552.     procedure Notification(AComponent: TComponent;
  553.       Operation: TOperation); override;
  554.     procedure Paint; override;
  555.   public
  556.     constructor Create(AOwner: TComponent); override;
  557.     destructor Destroy; override;
  558.     procedure CopyToClipboard;
  559.     procedure CutToClipboard;
  560.     procedure LoadPicture;
  561.     procedure PasteFromClipboard;
  562.     property Field: TField read GetField;
  563.     property Picture: TPicture read FPicture write SetPicture;
  564.   published
  565.     property Align;
  566.     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
  567.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  568.     property Center: Boolean read FCenter write SetCenter default True;
  569.     property Color;
  570.     property Ctl3D;
  571.     property DataField: string read GetDataField write SetDataField;
  572.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  573.     property DragCursor;
  574.     property DragMode;
  575.     property Enabled;
  576.     property Font;
  577.     property ParentColor default False;
  578.     property ParentCtl3D;
  579.     property ParentFont;
  580.     property ParentShowHint;
  581.     property PopupMenu;
  582.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  583.     property ShowHint;
  584.     property Stretch: Boolean read FStretch write SetStretch default False;
  585.     property TabOrder;
  586.     property TabStop default True;
  587.     property Visible;
  588.     property OnClick;
  589.     property OnDblClick;
  590.     property OnDragDrop;
  591.     property OnDragOver;
  592.     property OnEndDrag;
  593.     property OnEnter;
  594.     property OnExit;
  595.     property OnKeyDown;
  596.     property OnKeyPress;
  597.     property OnKeyUp;
  598.     property OnMouseDown;
  599.     property OnMouseMove;
  600.     property OnMouseUp;
  601.   end;
  602.  
  603. const
  604.   InitRepeatPause = 400;  { pause before repeat timer (ms) }
  605.   RepeatPause     = 100;  { pause before hint window displays (ms)}
  606.   SpaceSize       =  5;   { size of space between special buttons }
  607.  
  608. type
  609.   TNavButton = class;
  610.   TNavDataLink = class;
  611.  
  612.   TNavGlyph = (ngEnabled, ngDisabled);
  613.   TNavigateBtn = (nbFirst, nbPrior, nbNext, nbLast,
  614.                   nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh);
  615.   TButtonSet = set of TNavigateBtn;
  616.   TNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
  617.  
  618.   ENavClick = procedure (Sender: TObject; Button: TNavigateBtn) of object;
  619.  
  620. { TDBNavigator }
  621.  
  622.   TDBNavigator = class (TCustomPanel)
  623.   private
  624.     FDataLink: TNavDataLink;
  625.     FVisibleButtons: TButtonSet;
  626.     FHints: TStrings;
  627.     ButtonWidth: Integer;
  628.     MinBtnSize: TPoint;
  629.     FOnNavClick: ENavClick;
  630.     FocusedButton: TNavigateBtn;
  631.     FConfirmDelete: Boolean;
  632.     function GetDataSource: TDataSource;
  633.     procedure SetDataSource(Value: TDataSource);
  634.     procedure InitButtons;
  635.     procedure InitHints;
  636.     procedure Click(Sender: TObject);
  637.     procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
  638.       Shift: TShiftState; X, Y: Integer);
  639.     procedure SetVisible(Value: TButtonSet);
  640.     procedure AdjustSize (var W: Integer; var H: Integer);
  641.     procedure SetHints(Value: TStrings);
  642.     procedure WMSize(var Message: TWMSize);  message WM_SIZE;
  643.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  644.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  645.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  646.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  647.   protected
  648.     Buttons: array[TNavigateBtn] of TNavButton;
  649.     procedure DataChanged;
  650.     procedure EditingChanged;
  651.     procedure ActiveChanged;
  652.     procedure Loaded; override;
  653.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  654.     procedure Notification(AComponent: TComponent;
  655.       Operation: TOperation); override;
  656.   public
  657.     constructor Create(AOwner: TComponent); override;
  658.     destructor Destroy; override;
  659.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  660.     procedure BtnClick(Index: TNavigateBtn);
  661.   published
  662.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  663.     property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
  664.       default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
  665.         nbEdit, nbPost, nbCancel, nbRefresh];
  666.     property Align;
  667.     property DragCursor;
  668.     property DragMode;
  669.     property Enabled;
  670.     property Ctl3D;
  671.     property Hints: TStrings read FHints write SetHints;
  672.     property ParentCtl3D;
  673.     property ParentShowHint;
  674.     property PopupMenu;
  675.     property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
  676.     property ShowHint;
  677.     property TabOrder;
  678.     property TabStop;
  679.     property Visible;
  680.     property OnClick: ENavClick read FOnNavClick write FOnNavClick;
  681.     property OnDblClick;
  682.     property OnDragDrop;
  683.     property OnDragOver;
  684.     property OnEndDrag;
  685.     property OnEnter;
  686.     property OnExit;
  687.     property OnResize;
  688.   end;
  689.  
  690. { TNavButton }
  691.  
  692.   TNavButton = class(TSpeedButton)
  693.   private
  694.     FIndex: TNavigateBtn;
  695.     FNavStyle: TNavButtonStyle;
  696.     FRepeatTimer: TTimer;
  697.     procedure TimerExpired(Sender: TObject);
  698.   protected
  699.     procedure Paint; override;
  700.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  701.       X, Y: Integer); override;
  702.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  703.       X, Y: Integer); override;
  704.   public
  705.     destructor Destroy; override;
  706.     property NavStyle: TNavButtonStyle read FNavStyle write FNavStyle;
  707.     property Index : TNavigateBtn read FIndex write FIndex;
  708.   end;
  709.  
  710. { TNavDataLink }
  711.  
  712.   TNavDataLink = class(TDataLink)
  713.   private
  714.     FNavigator: TDBNavigator;
  715.   protected
  716.     procedure EditingChanged; override;
  717.     procedure DataSetChanged; override;
  718.     procedure ActiveChanged; override;
  719.   public
  720.     constructor Create(ANav: TDBNavigator);
  721.     destructor Destroy; override;
  722.   end;
  723.  
  724. implementation
  725.  
  726. uses DBIErrs, DBITypes, Clipbrd, DBConsts, Dialogs;
  727.  
  728. {$R DBCTRLS}
  729.  
  730. { TDBEdit }
  731.  
  732. constructor TDBEdit.Create(AOwner: TComponent);
  733. begin
  734.   inherited Create(AOwner);
  735.   inherited ReadOnly := True;
  736.   FDataLink := TFieldDataLink.Create;
  737.   FDataLink.Control := Self;
  738.   FDataLink.OnDataChange := DataChange;
  739.   FDataLink.OnEditingChange := EditingChange;
  740.   FDataLink.OnUpdateData := UpdateData;
  741.   CalcTextMargin;
  742. end;
  743.  
  744. destructor TDBEdit.Destroy;
  745. begin
  746.   FDataLink.Free;
  747.   FDataLink := nil;
  748.   FCanvas.Free;
  749.   inherited Destroy;
  750. end;
  751.  
  752. procedure TDBEdit.Notification(AComponent: TComponent;
  753.   Operation: TOperation);
  754. begin
  755.   inherited Notification(AComponent, Operation);
  756.   if (Operation = opRemove) and (FDataLink <> nil) and
  757.     (AComponent = DataSource) then DataSource := nil;
  758. end;
  759.  
  760. procedure TDBEdit.KeyDown(var Key: Word; Shift: TShiftState);
  761. begin
  762.   inherited KeyDown(Key, Shift);
  763.   if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  764.     FDataLink.Edit;
  765. end;
  766.  
  767. procedure TDBEdit.KeyPress(var Key: Char);
  768. begin
  769.   inherited KeyPress(Key);
  770.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  771.     not FDataLink.Field.IsValidChar(Key) then
  772.   begin
  773.     MessageBeep(0);
  774.     Key := #0;
  775.   end;
  776.   case Key of
  777.     ^H, ^V, ^X, #32..#255:
  778.       FDataLink.Edit;
  779.     #27:
  780.       begin
  781.         FDataLink.Reset;
  782.         SelectAll;
  783.         Key := #0;
  784.       end;
  785.   end;
  786. end;
  787.  
  788. function TDBEdit.EditCanModify: Boolean;
  789. begin
  790.   Result := FDataLink.Edit;
  791. end;
  792.  
  793. procedure TDBEdit.Reset;
  794. begin
  795.   FDataLink.Reset;
  796.   SelectAll;
  797. end;
  798.  
  799. procedure TDBEdit.SetFocused(Value: Boolean);
  800. begin
  801.   if FFocused <> Value then
  802.   begin
  803.     FFocused := Value;
  804.     if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
  805.     FDataLink.Reset;
  806.   end;
  807. end;
  808.  
  809. procedure TDBEdit.Change;
  810. begin
  811.   FDataLink.Modified;
  812.   inherited Change;
  813. end;
  814.  
  815. function TDBEdit.GetDataSource: TDataSource;
  816. begin
  817.   Result := FDataLink.DataSource;
  818. end;
  819.  
  820. procedure TDBEdit.SetDataSource(Value: TDataSource);
  821. begin
  822.   FDataLink.DataSource := Value;
  823. end;
  824.  
  825. function TDBEdit.GetDataField: string;
  826. begin
  827.   Result := FDataLink.FieldName;
  828. end;
  829.  
  830. procedure TDBEdit.SetDataField(const Value: string);
  831. begin
  832.   FDataLink.FieldName := Value;
  833. end;
  834.  
  835. function TDBEdit.GetReadOnly: Boolean;
  836. begin
  837.   Result := FDataLink.ReadOnly;
  838. end;
  839.  
  840. procedure TDBEdit.SetReadOnly(Value: Boolean);
  841. begin
  842.   FDataLink.ReadOnly := Value;
  843. end;
  844.  
  845. function TDBEdit.GetField: TField;
  846. begin
  847.   Result := FDataLink.Field;
  848. end;
  849.  
  850. procedure TDBEdit.DataChange(Sender: TObject);
  851. begin
  852.   if FDataLink.Field <> nil then
  853.   begin
  854.     if FAlignment <> FDataLink.Field.Alignment then
  855.     begin
  856.       EditText := '';  {forces update}
  857.       FAlignment := FDataLink.Field.Alignment;
  858.     end;
  859.     EditMask := FDataLink.Field.EditMask;
  860.     if FDataLink.Field.DataType = ftString then
  861.       MaxLength := FDataLink.Field.Size else
  862.       MaxLength := 0;
  863.     if FFocused and FDataLink.CanModify then
  864.       Text := FDataLink.Field.Text
  865.     else
  866.       EditText := FDataLink.Field.DisplayText;
  867.   end else
  868.   begin
  869.     FAlignment := taLeftJustify;
  870.     EditMask := '';
  871.     MaxLength := 0;
  872.     if csDesigning in ComponentState then
  873.       EditText := Name else
  874.       EditText := '';
  875.   end;
  876. end;
  877.  
  878. procedure TDBEdit.EditingChange(Sender: TObject);
  879. begin
  880.   inherited ReadOnly := not FDataLink.Editing;
  881. end;
  882.  
  883. procedure TDBEdit.UpdateData(Sender: TObject);
  884. begin
  885.   ValidateEdit;
  886.   FDataLink.Field.Text := Text;
  887. end;
  888.  
  889. procedure TDBEdit.WMPaste(var Message: TMessage);
  890. begin
  891.   FDataLink.Edit;
  892.   inherited;
  893. end;
  894.  
  895. procedure TDBEdit.WMCut(var Message: TMessage);
  896. begin
  897.   FDataLink.Edit;
  898.   inherited;
  899. end;
  900.  
  901. procedure TDBEdit.CMEnter(var Message: TCMEnter);
  902. begin
  903.   SetFocused(True);
  904.   inherited;
  905. end;
  906.  
  907. procedure TDBEdit.CMExit(var Message: TCMExit);
  908. begin
  909.   try
  910.     FDataLink.UpdateRecord;
  911.   except
  912.     SelectAll;
  913.     SetFocus;
  914.     raise;
  915.   end;
  916.   SetFocused(False);
  917.   SetCursor(0);
  918.   DoExit;
  919. end;
  920.  
  921. procedure TDBEdit.WMPaint(var Message: TWMPaint);
  922. var
  923.   Width, Indent, Left, I: Integer;
  924.   R: TRect;
  925.   DC: HDC;
  926.   PS: TPaintStruct;
  927.   S: string;
  928. begin
  929.   if (FAlignment = taLeftJustify) or FFocused then
  930.   begin
  931.     inherited;
  932.     Exit;
  933.   end;
  934. { Since edit controls do not handle justification unless multi-line (and
  935.   then only poorly) we will draw right and center justify manually unless
  936.   the edit has the focus. }
  937.   if FCanvas = nil then
  938.   begin
  939.     FCanvas := TControlCanvas.Create;
  940.     FCanvas.Control := Self;
  941.   end;
  942.   DC := Message.DC;
  943.   if DC = 0 then DC := BeginPaint(Handle, PS);
  944.   FCanvas.Handle := DC;
  945.   try
  946.     FCanvas.Font := Font;
  947.     with FCanvas do
  948.     begin
  949.       R := ClientRect;
  950.       if (BorderStyle = bsSingle) then
  951.       begin
  952.         Brush.Color := clWindowFrame;
  953.         FrameRect(R);
  954.         InflateRect(R, -1, -1);
  955.       end;
  956.       Brush.Color := Color;
  957.       S := EditText;
  958.       if PasswordChar <> #0 then
  959.       begin
  960.         for I := 1 to Length(S) do
  961.           S[I] := PasswordChar;
  962.       end;
  963.       Width := TextWidth(S);
  964.       if BorderStyle = bsNone then Indent := 0 else Indent := FTextMargin;
  965.       if FAlignment = taRightJustify then
  966.         Left := R.Right - Width - Indent else
  967.         Left := (R.Left + R.Right - Width) div 2;
  968.       TextRect(R, Left, Indent, S);
  969.     end;
  970.   finally
  971.     FCanvas.Handle := 0;
  972.     if Message.DC = 0 then EndPaint(Handle, PS);
  973.   end;
  974. end;
  975.  
  976. procedure TDBEdit.CMFontChanged(var Message: TMessage);
  977. begin
  978.   inherited;
  979.   CalcTextMargin;
  980. end;
  981.  
  982. procedure TDBEdit.CalcTextMargin;
  983. var
  984.   DC: HDC;
  985.   SaveFont: HFont;
  986.   I: Integer;
  987.   SysMetrics, Metrics: TTextMetric;
  988. begin
  989.   DC := GetDC(0);
  990.   GetTextMetrics(DC, SysMetrics);
  991.   SaveFont := SelectObject(DC, Font.Handle);
  992.   GetTextMetrics(DC, Metrics);
  993.   SelectObject(DC, SaveFont);
  994.   ReleaseDC(0, DC);
  995.   I := SysMetrics.tmHeight;
  996.   if I > Metrics.tmHeight then I := Metrics.tmHeight;
  997.   FTextMargin := I div 4;
  998. end;
  999.  
  1000. { TDBText }
  1001.  
  1002. constructor TDBText.Create(AOwner: TComponent);
  1003. begin
  1004.   inherited Create(AOwner);
  1005.   AutoSize := False;
  1006.   ShowAccelChar := False;
  1007.   FDataLink := TFieldDataLink.Create;
  1008.   FDataLink.OnDataChange := DataChange;
  1009. end;
  1010.  
  1011. destructor TDBText.Destroy;
  1012. begin
  1013.   FDataLink.Free;
  1014.   FDataLink := nil;
  1015.   inherited Destroy;
  1016. end;
  1017.  
  1018. procedure TDBText.Notification(AComponent: TComponent;
  1019.   Operation: TOperation);
  1020. begin
  1021.   inherited Notification(AComponent, Operation);
  1022.   if (Operation = opRemove) and (FDataLink <> nil) and
  1023.     (AComponent = DataSource) then DataSource := nil;
  1024. end;
  1025.  
  1026. function TDBText.GetDataSource: TDataSource;
  1027. begin
  1028.   Result := FDataLink.DataSource;
  1029. end;
  1030.  
  1031. procedure TDBText.SetDataSource(Value: TDataSource);
  1032. begin
  1033.   FDataLink.DataSource := Value;
  1034. end;
  1035.  
  1036. function TDBText.GetDataField: string;
  1037. begin
  1038.   Result := FDataLink.FieldName;
  1039. end;
  1040.  
  1041. procedure TDBText.SetDataField(const Value: string);
  1042. begin
  1043.   FDataLink.FieldName := Value;
  1044. end;
  1045.  
  1046. function TDBText.GetField: TField;
  1047. begin
  1048.   Result := FDataLink.Field;
  1049. end;
  1050.  
  1051. procedure TDBText.DataChange(Sender: TObject);
  1052. begin
  1053.   if FDataLink.Field <> nil then
  1054.     Caption := FDataLink.Field.DisplayText
  1055.   else
  1056.     if csDesigning in ComponentState then Caption := Name else Caption := '';
  1057. end;
  1058.  
  1059. { TDBCheckBox }
  1060.  
  1061. constructor TDBCheckBox.Create(AOwner: TComponent);
  1062. begin
  1063.   inherited Create(AOwner);
  1064.   State := cbUnchecked;
  1065.   FValueCheck := NewStr(LoadStr(STextTrue));
  1066.   FValueUncheck := NewStr(LoadStr(STextFalse));
  1067.   FDataLink := TFieldDataLink.Create;
  1068.   FDataLink.Control := Self;
  1069.   FDataLink.OnDataChange := DataChange;
  1070.   FDataLink.OnUpdateData := UpdateData;
  1071. end;
  1072.  
  1073. destructor TDBCheckBox.Destroy;
  1074. begin
  1075.   FDataLink.Free;
  1076.   FDataLink := nil;
  1077.   DisposeStr(FValueUncheck);
  1078.   DisposeStr(FValueCheck);
  1079.   inherited Destroy;
  1080. end;
  1081.  
  1082. procedure TDBCheckBox.Notification(AComponent: TComponent;
  1083.   Operation: TOperation);
  1084. begin
  1085.   inherited Notification(AComponent, Operation);
  1086.   if (Operation = opRemove) and (FDataLink <> nil) and
  1087.     (AComponent = DataSource) then DataSource := nil;
  1088. end;
  1089.  
  1090. procedure TDBCheckBox.DataChange(Sender: TObject);
  1091. var
  1092.   NewState: TCheckBoxState;
  1093.   Text: string;
  1094. begin
  1095.   NewState := cbGrayed;
  1096.   if (FDataLink.Field <> nil) and not FDataLink.Field.IsNull then
  1097.     if FDataLink.Field.DataType = ftBoolean then
  1098.       if FDataLink.Field.AsBoolean then
  1099.         NewState := cbChecked
  1100.       else
  1101.         NewState := cbUnchecked
  1102.     else
  1103.     begin
  1104.       Text := FDataLink.Field.Text;
  1105.       if ValueMatch(FValueCheck^, Text) then NewState := cbChecked else
  1106.         if ValueMatch(FValueUncheck^, Text) then NewState := cbUnchecked;
  1107.    end;
  1108.   State := NewState;
  1109. end;
  1110.  
  1111. procedure TDBCheckBox.UpdateData(Sender: TObject);
  1112. var
  1113.   Pos: Integer;
  1114.   S: PString;
  1115. begin
  1116.   if State = cbGrayed then
  1117.     FDataLink.Field.Clear
  1118.   else
  1119.     if FDataLink.Field.DataType = ftBoolean then
  1120.       FDataLink.Field.AsBoolean := Checked
  1121.     else
  1122.     begin
  1123.       if Checked then S := FValueCheck else S := FValueUncheck;
  1124.       Pos := 1;
  1125.       FDataLink.Field.Text := ExtractFieldName(S^, Pos);
  1126.     end;
  1127. end;
  1128.  
  1129. function TDBCheckBox.ValueMatch(const ValueList, Value: string): Boolean;
  1130. var
  1131.   Pos: Integer;
  1132. begin
  1133.   Result := False;
  1134.   Pos := 1;
  1135.   while Pos <= Length(ValueList) do
  1136.     if AnsiCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
  1137.     begin
  1138.       Result := True;
  1139.       Break;
  1140.     end;
  1141. end;
  1142.  
  1143. procedure TDBCheckBox.Toggle;
  1144. begin
  1145.   if FDataLink.Edit then
  1146.   begin
  1147.     inherited Toggle;
  1148.     FDataLink.Modified;
  1149.   end;
  1150. end;
  1151.  
  1152. function TDBCheckBox.GetDataSource: TDataSource;
  1153. begin
  1154.   Result := FDataLink.DataSource;
  1155. end;
  1156.  
  1157. procedure TDBCheckBox.SetDataSource(Value: TDataSource);
  1158. begin
  1159.   FDataLink.DataSource := Value;
  1160. end;
  1161.  
  1162. function TDBCheckBox.GetDataField: string;
  1163. begin
  1164.   Result := FDataLink.FieldName;
  1165. end;
  1166.  
  1167. procedure TDBCheckBox.SetDataField(const Value: string);
  1168. begin
  1169.   FDataLink.FieldName := Value;
  1170. end;
  1171.  
  1172. function TDBCheckBox.GetReadOnly: Boolean;
  1173. begin
  1174.   Result := FDataLink.ReadOnly;
  1175. end;
  1176.  
  1177. procedure TDBCheckBox.SetReadOnly(Value: Boolean);
  1178. begin
  1179.   FDataLink.ReadOnly := Value;
  1180. end;
  1181.  
  1182. function TDBCheckBox.GetField: TField;
  1183. begin
  1184.   Result := FDataLink.Field;
  1185. end;
  1186.  
  1187. procedure TDBCheckBox.KeyPress(var Key: Char);
  1188. begin
  1189.   inherited KeyPress(Key);
  1190.   case Key of
  1191.     #8, ' ':
  1192.       FDataLink.Edit;
  1193.     #27:
  1194.       FDataLink.Reset;
  1195.   end;
  1196. end;
  1197.  
  1198. function TDBCheckBox.GetValueCheck: string;
  1199. begin
  1200.   Result := FValueCheck^;
  1201. end;
  1202.  
  1203. function TDBCheckBox.GetValueUncheck: string;
  1204. begin
  1205.   Result := FValueUncheck^;
  1206. end;
  1207.  
  1208. procedure TDBCheckBox.SetValueCheck(const Value: string);
  1209. begin
  1210.   AssignStr(FValueCheck, Value);
  1211.   DataChange(Self);
  1212. end;
  1213.  
  1214. procedure TDBCheckBox.SetValueUncheck(const Value: string);
  1215. begin
  1216.   AssignStr(FValueUncheck, Value);
  1217.   DataChange(Self);
  1218. end;
  1219.  
  1220. procedure TDBCheckBox.CMExit(var Message: TCMExit);
  1221. begin
  1222.   try
  1223.     FDataLink.UpdateRecord;
  1224.   except
  1225.     SetFocus;
  1226.     raise;
  1227.   end;
  1228.   inherited;
  1229. end;
  1230.  
  1231. { TDBComboBox }
  1232.  
  1233. constructor TDBComboBox.Create(AOwner: TComponent);
  1234. begin
  1235.   inherited Create(AOwner);
  1236.   FDataLink := TFieldDataLink.Create;
  1237.   FDataLink.Control := Self;
  1238.   FDataLink.OnDataChange := DataChange;
  1239.   FDataLink.OnUpdateData := UpdateData;
  1240.   FDataLink.OnEditingChange := EditingChange;
  1241. end;
  1242.  
  1243. destructor TDBComboBox.Destroy;
  1244. begin
  1245.   FDataLink.Free;
  1246.   FDataLink := nil;
  1247.   inherited Destroy;
  1248. end;
  1249.  
  1250. procedure TDBComboBox.Notification(AComponent: TComponent;
  1251.   Operation: TOperation);
  1252. begin
  1253.   inherited Notification(AComponent, Operation);
  1254.   if (Operation = opRemove) and (FDataLink <> nil) and
  1255.     (AComponent = DataSource) then DataSource := nil;
  1256. end;
  1257.  
  1258. procedure TDBComboBox.CreateWnd;
  1259. begin
  1260.   inherited CreateWnd;
  1261.   SetEditReadOnly;
  1262. end;
  1263.  
  1264. procedure TDBComboBox.DataChange(Sender: TObject);
  1265. begin
  1266.   if FDataLink.Field <> nil then
  1267.     SetComboText(FDataLink.Field.Text)
  1268.   else
  1269.     if csDesigning in ComponentState then
  1270.       SetComboText(Name)
  1271.     else
  1272.       SetComboText('');
  1273. end;
  1274.  
  1275. procedure TDBComboBox.UpdateData(Sender: TObject);
  1276. begin
  1277.   FDataLink.Field.Text := GetComboText;
  1278. end;
  1279.  
  1280. procedure TDBComboBox.SetComboText(const Value: string);
  1281. var
  1282.   I: Integer;
  1283. begin
  1284.   if Value <> GetComboText then
  1285.   begin
  1286.     if Style <> csDropDown then
  1287.     begin
  1288.       if Value = '' then I := -1 else I := Items.IndexOf(Value);
  1289.       ItemIndex := I;
  1290.       if I >= 0 then Exit;
  1291.     end;
  1292.     if Style in [csDropDown, csSimple] then Text := Value;
  1293.   end;
  1294. end;
  1295.  
  1296. function TDBComboBox.GetComboText: string;
  1297. var
  1298.   I: Integer;
  1299. begin
  1300.   if Style in [csDropDown, csSimple] then Result := Text else
  1301.   begin
  1302.     I := ItemIndex;
  1303.     if ItemIndex < 0 then Result := '' else Result := Items[I];
  1304.   end;
  1305. end;
  1306.  
  1307. procedure TDBComboBox.Change;
  1308. begin
  1309.   FDataLink.Edit;
  1310.   inherited Change;
  1311.   FDataLink.Modified;
  1312. end;
  1313.  
  1314. procedure TDBComboBox.Click;
  1315. begin
  1316.   FDataLink.Edit;
  1317.   inherited Click;
  1318.   FDataLink.Modified;
  1319. end;
  1320.  
  1321. procedure TDBComboBox.DropDown;
  1322. begin
  1323.   FDataLink.Edit;
  1324.   inherited DropDown;
  1325. end;
  1326.  
  1327. function TDBComboBox.GetDataSource: TDataSource;
  1328. begin
  1329.   Result := FDataLink.DataSource;
  1330. end;
  1331.  
  1332. procedure TDBComboBox.SetDataSource(Value: TDataSource);
  1333. begin
  1334.   FDataLink.DataSource := Value;
  1335. end;
  1336.  
  1337. function TDBComboBox.GetDataField: string;
  1338. begin
  1339.   Result := FDataLink.FieldName;
  1340. end;
  1341.  
  1342. procedure TDBComboBox.SetDataField(const Value: string);
  1343. begin
  1344.   FDataLink.FieldName := Value;
  1345. end;
  1346.  
  1347. function TDBComboBox.GetReadOnly: Boolean;
  1348. begin
  1349.   Result := FDataLink.ReadOnly;
  1350. end;
  1351.  
  1352. procedure TDBComboBox.SetReadOnly(Value: Boolean);
  1353. begin
  1354.   FDataLink.ReadOnly := Value;
  1355. end;
  1356.  
  1357. function TDBComboBox.GetField: TField;
  1358. begin
  1359.   Result := FDataLink.Field;
  1360. end;
  1361.  
  1362. procedure TDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  1363. begin
  1364.   inherited KeyDown(Key, Shift);
  1365.   if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
  1366.   begin
  1367.     if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
  1368.       Key := 0;
  1369.   end;
  1370. end;
  1371.  
  1372. procedure TDBComboBox.KeyPress(var Key: Char);
  1373. begin
  1374.   inherited KeyPress(Key);
  1375.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  1376.     not FDataLink.Field.IsValidChar(Key) then
  1377.   begin
  1378.     MessageBeep(0);
  1379.     Key := #0;
  1380.   end;
  1381.   case Key of
  1382.     ^H, ^V, ^X, #32..#255:
  1383.       FDataLink.Edit;
  1384.     #27:
  1385.       begin
  1386.         FDataLink.Reset;
  1387.         SelectAll;
  1388.         Key := #0;
  1389.       end;
  1390.   end;
  1391. end;
  1392.  
  1393. procedure TDBComboBox.EditingChange(Sender: TObject);
  1394. begin
  1395.   SetEditReadOnly;
  1396. end;
  1397.  
  1398. procedure TDBComboBox.SetEditReadOnly;
  1399. begin
  1400.   if (Style in [csDropDown, csSimple]) and HandleAllocated then
  1401.     SendMessage(FEditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
  1402. end;
  1403.  
  1404. procedure TDBComboBox.WndProc(var Message: TMessage);
  1405. begin
  1406.   if not (csDesigning in ComponentState) then
  1407.     case Message.Msg of
  1408.       WM_COMMAND:
  1409.         if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
  1410.           if not FDataLink.Edit then
  1411.           begin
  1412.             if Style <> csSimple then
  1413.               PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  1414.             Exit;
  1415.           end;
  1416.       CB_SHOWDROPDOWN:
  1417.         if Message.WParam <> 0 then FDataLink.Edit else
  1418.           if not FDataLink.Editing then DataChange(Self); {Restore text}
  1419.     end;
  1420.   inherited WndProc (Message);
  1421. end;
  1422.  
  1423. procedure TDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  1424.   ComboProc: Pointer);
  1425. begin
  1426.   if not (csDesigning in ComponentState) then
  1427.     case Message.Msg of
  1428.       WM_LBUTTONDOWN:
  1429.         if (Style = csSimple) and (ComboWnd <> FEditHandle) then
  1430.           if not FDataLink.Edit then Exit;
  1431.     end;
  1432.   inherited ComboWndProc (Message, ComboWnd, ComboProc);
  1433. end;
  1434.  
  1435. procedure TDBComboBox.CMExit(var Message: TCMExit);
  1436. begin
  1437.   try
  1438.     FDataLink.UpdateRecord;
  1439.   except
  1440.     SelectAll;
  1441.     SetFocus;
  1442.     raise;
  1443.   end;
  1444.   inherited;
  1445. end;
  1446.  
  1447. procedure TDBComboBox.SetItems(Value: TStrings);
  1448. begin
  1449.   Items.Assign(Value);
  1450.   DataChange(Self);
  1451. end;
  1452.  
  1453. { TDBListBox }
  1454.  
  1455. constructor TDBListBox.Create(AOwner: TComponent);
  1456. begin
  1457.   inherited Create(AOwner);
  1458.   FDataLink := TFieldDataLink.Create;
  1459.   FDataLink.Control := Self;
  1460.   FDataLink.OnDataChange := DataChange;
  1461.   FDataLink.OnUpdateData := UpdateData;
  1462. end;
  1463.  
  1464. destructor TDBListBox.Destroy;
  1465. begin
  1466.   FDataLink.Free;
  1467.   FDataLink := nil;
  1468.   inherited Destroy;
  1469. end;
  1470.  
  1471. procedure TDBListBox.Notification(AComponent: TComponent;
  1472.   Operation: TOperation);
  1473. begin
  1474.   inherited Notification(AComponent, Operation);
  1475.   if (Operation = opRemove) and (FDataLink <> nil) and
  1476.     (AComponent = DataSource) then DataSource := nil;
  1477. end;
  1478.  
  1479. procedure TDBListBox.DataChange(Sender: TObject);
  1480. begin
  1481.   if FDataLink.Field <> nil then
  1482.     ItemIndex := Items.IndexOf(FDataLink.Field.Text) else
  1483.     ItemIndex := -1;
  1484. end;
  1485.  
  1486. procedure TDBListBox.UpdateData(Sender: TObject);
  1487. begin
  1488.   if ItemIndex >= 0 then
  1489.     FDataLink.Field.Text := Items[ItemIndex] else
  1490.     FDataLink.Field.Text := '';
  1491. end;
  1492.  
  1493. procedure TDBListBox.Click;
  1494. begin
  1495.   if FDataLink.Edit then
  1496.   begin
  1497.     inherited Click;
  1498.     FDataLink.Modified;
  1499.   end;
  1500. end;
  1501.  
  1502. function TDBListBox.GetDataSource: TDataSource;
  1503. begin
  1504.   Result := FDataLink.DataSource;
  1505. end;
  1506.  
  1507. procedure TDBListBox.SetDataSource(Value: TDataSource);
  1508. begin
  1509.   FDataLink.DataSource := Value;
  1510. end;
  1511.  
  1512. function TDBListBox.GetDataField: string;
  1513. begin
  1514.   Result := FDataLink.FieldName;
  1515. end;
  1516.  
  1517. procedure TDBListBox.SetDataField(const Value: string);
  1518. begin
  1519.   FDataLink.FieldName := Value;
  1520. end;
  1521.  
  1522. function TDBListBox.GetReadOnly: Boolean;
  1523. begin
  1524.   Result := FDataLink.ReadOnly;
  1525. end;
  1526.  
  1527. procedure TDBListBox.SetReadOnly(Value: Boolean);
  1528. begin
  1529.   FDataLink.ReadOnly := Value;
  1530. end;
  1531.  
  1532. function TDBListBox.GetField: TField;
  1533. begin
  1534.   Result := FDataLink.Field;
  1535. end;
  1536.  
  1537. procedure TDBListBox.KeyDown(var Key: Word; Shift: TShiftState);
  1538. begin
  1539.   inherited KeyDown(Key, Shift);
  1540.   if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP,
  1541.     VK_RIGHT, VK_DOWN] then
  1542.     if not FDataLink.Edit then Key := 0;
  1543. end;
  1544.  
  1545. procedure TDBListBox.KeyPress(var Key: Char);
  1546. begin
  1547.   inherited KeyPress(Key);
  1548.   case Key of
  1549.     #32..#255:
  1550.       if not FDataLink.Edit then Key := #0;
  1551.     #27:
  1552.       FDataLink.Reset;
  1553.   end;
  1554. end;
  1555.  
  1556. procedure TDBListBox.WMLButtonDown(var Message: TWMLButtonDown);
  1557. begin
  1558.   if FDataLink.Edit then inherited
  1559.   else
  1560.   begin
  1561.     SetFocus;
  1562.     with Message do
  1563.       MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  1564.   end;
  1565. end;
  1566.  
  1567. procedure TDBListBox.CMExit(var Message: TCMExit);
  1568. begin
  1569.   try
  1570.     FDataLink.UpdateRecord;
  1571.   except
  1572.     SetFocus;
  1573.     raise;
  1574.   end;
  1575.   inherited;
  1576. end;
  1577.  
  1578. procedure TDBListBox.SetItems(Value: TStrings);
  1579. begin
  1580.   Items.Assign(Value);
  1581.   DataChange(Self);
  1582. end;
  1583.  
  1584. { TDBRadioGroup }
  1585.  
  1586. constructor TDBRadioGroup.Create(AOwner: TComponent);
  1587. var
  1588.   CStyle : TControlStyle;
  1589. begin
  1590.   inherited Create(AOwner);
  1591.   FDataLink := TFieldDataLink.Create;
  1592.   FDataLink.Control := Self;
  1593.   FDataLink.OnDataChange := DataChange;
  1594.   FDataLink.OnUpdateData := UpdateData;
  1595.   FValue := NullStr;
  1596.   FValues := TStringList.Create;
  1597. end;
  1598.  
  1599. destructor TDBRadioGroup.Destroy;
  1600. begin
  1601.   FDataLink.Free;
  1602.   FDataLink := nil;
  1603.   DisposeStr (FValue);
  1604.   FValues.Free;
  1605.   inherited Destroy;
  1606. end;
  1607.  
  1608. procedure TDBRadioGroup.Notification(AComponent: TComponent;
  1609.   Operation: TOperation);
  1610. begin
  1611.   inherited Notification(AComponent, Operation);
  1612.   if (Operation = opRemove) and (FDataLink <> nil) and
  1613.     (AComponent = DataSource) then DataSource := nil;
  1614. end;
  1615.  
  1616. procedure TDBRadioGroup.DataChange(Sender: TObject);
  1617. begin
  1618.   if FDataLink.Field <> nil then
  1619.     Value := FDataLink.Field.Text
  1620.   else
  1621.     Value := EmptyStr;
  1622. end;
  1623.  
  1624. procedure TDBRadioGroup.UpdateData(Sender: TObject);
  1625. begin
  1626.   if FDataLink.Field <> nil then
  1627.     FDataLink.Field.Text := Value;
  1628. end;
  1629.  
  1630. function TDBRadioGroup.GetDataSource: TDataSource;
  1631. begin
  1632.   Result := FDataLink.DataSource;
  1633. end;
  1634.  
  1635. procedure TDBRadioGroup.SetDataSource(Value: TDataSource);
  1636. begin
  1637.   FDataLink.DataSource := Value;
  1638. end;
  1639.  
  1640. function TDBRadioGroup.GetDataField: string;
  1641. begin
  1642.   Result := FDataLink.FieldName;
  1643. end;
  1644.  
  1645. procedure TDBRadioGroup.SetDataField(const Value: string);
  1646. begin
  1647.   FDataLink.FieldName := Value;
  1648. end;
  1649.  
  1650. function TDBRadioGroup.GetReadOnly: Boolean;
  1651. begin
  1652.   Result := FDataLink.ReadOnly;
  1653. end;
  1654.  
  1655. procedure TDBRadioGroup.SetReadOnly(Value: Boolean);
  1656. begin
  1657.   FDataLink.ReadOnly := Value;
  1658. end;
  1659.  
  1660. function TDBRadioGroup.GetField: TField;
  1661. begin
  1662.   Result := FDataLink.Field;
  1663. end;
  1664.  
  1665. function TDBRadioGroup.GetValue : string;
  1666. begin
  1667.   Result := FValue^;
  1668. end;
  1669.  
  1670. function TDBRadioGroup.GetButtonValue(Index: Integer): string;
  1671. begin
  1672.   if (Index < FValues.Count) and (FValues[Index] <> '') then
  1673.     Result := FValues[Index]
  1674.   else if (Index < Items.Count) then
  1675.     Result := Items[Index]
  1676.   else
  1677.     Result := '';
  1678. end;
  1679.  
  1680. procedure TDBRadioGroup.SetValue (const Value: string);
  1681. var
  1682.   I : Integer;
  1683. begin
  1684.   AssignStr(FValue, Value);
  1685.   if (ItemIndex < 0) or (GetButtonValue(ItemIndex) <> Value) then
  1686.   begin
  1687.     if (ItemIndex >= 0) then ItemIndex := -1;
  1688.     for I := 0 to ControlCount - 1 do
  1689.     begin
  1690.       if GetButtonValue(I) = Value then
  1691.       begin
  1692.         ItemIndex := I;
  1693.         break;
  1694.       end;
  1695.     end;
  1696.     Change;
  1697.   end;
  1698. end;
  1699.  
  1700. procedure TDBRadioGroup.CMExit(var Message: TCMExit);
  1701. begin
  1702.   try
  1703.     FDataLink.UpdateRecord;
  1704.   except
  1705.     if ItemIndex >= 0 then TRadioButton(Controls[ItemIndex]).SetFocus
  1706.     else TRadioButton(Controls[0]).SetFocus;
  1707.     raise;
  1708.   end;
  1709.   inherited;
  1710. end;
  1711.  
  1712. procedure TDBRadioGroup.Click;
  1713. begin
  1714.   inherited Click;
  1715.   if ItemIndex >= 0 then
  1716.     Value := GetButtonValue(ItemIndex);
  1717.   if FDataLink.Editing then FDataLink.Modified;
  1718. end;
  1719.  
  1720. procedure TDBRadioGroup.SetItems(Value: TStrings);
  1721. begin
  1722.   Items.Assign(Value);
  1723.   DataChange(Self);
  1724. end;
  1725.  
  1726. procedure TDBRadioGroup.SetValues(Value: TStrings);
  1727. begin
  1728.   FValues.Assign(Value);
  1729.   DataChange(Self);
  1730. end;
  1731.  
  1732. procedure TDBRadioGroup.Change;
  1733. begin
  1734.   if Assigned(FOnChange) then FOnChange(Self);
  1735. end;
  1736.  
  1737. procedure TDBRadioGroup.KeyPress(var Key: Char);
  1738. begin
  1739.   inherited KeyPress(Key);
  1740.   case Key of
  1741.     #8, ' ':
  1742.       FDataLink.Edit;
  1743.     #27:
  1744.       FDataLink.Reset;
  1745.   end;
  1746. end;
  1747.  
  1748. function TDBRadioGroup.CanModify: Boolean;
  1749. begin
  1750.   Result := FDataLink.Edit;
  1751. end;
  1752.  
  1753. { TDBMemo }
  1754.  
  1755. constructor TDBMemo.Create(AOwner: TComponent);
  1756. begin
  1757.   inherited Create(AOwner);
  1758.   inherited ReadOnly := True;
  1759.   FAutoDisplay := True;
  1760.   FDataLink := TFieldDataLink.Create;
  1761.   FDataLink.Control := Self;
  1762.   FDataLink.OnDataChange := DataChange;
  1763.   FDataLink.OnEditingChange := EditingChange;
  1764.   FDataLink.OnUpdateData := UpdateData;
  1765. end;
  1766.  
  1767. destructor TDBMemo.Destroy;
  1768. begin
  1769.   FDataLink.Free;
  1770.   FDataLink := nil;
  1771.   inherited Destroy;
  1772. end;
  1773.  
  1774. procedure TDBMemo.Notification(AComponent: TComponent;
  1775.   Operation: TOperation);
  1776. begin
  1777.   inherited Notification(AComponent, Operation);
  1778.   if (Operation = opRemove) and (FDataLink <> nil) and
  1779.     (AComponent = DataSource) then DataSource := nil;
  1780. end;
  1781.  
  1782. procedure TDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
  1783. begin
  1784.   inherited KeyDown(Key, Shift);
  1785.   if FMemoLoaded then
  1786.   begin
  1787.     if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  1788.       FDataLink.Edit;
  1789.   end else
  1790.     Key := 0;
  1791. end;
  1792.  
  1793. procedure TDBMemo.KeyPress(var Key: Char);
  1794. begin
  1795.   inherited KeyPress(Key);
  1796.   if FMemoLoaded then
  1797.   begin
  1798.     if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  1799.       not FDataLink.Field.IsValidChar(Key) then
  1800.     begin
  1801.       MessageBeep(0);
  1802.       Key := #0;
  1803.     end;
  1804.     case Key of
  1805.       ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
  1806.         FDataLink.Edit;
  1807.       #27:
  1808.         FDataLink.Reset;
  1809.     end;
  1810.   end else
  1811.   begin
  1812.     if Key = #13 then LoadMemo;
  1813.     Key := #0;
  1814.   end;
  1815. end;
  1816.  
  1817. procedure TDBMemo.Change;
  1818. begin
  1819.   FDataLink.Modified;
  1820.   FMemoLoaded := True;
  1821.   inherited Change;
  1822. end;
  1823.  
  1824. function TDBMemo.GetDataSource: TDataSource;
  1825. begin
  1826.   Result := FDataLink.DataSource;
  1827. end;
  1828.  
  1829. procedure TDBMemo.SetDataSource(Value: TDataSource);
  1830. begin
  1831.   FDataLink.DataSource := Value;
  1832. end;
  1833.  
  1834. function TDBMemo.GetDataField: string;
  1835. begin
  1836.   Result := FDataLink.FieldName;
  1837. end;
  1838.  
  1839. procedure TDBMemo.SetDataField(const Value: string);
  1840. begin
  1841.   FDataLink.FieldName := Value;
  1842. end;
  1843.  
  1844. function TDBMemo.GetReadOnly: Boolean;
  1845. begin
  1846.   Result := FDataLink.ReadOnly;
  1847. end;
  1848.  
  1849. procedure TDBMemo.SetReadOnly(Value: Boolean);
  1850. begin
  1851.   FDataLink.ReadOnly := Value;
  1852. end;
  1853.  
  1854. function TDBMemo.GetField: TField;
  1855. begin
  1856.   Result := FDataLink.Field;
  1857. end;
  1858.  
  1859. procedure TDBMemo.LoadMemo;
  1860. begin
  1861.   if not FMemoLoaded and (FDataLink.Field is TBlobField) then
  1862.   begin
  1863.     Lines.Assign(FDataLink.Field);
  1864.     FMemoLoaded := True;
  1865.     EditingChange(Self);
  1866.   end;
  1867. end;
  1868.  
  1869. procedure TDBMemo.DataChange(Sender: TObject);
  1870. begin
  1871.   if FDataLink.Field <> nil then
  1872.     if FDataLink.Field is TBlobField then
  1873.     begin
  1874.       if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
  1875.       begin
  1876.         FMemoLoaded := False;
  1877.         LoadMemo;
  1878.       end else
  1879.       begin
  1880.         Text := '(' + FDataLink.Field.DisplayLabel + ')';
  1881.         FMemoLoaded := False;
  1882.       end;
  1883.     end else
  1884.     begin
  1885.       if FFocused and FDataLink.CanModify then
  1886.         Text := FDataLink.Field.Text
  1887.       else
  1888.         Text := FDataLink.Field.DisplayText;
  1889.       FMemoLoaded := True;
  1890.     end
  1891.   else
  1892.   begin
  1893.     if csDesigning in ComponentState then Text := Name else Text := '';
  1894.     FMemoLoaded := False;
  1895.   end;
  1896. end;
  1897.  
  1898. procedure TDBMemo.EditingChange(Sender: TObject);
  1899. begin
  1900.   inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
  1901. end;
  1902.  
  1903. procedure TDBMemo.UpdateData(Sender: TObject);
  1904. begin
  1905.   if FDataLink.Field is TBlobField then
  1906.     FDataLink.Field.Assign(Lines)
  1907.   else
  1908.     FDataLink.Field.Text := Text;
  1909. end;
  1910.  
  1911. procedure TDBMemo.SetFocused(Value: Boolean);
  1912. begin
  1913.   if FFocused <> Value then
  1914.   begin
  1915.     FFocused := Value;
  1916.     if not (FDataLink.Field is TBlobField) then FDataLink.Reset;
  1917.   end;
  1918. end;
  1919.  
  1920. procedure TDBMemo.CMEnter(var Message: TCMEnter);
  1921. begin
  1922.   SetFocused(True);
  1923.   inherited;
  1924. end;
  1925.  
  1926. procedure TDBMemo.CMExit(var Message: TCMExit);
  1927. begin
  1928.   if not (FDataLink.Field is TBlobField) then
  1929.     try
  1930.       FDataLink.UpdateRecord;
  1931.     except
  1932.       SetFocus;
  1933.       raise;
  1934.     end;
  1935.   SetFocused(False);
  1936.   inherited;
  1937. end;
  1938.  
  1939. procedure TDBMemo.SetAutoDisplay(Value: Boolean);
  1940. begin
  1941.   if FAutoDisplay <> Value then
  1942.   begin
  1943.     FAutoDisplay := Value;
  1944.     if Value then LoadMemo;
  1945.   end;
  1946. end;
  1947.  
  1948. procedure TDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1949. begin
  1950.   if not FMemoLoaded then LoadMemo else inherited;
  1951. end;
  1952.  
  1953. procedure TDBMemo.WMCut(var Message: TMessage);
  1954. begin
  1955.   FDataLink.Edit;
  1956.   inherited;
  1957. end;
  1958.  
  1959. procedure TDBMemo.WMPaste(var Message: TMessage);
  1960. begin
  1961.   FDataLink.Edit;
  1962.   inherited;
  1963. end;
  1964.  
  1965. { TDBImage }
  1966.  
  1967. constructor TDBImage.Create(AOwner: TComponent);
  1968. begin
  1969.   inherited Create(AOwner);
  1970.   ControlStyle := ControlStyle + [csFramed, csOpaque];
  1971.   Width := 105;
  1972.   Height := 105;
  1973.   TabStop := True;
  1974.   ParentColor := False;
  1975.   FPicture := TPicture.Create;
  1976.   FPicture.OnChange := PictureChanged;
  1977.   FBorderStyle := bsSingle;
  1978.   FAutoDisplay := True;
  1979.   FCenter := True;
  1980.   FDataLink := TFieldDataLink.Create;
  1981.   FDataLink.Control := Self;
  1982.   FDataLink.OnDataChange := DataChange;
  1983.   FDataLink.OnUpdateData := UpdateData;
  1984. end;
  1985.  
  1986. destructor TDBImage.Destroy;
  1987. begin
  1988.   FPicture.Free;
  1989.   FDataLink.Free;
  1990.   FDataLink := nil;
  1991.   inherited Destroy;
  1992. end;
  1993.  
  1994. function TDBImage.GetDataSource: TDataSource;
  1995. begin
  1996.   Result := FDataLink.DataSource;
  1997. end;
  1998.  
  1999. procedure TDBImage.SetDataSource(Value: TDataSource);
  2000. begin
  2001.   FDataLink.DataSource := Value;
  2002. end;
  2003.  
  2004. function TDBImage.GetDataField: string;
  2005. begin
  2006.   Result := FDataLink.FieldName;
  2007. end;
  2008.  
  2009. procedure TDBImage.SetDataField(const Value: string);
  2010. begin
  2011.   FDataLink.FieldName := Value;
  2012. end;
  2013.  
  2014. function TDBImage.GetReadOnly: Boolean;
  2015. begin
  2016.   Result := FDataLink.ReadOnly;
  2017. end;
  2018.  
  2019. procedure TDBImage.SetReadOnly(Value: Boolean);
  2020. begin
  2021.   FDataLink.ReadOnly := Value;
  2022. end;
  2023.  
  2024. function TDBImage.GetField: TField;
  2025. begin
  2026.   Result := FDataLink.Field;
  2027. end;
  2028.  
  2029. function TDBImage.GetPalette: HPALETTE;
  2030. begin
  2031.   Result := 0;
  2032.   if FPicture.Graphic is TBitmap then
  2033.     Result := TBitmap(FPicture.Graphic).Palette;
  2034. end;
  2035.  
  2036. procedure TDBImage.SetAutoDisplay(Value: Boolean);
  2037. begin
  2038.   if FAutoDisplay <> Value then
  2039.   begin
  2040.     FAutoDisplay := Value;
  2041.     if Value then LoadPicture;
  2042.   end;
  2043. end;
  2044.  
  2045. procedure TDBImage.SetBorderStyle(Value: TBorderStyle);
  2046. begin
  2047.   if FBorderStyle <> Value then
  2048.   begin
  2049.     FBorderStyle := Value;
  2050.     RecreateWnd;
  2051.   end;
  2052. end;
  2053.  
  2054. procedure TDBImage.SetCenter(Value: Boolean);
  2055. begin
  2056.   if FCenter <> Value then
  2057.   begin
  2058.     FCenter := Value;
  2059.     Invalidate;
  2060.   end;
  2061. end;
  2062.  
  2063. procedure TDBImage.SetPicture(Value: TPicture);
  2064. begin
  2065.   FPicture.Assign(Value);
  2066. end;
  2067.  
  2068. procedure TDBImage.SetStretch(Value: Boolean);
  2069. begin
  2070.   if FStretch <> Value then
  2071.   begin
  2072.     FStretch := Value;
  2073.     Invalidate;
  2074.   end;
  2075. end;
  2076.  
  2077. procedure TDBImage.Paint;
  2078. var
  2079.   W, H: Integer;
  2080.   R: TRect;
  2081.   S: string[63];
  2082. begin
  2083.   with Canvas do
  2084.   begin
  2085.     Brush.Style := bsSolid;
  2086.     Brush.Color := Color;
  2087.     if FPictureLoaded then
  2088.     begin
  2089.       if Stretch then
  2090.         if Picture.Graphic.Empty then
  2091.           FillRect(ClientRect) else
  2092.           StretchDraw(ClientRect, Picture.Graphic)
  2093.       else
  2094.       begin
  2095.         SetRect(R, 0, 0, Picture.Width, Picture.Height);
  2096.         if Center then OffsetRect(R, (ClientWidth - Picture.Width) div 2,
  2097.           (ClientHeight - Picture.Height) div 2);
  2098.         StretchDraw(R, Picture.Graphic);
  2099.         ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
  2100.         FillRect(ClientRect);
  2101.         SelectClipRgn(Handle, 0);
  2102.       end;
  2103.     end else
  2104.     begin
  2105.       Font := Self.Font;
  2106.       if FDataLink.Field <> nil then
  2107.         S := FDataLink.Field.DisplayLabel else
  2108.         S := Name;
  2109.       S := '(' + S + ')';
  2110.       W := TextWidth(S);
  2111.       H := TextHeight(S);
  2112.       R := ClientRect;
  2113.       TextRect(R, (R.Right - W) div 2, (R.Bottom - H) div 2, S);
  2114.     end;
  2115.     if (GetParentForm(Self).ActiveControl = Self) and
  2116.       not (csDesigning in ComponentState) then
  2117.     begin
  2118.       Brush.Color := clWindowFrame;
  2119.       FrameRect(ClientRect);
  2120.     end;
  2121.   end;
  2122. end;
  2123.  
  2124. procedure TDBImage.PictureChanged(Sender: TObject);
  2125. begin
  2126.   FDataLink.Modified;
  2127.   FPictureLoaded := True;
  2128.   Invalidate;
  2129. end;
  2130.  
  2131. procedure TDBImage.Notification(AComponent: TComponent;
  2132.   Operation: TOperation);
  2133. begin
  2134.   inherited Notification(AComponent, Operation);
  2135.   if (Operation = opRemove) and (FDataLink <> nil) and
  2136.     (AComponent = DataSource) then DataSource := nil;
  2137. end;
  2138.  
  2139. procedure TDBImage.LoadPicture;
  2140. begin
  2141.   if not FPictureLoaded and (FDataLink.Field is TBlobField) then
  2142.     Picture.Assign(FDataLink.Field);
  2143. end;
  2144.  
  2145. procedure TDBImage.DataChange(Sender: TObject);
  2146. begin
  2147.   Picture.Graphic := nil;
  2148.   FPictureLoaded := False;
  2149.   if FAutoDisplay then LoadPicture;
  2150. end;
  2151.  
  2152. procedure TDBImage.UpdateData(Sender: TObject);
  2153. begin
  2154.   if FDataLink.Field is TBlobField then
  2155.     with TBlobField(FDataLink.Field) do
  2156.       if Picture.Graphic is TBitmap then
  2157.         Assign(Picture.Graphic)
  2158.       else
  2159.         Clear;
  2160. end;
  2161.  
  2162. procedure TDBImage.CopyToClipboard;
  2163. begin
  2164.   if Picture.Graphic <> nil then Clipboard.Assign(Picture);
  2165. end;
  2166.  
  2167. procedure TDBImage.CutToClipboard;
  2168. begin
  2169.   if Picture.Graphic <> nil then
  2170.   begin
  2171.     CopyToClipboard;
  2172.     if FDataLink.Edit then
  2173.       Picture.Graphic := nil;
  2174.   end;
  2175. end;
  2176.  
  2177. procedure TDBImage.PasteFromClipboard;
  2178. begin
  2179.   if Clipboard.HasFormat(CF_PICTURE) and FDataLink.Edit then
  2180.     Picture.Assign(Clipboard);
  2181. end;
  2182.  
  2183. procedure TDBImage.CreateParams(var Params: TCreateParams);
  2184. begin
  2185.   inherited CreateParams(Params);
  2186.   if FBorderStyle = bsSingle then
  2187.     Params.Style := Params.Style or WS_BORDER;
  2188. end;
  2189.  
  2190. procedure TDBImage.KeyDown(var Key: Word; Shift: TShiftState);
  2191. begin
  2192.   inherited KeyDown(Key, Shift);
  2193.   case Key of
  2194.     VK_INSERT:
  2195.       if ssShift in Shift then PasteFromClipBoard else
  2196.         if ssCtrl in Shift then CopyToClipBoard;
  2197.     VK_DELETE:
  2198.       if ssShift in Shift then CutToClipBoard;
  2199.   end;
  2200. end;
  2201.  
  2202. procedure TDBImage.KeyPress(var Key: Char);
  2203. begin
  2204.   inherited KeyPress(Key);
  2205.   case Key of
  2206.     ^X: CutToClipBoard;
  2207.     ^C: CopyToClipBoard;
  2208.     ^V: PasteFromClipBoard;
  2209.     #13: LoadPicture;
  2210.     #27: FDataLink.Reset;
  2211.   end;
  2212. end;
  2213.  
  2214. procedure TDBImage.CMEnter(var Message: TCMEnter);
  2215. begin
  2216.   Invalidate; { Draw the focus marker }
  2217.   inherited;
  2218. end;
  2219.  
  2220. procedure TDBImage.CMExit(var Message: TCMExit);
  2221. begin
  2222.   Invalidate; { Erase the focus marker }
  2223.   inherited;
  2224. end;
  2225.  
  2226. procedure TDBImage.CMTextChanged(var Message: TMessage);
  2227. begin
  2228.   inherited;
  2229.   if not FPictureLoaded then Invalidate;
  2230. end;
  2231.  
  2232. procedure TDBImage.WMLButtonDown(var Message: TWMLButtonDown);
  2233. begin
  2234.   if TabStop and CanFocus then SetFocus;
  2235.   inherited;
  2236. end;
  2237.  
  2238. procedure TDBImage.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  2239. begin
  2240.   LoadPicture;
  2241.   inherited;
  2242. end;
  2243.  
  2244. procedure TDBImage.WMCut(var Message: TMessage);
  2245. begin
  2246.   CutToClipboard;
  2247. end;
  2248.  
  2249. procedure TDBImage.WMCopy(var Message: TMessage);
  2250. begin
  2251.   CopyToClipboard;
  2252. end;
  2253.  
  2254. procedure TDBImage.WMPaste(var Message: TMessage);
  2255. begin
  2256.   PasteFromClipboard;
  2257. end;
  2258.  
  2259. { TDBNavigator }
  2260.  
  2261. const
  2262.   BtnStateName: array[TNavGlyph] of PChar = ('EN', 'DI');
  2263.   BtnTypeName: array[TNavigateBtn] of PChar = ('FIRST', 'PRIOR', 'NEXT',
  2264.     'LAST', 'INSERT', 'DELETE', 'EDIT', 'POST', 'CANCEL', 'REFRESH');
  2265.   BtnHintId: array[TNavigateBtn] of Word = (SFirstRecord, SPriorRecord,
  2266.     SNextRecord, SLastRecord, SInsertRecord, SDeleteRecord, SEditRecord,
  2267.     SPostEdit, SCancelEdit, SRefreshRecord);
  2268.  
  2269. constructor TDBNavigator.Create(AOwner: TComponent);
  2270. begin
  2271.   inherited Create(AOwner);
  2272.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
  2273.     [csFramed, csOpaque];
  2274.   FDataLink := TNavDataLink.Create(Self);
  2275.   FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
  2276.     nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  2277.   FHints := TStringList.Create;
  2278.   InitButtons;
  2279.   BevelOuter := bvNone;
  2280.   BevelInner := bvNone;
  2281.   Width := 241;
  2282.   Height := 25;
  2283.   ButtonWidth := 0;
  2284.   FocusedButton := nbFirst;
  2285.   FConfirmDelete := True;
  2286. end;
  2287.  
  2288. destructor TDBNavigator.Destroy;
  2289. begin
  2290.   FDataLink.Free;
  2291.   FDataLink := nil;
  2292.   inherited Destroy;
  2293. end;
  2294.  
  2295. procedure TDBNavigator.InitButtons;
  2296. var
  2297.   I: TNavigateBtn;
  2298.   Btn: TNavButton;
  2299.   X: Integer;
  2300.   ResName: array[0..40] of Char;
  2301. begin
  2302.   MinBtnSize := Point(20, 18);
  2303.   X := 0;
  2304.   for I := Low(Buttons) to High(Buttons) do
  2305.   begin
  2306.     Btn := TNavButton.Create (Self);
  2307.     Btn.Index := I;
  2308.     Btn.Visible := I in FVisibleButtons;
  2309.     Btn.Enabled := True;
  2310.     Btn.SetBounds (X, 0, MinBtnSize.X, MinBtnSize.Y);
  2311.     Btn.Glyph.Handle := LoadBitmap(HInstance,
  2312.         StrFmt(ResName, 'dbn_%s', [BtnTypeName[I]]));
  2313.     Btn.NumGlyphs := 2;
  2314.     Btn.OnClick := Click;
  2315.     Btn.OnMouseDown := BtnMouseDown;
  2316.     Btn.Parent := Self;
  2317.     Buttons[I] := Btn;
  2318.     X := X + MinBtnSize.X;
  2319.   end;
  2320.   InitHints;
  2321.   Buttons[nbPrior].NavStyle := Buttons[nbPrior].NavStyle + [nsAllowTimer];
  2322.   Buttons[nbNext].NavStyle  := Buttons[nbNext].NavStyle + [nsAllowTimer];
  2323. end;
  2324.  
  2325. procedure TDBNavigator.InitHints;
  2326. var
  2327.   I: Integer;
  2328.   J: TNavigateBtn;
  2329. begin
  2330.   for J := Low(Buttons) to High(Buttons) do
  2331.     Buttons[J].Hint := LoadStr (BtnHintId[J]);
  2332.   J := Low(Buttons);
  2333.   for I := 0 to (FHints.Count - 1) do
  2334.   begin
  2335.     if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I];
  2336.     if J = High(Buttons) then Exit;
  2337.     Inc(J);
  2338.   end;
  2339. end;
  2340.  
  2341. procedure TDBNavigator.SetHints(Value: TStrings);
  2342. begin
  2343.   FHints.Assign(Value);
  2344.   InitHints;
  2345. end;
  2346.  
  2347. procedure TDBNavigator.Notification(AComponent: TComponent;
  2348.   Operation: TOperation);
  2349. begin
  2350.   inherited Notification(AComponent, Operation);
  2351.   if (Operation = opRemove) and (FDataLink <> nil) and
  2352.     (AComponent = DataSource) then DataSource := nil;
  2353. end;
  2354.  
  2355. procedure TDBNavigator.SetVisible(Value: TButtonSet);
  2356. var
  2357.   I: TNavigateBtn;
  2358.   W, H: Integer;
  2359. begin
  2360.   W := Width;
  2361.   H := Height;
  2362.   FVisibleButtons := Value;
  2363.   for I := Low(Buttons) to High(Buttons) do
  2364.     Buttons[I].Visible := I in FVisibleButtons;
  2365.   AdjustSize (W, H);
  2366.   if (W <> Width) or (H <> Height) then
  2367.     inherited SetBounds (Left, Top, W, H);
  2368.   Invalidate;
  2369. end;
  2370.  
  2371. procedure TDBNavigator.AdjustSize (var W: Integer; var H: Integer);
  2372. var
  2373.   Count: Integer;
  2374.   MinW: Integer;
  2375.   I: TNavigateBtn;
  2376.   LastBtn: TNavigateBtn;
  2377.   Space, Temp, Remain: Integer;
  2378.   X: Integer;
  2379. begin
  2380.   if (csLoading in ComponentState) then Exit;
  2381.   if Buttons[nbFirst] = nil then Exit;
  2382.  
  2383.   Count := 0;
  2384.   LastBtn := High(Buttons);
  2385.   for I := Low(Buttons) to High(Buttons) do
  2386.   begin
  2387.     if Buttons[I].Visible then
  2388.     begin
  2389.       Inc(Count);
  2390.       LastBtn := I;
  2391.     end;
  2392.   end;
  2393.   if Count = 0 then Inc(Count);
  2394.  
  2395.   MinW := Count * (MinBtnSize.X - 1) + 1;
  2396.   if W < MinW then
  2397.     W := MinW;
  2398.   if H < MinBtnSize.Y then
  2399.     H := MinBtnSize.Y;
  2400.  
  2401.   ButtonWidth := ((W - 1) div Count) + 1;
  2402.   Temp := Count * (ButtonWidth - 1) + 1;
  2403.   if Align = alNone then
  2404.     W := Temp;
  2405.  
  2406.   X := 0;
  2407.   Remain := W - Temp;
  2408.   Temp := Count div 2;
  2409.   for I := Low(Buttons) to High(Buttons) do
  2410.   begin
  2411.     if Buttons[I].Visible then
  2412.     begin
  2413.       Space := 0;
  2414.       if Remain <> 0 then
  2415.       begin
  2416.         Dec (Temp, Remain);
  2417.         if Temp < 0 then
  2418.         begin
  2419.           Inc (Temp, Count);
  2420.           Space := 1;
  2421.         end;
  2422.       end;
  2423.       Buttons[I].SetBounds (X, 0, ButtonWidth + Space, Height);
  2424.       Inc (X, ButtonWidth - 1 + Space);
  2425.       LastBtn := I;
  2426.     end
  2427.     else
  2428.       Buttons[I].SetBounds (Width + 1, 0, ButtonWidth, Height);
  2429.   end;
  2430. end;
  2431.  
  2432. procedure TDBNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  2433. var
  2434.   W, H: Integer;
  2435. begin
  2436.   W := AWidth;
  2437.   H := AHeight;
  2438.   AdjustSize (W, H);
  2439.   inherited SetBounds (ALeft, ATop, W, H);
  2440. end;
  2441.  
  2442. procedure TDBNavigator.WMSize(var Message: TWMSize);
  2443. var
  2444.   W, H: Integer;
  2445. begin
  2446.   inherited;
  2447.  
  2448.   { check for minimum size }
  2449.   W := Width;
  2450.   H := Height;
  2451.   AdjustSize (W, H);
  2452.   if (W <> Width) or (H <> Height) then
  2453.     inherited SetBounds(Left, Top, W, H);
  2454.   Message.Result := 0;
  2455. end;
  2456.  
  2457. procedure TDBNavigator.Click(Sender: TObject);
  2458. begin
  2459.   BtnClick (TNavButton (Sender).Index);
  2460. end;
  2461.  
  2462. procedure TDBNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton;
  2463.   Shift: TShiftState; X, Y: Integer);
  2464. var
  2465.   OldFocus: TNavigateBtn;
  2466.   Form: TForm;
  2467. begin
  2468.   OldFocus := FocusedButton;
  2469.   FocusedButton := TNavButton (Sender).Index;
  2470.   if TabStop and (GetFocus <> Handle) and CanFocus then
  2471.   begin
  2472.     SetFocus;
  2473.     if (GetFocus <> Handle) then
  2474.       Exit;
  2475.   end
  2476.   else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then
  2477.   begin
  2478.     Buttons[OldFocus].Invalidate;
  2479.     Buttons[FocusedButton].Invalidate;
  2480.   end;
  2481. end;
  2482.  
  2483. procedure TDBNavigator.BtnClick(Index: TNavigateBtn);
  2484. begin
  2485.   if (DataSource <> nil) and (DataSource.State <> dsInactive) then
  2486.   begin
  2487.     with DataSource.DataSet do
  2488.     begin
  2489.       case Index of
  2490.         nbPrior: Prior;
  2491.         nbNext: Next;
  2492.         nbFirst: First;
  2493.         nbLast: Last;
  2494.         nbInsert: Insert;
  2495.         nbEdit: Edit;
  2496.         nbCancel: Cancel;
  2497.         nbPost: Post;
  2498.         nbRefresh: Refresh;
  2499.         nbDelete:
  2500.           begin
  2501.             if not FConfirmDelete or
  2502.                 (MessageDlg (LoadStr(SDeleteRecordQuestion),
  2503.                 mtConfirmation, mbOKCancel, 0) <> idCancel) then
  2504.               Delete;
  2505.           end;
  2506.       end;
  2507.     end;
  2508.   end;
  2509.   if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then
  2510.     FOnNavClick(Self, Index);
  2511. end;
  2512.  
  2513. procedure TDBNavigator.WMSetFocus(var Message: TWMSetFocus);
  2514. begin
  2515.   Buttons[FocusedButton].Invalidate;
  2516. end;
  2517.  
  2518. procedure TDBNavigator.WMKillFocus(var Message: TWMKillFocus);
  2519. begin
  2520.   Buttons[FocusedButton].Invalidate;
  2521. end;
  2522.  
  2523. procedure TDBNavigator.KeyDown(var Key: Word; Shift: TShiftState);
  2524. var
  2525.   NewFocus: TNavigateBtn;
  2526.   OldFocus: TNavigateBtn;
  2527. begin
  2528.   OldFocus := FocusedButton;
  2529.   case Key of
  2530.     VK_RIGHT:
  2531.       begin
  2532.         NewFocus := FocusedButton;
  2533.         repeat
  2534.           if NewFocus < High(Buttons) then
  2535.             NewFocus := Succ(NewFocus);
  2536.         until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
  2537.         if NewFocus <> FocusedButton then
  2538.         begin
  2539.           FocusedButton := NewFocus;
  2540.           Buttons[OldFocus].Invalidate;
  2541.           Buttons[FocusedButton].Invalidate;
  2542.         end;
  2543.       end;
  2544.     VK_LEFT:
  2545.       begin
  2546.         NewFocus := FocusedButton;
  2547.         repeat
  2548.           if NewFocus > Low(Buttons) then
  2549.             NewFocus := Pred(NewFocus);
  2550.         until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
  2551.         if NewFocus <> FocusedButton then
  2552.         begin
  2553.           FocusedButton := NewFocus;
  2554.           Buttons[OldFocus].Invalidate;
  2555.           Buttons[FocusedButton].Invalidate;
  2556.         end;
  2557.       end;
  2558.     VK_SPACE:
  2559.       begin
  2560.         if Buttons[FocusedButton].Enabled then
  2561.           Buttons[FocusedButton].Click;
  2562.       end;
  2563.   end;
  2564. end;
  2565.  
  2566. procedure TDBNavigator.WMGetDlgCode(var Message: TWMGetDlgCode);
  2567. begin
  2568.   Message.Result := DLGC_WANTARROWS;
  2569. end;
  2570.  
  2571. procedure TDBNavigator.DataChanged;
  2572. var
  2573.   UpEnable, DnEnable: Boolean;
  2574. begin
  2575.   UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF;
  2576.   DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF;
  2577.   Buttons[nbFirst].Enabled := UpEnable;
  2578.   Buttons[nbPrior].Enabled := UpEnable;
  2579.   Buttons[nbNext].Enabled := DnEnable;
  2580.   Buttons[nbLast].Enabled := DnEnable;
  2581.   Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and 
  2582.     FDataLink.DataSet.CanModify and 
  2583.     not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF);
  2584. end;
  2585.  
  2586. procedure TDBNavigator.EditingChanged;
  2587. var
  2588.   CanModify: Boolean;
  2589. begin
  2590.   CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify;
  2591.   Buttons[nbInsert].Enabled := CanModify;
  2592.   Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing;
  2593.   Buttons[nbPost].Enabled := CanModify and FDataLink.Editing;
  2594.   Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing;
  2595.   Buttons[nbRefresh].Enabled := not (FDataLink.DataSet is TQuery);
  2596. end;
  2597.  
  2598. procedure TDBNavigator.ActiveChanged;
  2599. var
  2600.   I: TNavigateBtn;
  2601. begin
  2602.   if not (Enabled and FDataLink.Active) then
  2603.     for I := Low(Buttons) to High(Buttons) do
  2604.       Buttons[I].Enabled := False
  2605.   else
  2606.   begin
  2607.     DataChanged;
  2608.     EditingChanged;
  2609.   end;
  2610. end;
  2611.  
  2612. procedure TDBNavigator.CMEnabledChanged(var Message: TMessage);
  2613. begin
  2614.   inherited;
  2615.   if not (csLoading in ComponentState) then
  2616.     ActiveChanged;
  2617. end;
  2618.  
  2619. procedure TDBNavigator.SetDataSource(Value: TDataSource);
  2620. begin
  2621.   FDataLink.DataSource := Value;
  2622.   if not (csLoading in ComponentState) then
  2623.     ActiveChanged;
  2624. end;
  2625.  
  2626. function TDBNavigator.GetDataSource: TDataSource;
  2627. begin
  2628.   Result := FDataLink.DataSource;
  2629. end;
  2630.  
  2631. procedure TDBNavigator.Loaded;
  2632. var
  2633.   W, H: Integer;
  2634. begin
  2635.   inherited Loaded;
  2636.   W := Width;
  2637.   H := Height;
  2638.   AdjustSize (W, H);
  2639.   if (W <> Width) or (H <> Height) then
  2640.     inherited SetBounds (Left, Top, W, H);
  2641.   InitHints;
  2642.   ActiveChanged;
  2643. end;
  2644.  
  2645. {TNavButton}
  2646.  
  2647. destructor TNavButton.Destroy;
  2648. begin
  2649.   if FRepeatTimer <> nil then
  2650.     FRepeatTimer.Free;
  2651.   inherited Destroy;
  2652. end;
  2653.  
  2654. procedure TNavButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2655.   X, Y: Integer);
  2656. begin
  2657.   inherited MouseDown (Button, Shift, X, Y);
  2658.   if nsAllowTimer in FNavStyle then
  2659.   begin
  2660.     if FRepeatTimer = nil then
  2661.       FRepeatTimer := TTimer.Create(Self);
  2662.  
  2663.     FRepeatTimer.OnTimer := TimerExpired;
  2664.     FRepeatTimer.Interval := InitRepeatPause;
  2665.     FRepeatTimer.Enabled  := True;
  2666.   end;
  2667. end;
  2668.  
  2669. procedure TNavButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2670.                                   X, Y: Integer);
  2671. begin
  2672.   inherited MouseUp (Button, Shift, X, Y);
  2673.   if FRepeatTimer <> nil then
  2674.     FRepeatTimer.Enabled  := False;
  2675. end;
  2676.  
  2677. procedure TNavButton.TimerExpired(Sender: TObject);
  2678. begin
  2679.   FRepeatTimer.Interval := RepeatPause;
  2680.   if (FState = bsDown) and MouseCapture then
  2681.   begin
  2682.     try
  2683.       Click;
  2684.     except
  2685.       FRepeatTimer.Enabled := False;
  2686.       raise;
  2687.     end;
  2688.   end;
  2689. end;
  2690.  
  2691. procedure TNavButton.Paint;
  2692. var
  2693.   R: TRect;
  2694. begin
  2695.   inherited Paint;
  2696.   if (GetFocus = Parent.Handle) and
  2697.      (FIndex = TDBNavigator (Parent).FocusedButton) then
  2698.   begin
  2699.     R := Bounds(0, 0, Width, Height);
  2700.     InflateRect(R, -3, -3);
  2701.     if FState = bsDown then
  2702.       OffsetRect(R, 1, 1);
  2703.     DrawFocusRect(Canvas.Handle, R);
  2704.   end;
  2705. end;
  2706.  
  2707. { TNavDataLink }
  2708.  
  2709. constructor TNavDataLink.Create(ANav: TDBNavigator);
  2710. begin
  2711.   inherited Create;
  2712.   FNavigator := ANav;
  2713. end;
  2714.  
  2715. destructor TNavDataLink.Destroy;
  2716. begin
  2717.   FNavigator := nil;
  2718.   inherited Destroy;
  2719. end;
  2720.  
  2721. procedure TNavDataLink.EditingChanged;
  2722. begin
  2723.   if FNavigator <> nil then FNavigator.EditingChanged;
  2724. end;
  2725.  
  2726. procedure TNavDataLink.DataSetChanged;
  2727. begin
  2728.   if FNavigator <> nil then FNavigator.DataChanged;
  2729. end;
  2730.  
  2731. procedure TNavDataLink.ActiveChanged;
  2732. begin
  2733.   if FNavigator <> nil then FNavigator.ActiveChanged;
  2734. end;
  2735.  
  2736. end.
  2737.