home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / dbctrls.zip / DBCTRLS.PAS next >
Pascal/Delphi Source File  |  1995-07-16  |  72KB  |  2,835 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.  
  762. begin
  763.   inherited KeyDown(Key, Shift);
  764.   if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  765.     FDataLink.Edit;
  766. end;
  767.  
  768. procedure TDBEdit.KeyPress(var Key: Char);
  769.  
  770. var
  771.  
  772. MyForm : TForm;
  773.  
  774. begin
  775.  
  776.    if Key = #13 then
  777.    begin
  778.        MYForm := GetParentForm( Self );
  779.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  780.        Key := #0;
  781.    end;
  782.  
  783.    if Key <> #0 then inherited KeyPress(Key);
  784.  
  785.    if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  786.     not FDataLink.Field.IsValidChar(Key) then
  787.   begin
  788.     MessageBeep(0);
  789.     Key := #0;
  790.   end;
  791.   case Key of
  792.     ^H, ^V, ^X, #32..#255:
  793.       FDataLink.Edit;
  794.     #27:
  795.       begin
  796.         FDataLink.Reset;
  797.         SelectAll;
  798.         Key := #0;
  799.       end;
  800.   end;
  801. end;
  802.  
  803. function TDBEdit.EditCanModify: Boolean;
  804. begin
  805.   Result := FDataLink.Edit;
  806. end;
  807.  
  808. procedure TDBEdit.Reset;
  809. begin
  810.   FDataLink.Reset;
  811.   SelectAll;
  812. end;
  813.  
  814. procedure TDBEdit.SetFocused(Value: Boolean);
  815. begin
  816.   if FFocused <> Value then
  817.   begin
  818.     FFocused := Value;
  819.     if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
  820.     FDataLink.Reset;
  821.   end;
  822. end;
  823.  
  824. procedure TDBEdit.Change;
  825. begin
  826.   FDataLink.Modified;
  827.   inherited Change;
  828. end;
  829.  
  830. function TDBEdit.GetDataSource: TDataSource;
  831. begin
  832.   Result := FDataLink.DataSource;
  833. end;
  834.  
  835. procedure TDBEdit.SetDataSource(Value: TDataSource);
  836. begin
  837.   FDataLink.DataSource := Value;
  838. end;
  839.  
  840. function TDBEdit.GetDataField: string;
  841. begin
  842.   Result := FDataLink.FieldName;
  843. end;
  844.  
  845. procedure TDBEdit.SetDataField(const Value: string);
  846. begin
  847.   FDataLink.FieldName := Value;
  848. end;
  849.  
  850. function TDBEdit.GetReadOnly: Boolean;
  851. begin
  852.   Result := FDataLink.ReadOnly;
  853. end;
  854.  
  855. procedure TDBEdit.SetReadOnly(Value: Boolean);
  856. begin
  857.   FDataLink.ReadOnly := Value;
  858. end;
  859.  
  860. function TDBEdit.GetField: TField;
  861. begin
  862.   Result := FDataLink.Field;
  863. end;
  864.  
  865. procedure TDBEdit.DataChange(Sender: TObject);
  866. begin
  867.   if FDataLink.Field <> nil then
  868.   begin
  869.     if FAlignment <> FDataLink.Field.Alignment then
  870.     begin
  871.       EditText := '';  {forces update}
  872.       FAlignment := FDataLink.Field.Alignment;
  873.     end;
  874.     EditMask := FDataLink.Field.EditMask;
  875.     if FDataLink.Field.DataType = ftString then
  876.       MaxLength := FDataLink.Field.Size else
  877.       MaxLength := 0;
  878.     if FFocused and FDataLink.CanModify then
  879.       Text := FDataLink.Field.Text
  880.     else
  881.       EditText := FDataLink.Field.DisplayText;
  882.   end else
  883.   begin
  884.     FAlignment := taLeftJustify;
  885.     EditMask := '';
  886.     MaxLength := 0;
  887.     if csDesigning in ComponentState then
  888.       EditText := Name else
  889.       EditText := '';
  890.   end;
  891. end;
  892.  
  893. procedure TDBEdit.EditingChange(Sender: TObject);
  894. begin
  895.   inherited ReadOnly := not FDataLink.Editing;
  896. end;
  897.  
  898. procedure TDBEdit.UpdateData(Sender: TObject);
  899. begin
  900.   ValidateEdit;
  901.   FDataLink.Field.Text := Text;
  902. end;
  903.  
  904. procedure TDBEdit.WMPaste(var Message: TMessage);
  905. begin
  906.   FDataLink.Edit;
  907.   inherited;
  908. end;
  909.  
  910. procedure TDBEdit.WMCut(var Message: TMessage);
  911. begin
  912.   FDataLink.Edit;
  913.   inherited;
  914. end;
  915.  
  916. procedure TDBEdit.CMEnter(var Message: TCMEnter);
  917. begin
  918.   SetFocused(True);
  919.   inherited;
  920. end;
  921.  
  922. procedure TDBEdit.CMExit(var Message: TCMExit);
  923. begin
  924.   try
  925.     FDataLink.UpdateRecord;
  926.   except
  927.     SelectAll;
  928.     SetFocus;
  929.     raise;
  930.   end;
  931.   SetFocused(False);
  932.   SetCursor(0);
  933.   DoExit;
  934. end;
  935.  
  936. procedure TDBEdit.WMPaint(var Message: TWMPaint);
  937. var
  938.   Width, Indent, Left, I: Integer;
  939.   R: TRect;
  940.   DC: HDC;
  941.   PS: TPaintStruct;
  942.   S: string;
  943. begin
  944.   if (FAlignment = taLeftJustify) or FFocused then
  945.   begin
  946.     inherited;
  947.     Exit;
  948.   end;
  949. { Since edit controls do not handle justification unless multi-line (and
  950.   then only poorly) we will draw right and center justify manually unless
  951.   the edit has the focus. }
  952.   if FCanvas = nil then
  953.   begin
  954.     FCanvas := TControlCanvas.Create;
  955.     FCanvas.Control := Self;
  956.   end;
  957.   DC := Message.DC;
  958.   if DC = 0 then DC := BeginPaint(Handle, PS);
  959.   FCanvas.Handle := DC;
  960.   try
  961.     FCanvas.Font := Font;
  962.     with FCanvas do
  963.     begin
  964.       R := ClientRect;
  965.       if (BorderStyle = bsSingle) then
  966.       begin
  967.         Brush.Color := clWindowFrame;
  968.         FrameRect(R);
  969.         InflateRect(R, -1, -1);
  970.       end;
  971.       Brush.Color := Color;
  972.       S := EditText;
  973.       if PasswordChar <> #0 then
  974.       begin
  975.         for I := 1 to Length(S) do
  976.           S[I] := PasswordChar;
  977.       end;
  978.       Width := TextWidth(S);
  979.       if BorderStyle = bsNone then Indent := 0 else Indent := FTextMargin;
  980.       if FAlignment = taRightJustify then
  981.         Left := R.Right - Width - Indent else
  982.         Left := (R.Left + R.Right - Width) div 2;
  983.       TextRect(R, Left, Indent, S);
  984.     end;
  985.   finally
  986.     FCanvas.Handle := 0;
  987.     if Message.DC = 0 then EndPaint(Handle, PS);
  988.   end;
  989. end;
  990.  
  991. procedure TDBEdit.CMFontChanged(var Message: TMessage);
  992. begin
  993.   inherited;
  994.   CalcTextMargin;
  995. end;
  996.  
  997. procedure TDBEdit.CalcTextMargin;
  998. var
  999.   DC: HDC;
  1000.   SaveFont: HFont;
  1001.   I: Integer;
  1002.   SysMetrics, Metrics: TTextMetric;
  1003. begin
  1004.   DC := GetDC(0);
  1005.   GetTextMetrics(DC, SysMetrics);
  1006.   SaveFont := SelectObject(DC, Font.Handle);
  1007.   GetTextMetrics(DC, Metrics);
  1008.   SelectObject(DC, SaveFont);
  1009.   ReleaseDC(0, DC);
  1010.   I := SysMetrics.tmHeight;
  1011.   if I > Metrics.tmHeight then I := Metrics.tmHeight;
  1012.   FTextMargin := I div 4;
  1013. end;
  1014.  
  1015. { TDBText }
  1016.  
  1017. constructor TDBText.Create(AOwner: TComponent);
  1018. begin
  1019.   inherited Create(AOwner);
  1020.   AutoSize := False;
  1021.   ShowAccelChar := False;
  1022.   FDataLink := TFieldDataLink.Create;
  1023.   FDataLink.OnDataChange := DataChange;
  1024. end;
  1025.  
  1026. destructor TDBText.Destroy;
  1027. begin
  1028.   FDataLink.Free;
  1029.   FDataLink := nil;
  1030.   inherited Destroy;
  1031. end;
  1032.  
  1033. procedure TDBText.Notification(AComponent: TComponent;
  1034.   Operation: TOperation);
  1035. begin
  1036.   inherited Notification(AComponent, Operation);
  1037.   if (Operation = opRemove) and (FDataLink <> nil) and
  1038.     (AComponent = DataSource) then DataSource := nil;
  1039. end;
  1040.  
  1041. function TDBText.GetDataSource: TDataSource;
  1042. begin
  1043.   Result := FDataLink.DataSource;
  1044. end;
  1045.  
  1046. procedure TDBText.SetDataSource(Value: TDataSource);
  1047. begin
  1048.   FDataLink.DataSource := Value;
  1049. end;
  1050.  
  1051. function TDBText.GetDataField: string;
  1052. begin
  1053.   Result := FDataLink.FieldName;
  1054. end;
  1055.  
  1056. procedure TDBText.SetDataField(const Value: string);
  1057. begin
  1058.   FDataLink.FieldName := Value;
  1059. end;
  1060.  
  1061. function TDBText.GetField: TField;
  1062. begin
  1063.   Result := FDataLink.Field;
  1064. end;
  1065.  
  1066. procedure TDBText.DataChange(Sender: TObject);
  1067. begin
  1068.   if FDataLink.Field <> nil then
  1069.     Caption := FDataLink.Field.DisplayText
  1070.   else
  1071.     if csDesigning in ComponentState then Caption := Name else Caption := '';
  1072. end;
  1073.  
  1074. { TDBCheckBox }
  1075.  
  1076. constructor TDBCheckBox.Create(AOwner: TComponent);
  1077. begin
  1078.   inherited Create(AOwner);
  1079.   State := cbUnchecked;
  1080.   FValueCheck := NewStr(LoadStr(STextTrue));
  1081.   FValueUncheck := NewStr(LoadStr(STextFalse));
  1082.   FDataLink := TFieldDataLink.Create;
  1083.   FDataLink.Control := Self;
  1084.   FDataLink.OnDataChange := DataChange;
  1085.   FDataLink.OnUpdateData := UpdateData;
  1086. end;
  1087.  
  1088. destructor TDBCheckBox.Destroy;
  1089. begin
  1090.   FDataLink.Free;
  1091.   FDataLink := nil;
  1092.   DisposeStr(FValueUncheck);
  1093.   DisposeStr(FValueCheck);
  1094.   inherited Destroy;
  1095. end;
  1096.  
  1097. procedure TDBCheckBox.Notification(AComponent: TComponent;
  1098.   Operation: TOperation);
  1099. begin
  1100.   inherited Notification(AComponent, Operation);
  1101.   if (Operation = opRemove) and (FDataLink <> nil) and
  1102.     (AComponent = DataSource) then DataSource := nil;
  1103. end;
  1104.  
  1105. procedure TDBCheckBox.DataChange(Sender: TObject);
  1106. var
  1107.   NewState: TCheckBoxState;
  1108.   Text: string;
  1109. begin
  1110.   NewState := cbGrayed;
  1111.   if (FDataLink.Field <> nil) and not FDataLink.Field.IsNull then
  1112.     if FDataLink.Field.DataType = ftBoolean then
  1113.       if FDataLink.Field.AsBoolean then
  1114.         NewState := cbChecked
  1115.       else
  1116.         NewState := cbUnchecked
  1117.     else
  1118.     begin
  1119.       Text := FDataLink.Field.Text;
  1120.       if ValueMatch(FValueCheck^, Text) then NewState := cbChecked else
  1121.         if ValueMatch(FValueUncheck^, Text) then NewState := cbUnchecked;
  1122.    end;
  1123.   State := NewState;
  1124. end;
  1125.  
  1126. procedure TDBCheckBox.UpdateData(Sender: TObject);
  1127. var
  1128.   Pos: Integer;
  1129.   S: PString;
  1130. begin
  1131.   if State = cbGrayed then
  1132.     FDataLink.Field.Clear
  1133.   else
  1134.     if FDataLink.Field.DataType = ftBoolean then
  1135.       FDataLink.Field.AsBoolean := Checked
  1136.     else
  1137.     begin
  1138.       if Checked then S := FValueCheck else S := FValueUncheck;
  1139.       Pos := 1;
  1140.       FDataLink.Field.Text := ExtractFieldName(S^, Pos);
  1141.     end;
  1142. end;
  1143.  
  1144. function TDBCheckBox.ValueMatch(const ValueList, Value: string): Boolean;
  1145. var
  1146.   Pos: Integer;
  1147. begin
  1148.   Result := False;
  1149.   Pos := 1;
  1150.   while Pos <= Length(ValueList) do
  1151.     if AnsiCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
  1152.     begin
  1153.       Result := True;
  1154.       Break;
  1155.     end;
  1156. end;
  1157.  
  1158. procedure TDBCheckBox.Toggle;
  1159. begin
  1160.   if FDataLink.Edit then
  1161.   begin
  1162.     inherited Toggle;
  1163.     FDataLink.Modified;
  1164.   end;
  1165. end;
  1166.  
  1167. function TDBCheckBox.GetDataSource: TDataSource;
  1168. begin
  1169.   Result := FDataLink.DataSource;
  1170. end;
  1171.  
  1172. procedure TDBCheckBox.SetDataSource(Value: TDataSource);
  1173. begin
  1174.   FDataLink.DataSource := Value;
  1175. end;
  1176.  
  1177. function TDBCheckBox.GetDataField: string;
  1178. begin
  1179.   Result := FDataLink.FieldName;
  1180. end;
  1181.  
  1182. procedure TDBCheckBox.SetDataField(const Value: string);
  1183. begin
  1184.   FDataLink.FieldName := Value;
  1185. end;
  1186.  
  1187. function TDBCheckBox.GetReadOnly: Boolean;
  1188. begin
  1189.   Result := FDataLink.ReadOnly;
  1190. end;
  1191.  
  1192. procedure TDBCheckBox.SetReadOnly(Value: Boolean);
  1193. begin
  1194.   FDataLink.ReadOnly := Value;
  1195. end;
  1196.  
  1197. function TDBCheckBox.GetField: TField;
  1198. begin
  1199.   Result := FDataLink.Field;
  1200. end;
  1201.  
  1202. procedure TDBCheckBox.KeyPress(var Key: Char);
  1203.  
  1204. var
  1205.  
  1206. MyForm : TForm;
  1207.  
  1208. begin
  1209.  
  1210.    if Key = #13 then
  1211.    begin
  1212.        MYForm := GetParentForm( Self );
  1213.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  1214.        Key := #0;
  1215.    end;
  1216.  
  1217.    if Key <> #0 then inherited KeyPress(Key);
  1218.  
  1219.   case Key of
  1220.     #8, ' ':
  1221.       FDataLink.Edit;
  1222.     #27:
  1223.       FDataLink.Reset;
  1224.   end;
  1225. end;
  1226.  
  1227. function TDBCheckBox.GetValueCheck: string;
  1228. begin
  1229.   Result := FValueCheck^;
  1230. end;
  1231.  
  1232. function TDBCheckBox.GetValueUncheck: string;
  1233. begin
  1234.   Result := FValueUncheck^;
  1235. end;
  1236.  
  1237. procedure TDBCheckBox.SetValueCheck(const Value: string);
  1238. begin
  1239.   AssignStr(FValueCheck, Value);
  1240.   DataChange(Self);
  1241. end;
  1242.  
  1243. procedure TDBCheckBox.SetValueUncheck(const Value: string);
  1244. begin
  1245.   AssignStr(FValueUncheck, Value);
  1246.   DataChange(Self);
  1247. end;
  1248.  
  1249. procedure TDBCheckBox.CMExit(var Message: TCMExit);
  1250. begin
  1251.   try
  1252.     FDataLink.UpdateRecord;
  1253.   except
  1254.     SetFocus;
  1255.     raise;
  1256.   end;
  1257.   inherited;
  1258. end;
  1259.  
  1260. { TDBComboBox }
  1261.  
  1262. constructor TDBComboBox.Create(AOwner: TComponent);
  1263. begin
  1264.   inherited Create(AOwner);
  1265.   FDataLink := TFieldDataLink.Create;
  1266.   FDataLink.Control := Self;
  1267.   FDataLink.OnDataChange := DataChange;
  1268.   FDataLink.OnUpdateData := UpdateData;
  1269.   FDataLink.OnEditingChange := EditingChange;
  1270. end;
  1271.  
  1272. destructor TDBComboBox.Destroy;
  1273. begin
  1274.   FDataLink.Free;
  1275.   FDataLink := nil;
  1276.   inherited Destroy;
  1277. end;
  1278.  
  1279. procedure TDBComboBox.Notification(AComponent: TComponent;
  1280.   Operation: TOperation);
  1281. begin
  1282.   inherited Notification(AComponent, Operation);
  1283.   if (Operation = opRemove) and (FDataLink <> nil) and
  1284.     (AComponent = DataSource) then DataSource := nil;
  1285. end;
  1286.  
  1287. procedure TDBComboBox.CreateWnd;
  1288. begin
  1289.   inherited CreateWnd;
  1290.   SetEditReadOnly;
  1291. end;
  1292.  
  1293. procedure TDBComboBox.DataChange(Sender: TObject);
  1294. begin
  1295.   if FDataLink.Field <> nil then
  1296.     SetComboText(FDataLink.Field.Text)
  1297.   else
  1298.     if csDesigning in ComponentState then
  1299.       SetComboText(Name)
  1300.     else
  1301.       SetComboText('');
  1302. end;
  1303.  
  1304. procedure TDBComboBox.UpdateData(Sender: TObject);
  1305. begin
  1306.   FDataLink.Field.Text := GetComboText;
  1307. end;
  1308.  
  1309. procedure TDBComboBox.SetComboText(const Value: string);
  1310. var
  1311.   I: Integer;
  1312. begin
  1313.   if Value <> GetComboText then
  1314.   begin
  1315.     if Style <> csDropDown then
  1316.     begin
  1317.       if Value = '' then I := -1 else I := Items.IndexOf(Value);
  1318.       ItemIndex := I;
  1319.       if I >= 0 then Exit;
  1320.     end;
  1321.     if Style in [csDropDown, csSimple] then Text := Value;
  1322.   end;
  1323. end;
  1324.  
  1325. function TDBComboBox.GetComboText: string;
  1326. var
  1327.   I: Integer;
  1328. begin
  1329.   if Style in [csDropDown, csSimple] then Result := Text else
  1330.   begin
  1331.     I := ItemIndex;
  1332.     if ItemIndex < 0 then Result := '' else Result := Items[I];
  1333.   end;
  1334. end;
  1335.  
  1336. procedure TDBComboBox.Change;
  1337. begin
  1338.   FDataLink.Edit;
  1339.   inherited Change;
  1340.   FDataLink.Modified;
  1341. end;
  1342.  
  1343. procedure TDBComboBox.Click;
  1344. begin
  1345.   FDataLink.Edit;
  1346.   inherited Click;
  1347.   FDataLink.Modified;
  1348. end;
  1349.  
  1350. procedure TDBComboBox.DropDown;
  1351. begin
  1352.   FDataLink.Edit;
  1353.   inherited DropDown;
  1354. end;
  1355.  
  1356. function TDBComboBox.GetDataSource: TDataSource;
  1357. begin
  1358.   Result := FDataLink.DataSource;
  1359. end;
  1360.  
  1361. procedure TDBComboBox.SetDataSource(Value: TDataSource);
  1362. begin
  1363.   FDataLink.DataSource := Value;
  1364. end;
  1365.  
  1366. function TDBComboBox.GetDataField: string;
  1367. begin
  1368.   Result := FDataLink.FieldName;
  1369. end;
  1370.  
  1371. procedure TDBComboBox.SetDataField(const Value: string);
  1372. begin
  1373.   FDataLink.FieldName := Value;
  1374. end;
  1375.  
  1376. function TDBComboBox.GetReadOnly: Boolean;
  1377. begin
  1378.   Result := FDataLink.ReadOnly;
  1379. end;
  1380.  
  1381. procedure TDBComboBox.SetReadOnly(Value: Boolean);
  1382. begin
  1383.   FDataLink.ReadOnly := Value;
  1384. end;
  1385.  
  1386. function TDBComboBox.GetField: TField;
  1387. begin
  1388.   Result := FDataLink.Field;
  1389. end;
  1390.  
  1391. procedure TDBComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  1392. begin
  1393.   inherited KeyDown(Key, Shift);
  1394.   if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN, 32..255] then
  1395.   begin
  1396.     if not FDataLink.Edit and (Key in [VK_UP, VK_DOWN]) then
  1397.       Key := 0;
  1398.   end;
  1399. end;
  1400.  
  1401. procedure TDBComboBox.KeyPress(var Key: Char);
  1402.  
  1403. var
  1404.  
  1405. MyForm : TForm;
  1406.  
  1407. begin
  1408.  
  1409.    if Key = #13 then
  1410.    begin
  1411.        MYForm := GetParentForm( Self );
  1412.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  1413.        Key := #0;
  1414.    end;
  1415.  
  1416.    if Key <> #0 then inherited KeyPress(Key);
  1417.  
  1418.   if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  1419.     not FDataLink.Field.IsValidChar(Key) then
  1420.   begin
  1421.     MessageBeep(0);
  1422.     Key := #0;
  1423.   end;
  1424.   case Key of
  1425.     ^H, ^V, ^X, #32..#255:
  1426.       FDataLink.Edit;
  1427.     #27:
  1428.       begin
  1429.         FDataLink.Reset;
  1430.         SelectAll;
  1431.         Key := #0;
  1432.       end;
  1433.   end;
  1434. end;
  1435.  
  1436. procedure TDBComboBox.EditingChange(Sender: TObject);
  1437. begin
  1438.   SetEditReadOnly;
  1439. end;
  1440.  
  1441. procedure TDBComboBox.SetEditReadOnly;
  1442. begin
  1443.   if (Style in [csDropDown, csSimple]) and HandleAllocated then
  1444.     SendMessage(FEditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
  1445. end;
  1446.  
  1447. procedure TDBComboBox.WndProc(var Message: TMessage);
  1448. begin
  1449.   if not (csDesigning in ComponentState) then
  1450.     case Message.Msg of
  1451.       WM_COMMAND:
  1452.         if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
  1453.           if not FDataLink.Edit then
  1454.           begin
  1455.             if Style <> csSimple then
  1456.               PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  1457.             Exit;
  1458.           end;
  1459.       CB_SHOWDROPDOWN:
  1460.         if Message.WParam <> 0 then FDataLink.Edit else
  1461.           if not FDataLink.Editing then DataChange(Self); {Restore text}
  1462.     end;
  1463.   inherited WndProc (Message);
  1464. end;
  1465.  
  1466. procedure TDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  1467.   ComboProc: Pointer);
  1468. begin
  1469.   if not (csDesigning in ComponentState) then
  1470.     case Message.Msg of
  1471.       WM_LBUTTONDOWN:
  1472.         if (Style = csSimple) and (ComboWnd <> FEditHandle) then
  1473.           if not FDataLink.Edit then Exit;
  1474.     end;
  1475.   inherited ComboWndProc (Message, ComboWnd, ComboProc);
  1476. end;
  1477.  
  1478. procedure TDBComboBox.CMExit(var Message: TCMExit);
  1479. begin
  1480.   try
  1481.     FDataLink.UpdateRecord;
  1482.   except
  1483.     SelectAll;
  1484.     SetFocus;
  1485.     raise;
  1486.   end;
  1487.   inherited;
  1488. end;
  1489.  
  1490. procedure TDBComboBox.SetItems(Value: TStrings);
  1491. begin
  1492.   Items.Assign(Value);
  1493.   DataChange(Self);
  1494. end;
  1495.  
  1496. { TDBListBox }
  1497.  
  1498. constructor TDBListBox.Create(AOwner: TComponent);
  1499. begin
  1500.   inherited Create(AOwner);
  1501.   FDataLink := TFieldDataLink.Create;
  1502.   FDataLink.Control := Self;
  1503.   FDataLink.OnDataChange := DataChange;
  1504.   FDataLink.OnUpdateData := UpdateData;
  1505. end;
  1506.  
  1507. destructor TDBListBox.Destroy;
  1508. begin
  1509.   FDataLink.Free;
  1510.   FDataLink := nil;
  1511.   inherited Destroy;
  1512. end;
  1513.  
  1514. procedure TDBListBox.Notification(AComponent: TComponent;
  1515.   Operation: TOperation);
  1516. begin
  1517.   inherited Notification(AComponent, Operation);
  1518.   if (Operation = opRemove) and (FDataLink <> nil) and
  1519.     (AComponent = DataSource) then DataSource := nil;
  1520. end;
  1521.  
  1522. procedure TDBListBox.DataChange(Sender: TObject);
  1523. begin
  1524.   if FDataLink.Field <> nil then
  1525.     ItemIndex := Items.IndexOf(FDataLink.Field.Text) else
  1526.     ItemIndex := -1;
  1527. end;
  1528.  
  1529. procedure TDBListBox.UpdateData(Sender: TObject);
  1530. begin
  1531.   if ItemIndex >= 0 then
  1532.     FDataLink.Field.Text := Items[ItemIndex] else
  1533.     FDataLink.Field.Text := '';
  1534. end;
  1535.  
  1536. procedure TDBListBox.Click;
  1537. begin
  1538.   if FDataLink.Edit then
  1539.   begin
  1540.     inherited Click;
  1541.     FDataLink.Modified;
  1542.   end;
  1543. end;
  1544.  
  1545. function TDBListBox.GetDataSource: TDataSource;
  1546. begin
  1547.   Result := FDataLink.DataSource;
  1548. end;
  1549.  
  1550. procedure TDBListBox.SetDataSource(Value: TDataSource);
  1551. begin
  1552.   FDataLink.DataSource := Value;
  1553. end;
  1554.  
  1555. function TDBListBox.GetDataField: string;
  1556. begin
  1557.   Result := FDataLink.FieldName;
  1558. end;
  1559.  
  1560. procedure TDBListBox.SetDataField(const Value: string);
  1561. begin
  1562.   FDataLink.FieldName := Value;
  1563. end;
  1564.  
  1565. function TDBListBox.GetReadOnly: Boolean;
  1566. begin
  1567.   Result := FDataLink.ReadOnly;
  1568. end;
  1569.  
  1570. procedure TDBListBox.SetReadOnly(Value: Boolean);
  1571. begin
  1572.   FDataLink.ReadOnly := Value;
  1573. end;
  1574.  
  1575. function TDBListBox.GetField: TField;
  1576. begin
  1577.   Result := FDataLink.Field;
  1578. end;
  1579.  
  1580. procedure TDBListBox.KeyDown(var Key: Word; Shift: TShiftState);
  1581. begin
  1582.   inherited KeyDown(Key, Shift);
  1583.   if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP,
  1584.     VK_RIGHT, VK_DOWN] then
  1585.     if not FDataLink.Edit then Key := 0;
  1586. end;
  1587.  
  1588. procedure TDBListBox.KeyPress(var Key: Char);
  1589.  
  1590. var
  1591.  
  1592. MyForm : TForm;
  1593.  
  1594. begin
  1595.  
  1596.    if Key = #13 then
  1597.    begin
  1598.        MYForm := GetParentForm( Self );
  1599.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  1600.        Key := #0;
  1601.    end;
  1602.  
  1603.    if Key <> #0 then inherited KeyPress(Key);
  1604.   case Key of
  1605.     #32..#255:
  1606.       if not FDataLink.Edit then Key := #0;
  1607.     #27:
  1608.       FDataLink.Reset;
  1609.   end;
  1610. end;
  1611.  
  1612. procedure TDBListBox.WMLButtonDown(var Message: TWMLButtonDown);
  1613. begin
  1614.   if FDataLink.Edit then inherited
  1615.   else
  1616.   begin
  1617.     SetFocus;
  1618.     with Message do
  1619.       MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  1620.   end;
  1621. end;
  1622.  
  1623. procedure TDBListBox.CMExit(var Message: TCMExit);
  1624. begin
  1625.   try
  1626.     FDataLink.UpdateRecord;
  1627.   except
  1628.     SetFocus;
  1629.     raise;
  1630.   end;
  1631.   inherited;
  1632. end;
  1633.  
  1634. procedure TDBListBox.SetItems(Value: TStrings);
  1635. begin
  1636.   Items.Assign(Value);
  1637.   DataChange(Self);
  1638. end;
  1639.  
  1640. { TDBRadioGroup }
  1641.  
  1642. constructor TDBRadioGroup.Create(AOwner: TComponent);
  1643. var
  1644.   CStyle : TControlStyle;
  1645. begin
  1646.   inherited Create(AOwner);
  1647.   FDataLink := TFieldDataLink.Create;
  1648.   FDataLink.Control := Self;
  1649.   FDataLink.OnDataChange := DataChange;
  1650.   FDataLink.OnUpdateData := UpdateData;
  1651.   FValue := NullStr;
  1652.   FValues := TStringList.Create;
  1653. end;
  1654.  
  1655. destructor TDBRadioGroup.Destroy;
  1656. begin
  1657.   FDataLink.Free;
  1658.   FDataLink := nil;
  1659.   DisposeStr (FValue);
  1660.   FValues.Free;
  1661.   inherited Destroy;
  1662. end;
  1663.  
  1664. procedure TDBRadioGroup.Notification(AComponent: TComponent;
  1665.   Operation: TOperation);
  1666. begin
  1667.   inherited Notification(AComponent, Operation);
  1668.   if (Operation = opRemove) and (FDataLink <> nil) and
  1669.     (AComponent = DataSource) then DataSource := nil;
  1670. end;
  1671.  
  1672. procedure TDBRadioGroup.DataChange(Sender: TObject);
  1673. begin
  1674.   if FDataLink.Field <> nil then
  1675.     Value := FDataLink.Field.Text
  1676.   else
  1677.     Value := EmptyStr;
  1678. end;
  1679.  
  1680. procedure TDBRadioGroup.UpdateData(Sender: TObject);
  1681. begin
  1682.   if FDataLink.Field <> nil then
  1683.     FDataLink.Field.Text := Value;
  1684. end;
  1685.  
  1686. function TDBRadioGroup.GetDataSource: TDataSource;
  1687. begin
  1688.   Result := FDataLink.DataSource;
  1689. end;
  1690.  
  1691. procedure TDBRadioGroup.SetDataSource(Value: TDataSource);
  1692. begin
  1693.   FDataLink.DataSource := Value;
  1694. end;
  1695.  
  1696. function TDBRadioGroup.GetDataField: string;
  1697. begin
  1698.   Result := FDataLink.FieldName;
  1699. end;
  1700.  
  1701. procedure TDBRadioGroup.SetDataField(const Value: string);
  1702. begin
  1703.   FDataLink.FieldName := Value;
  1704. end;
  1705.  
  1706. function TDBRadioGroup.GetReadOnly: Boolean;
  1707. begin
  1708.   Result := FDataLink.ReadOnly;
  1709. end;
  1710.  
  1711. procedure TDBRadioGroup.SetReadOnly(Value: Boolean);
  1712. begin
  1713.   FDataLink.ReadOnly := Value;
  1714. end;
  1715.  
  1716. function TDBRadioGroup.GetField: TField;
  1717. begin
  1718.   Result := FDataLink.Field;
  1719. end;
  1720.  
  1721. function TDBRadioGroup.GetValue : string;
  1722. begin
  1723.   Result := FValue^;
  1724. end;
  1725.  
  1726. function TDBRadioGroup.GetButtonValue(Index: Integer): string;
  1727. begin
  1728.   if (Index < FValues.Count) and (FValues[Index] <> '') then
  1729.     Result := FValues[Index]
  1730.   else if (Index < Items.Count) then
  1731.     Result := Items[Index]
  1732.   else
  1733.     Result := '';
  1734. end;
  1735.  
  1736. procedure TDBRadioGroup.SetValue (const Value: string);
  1737. var
  1738.   I : Integer;
  1739. begin
  1740.   AssignStr(FValue, Value);
  1741.   if (ItemIndex < 0) or (GetButtonValue(ItemIndex) <> Value) then
  1742.   begin
  1743.     if (ItemIndex >= 0) then ItemIndex := -1;
  1744.     for I := 0 to ControlCount - 1 do
  1745.     begin
  1746.       if GetButtonValue(I) = Value then
  1747.       begin
  1748.         ItemIndex := I;
  1749.         break;
  1750.       end;
  1751.     end;
  1752.     Change;
  1753.   end;
  1754. end;
  1755.  
  1756. procedure TDBRadioGroup.CMExit(var Message: TCMExit);
  1757. begin
  1758.   try
  1759.     FDataLink.UpdateRecord;
  1760.   except
  1761.     if ItemIndex >= 0 then TRadioButton(Controls[ItemIndex]).SetFocus
  1762.     else TRadioButton(Controls[0]).SetFocus;
  1763.     raise;
  1764.   end;
  1765.   inherited;
  1766. end;
  1767.  
  1768. procedure TDBRadioGroup.Click;
  1769. begin
  1770.   inherited Click;
  1771.   if ItemIndex >= 0 then
  1772.     Value := GetButtonValue(ItemIndex);
  1773.   if FDataLink.Editing then FDataLink.Modified;
  1774. end;
  1775.  
  1776. procedure TDBRadioGroup.SetItems(Value: TStrings);
  1777. begin
  1778.   Items.Assign(Value);
  1779.   DataChange(Self);
  1780. end;
  1781.  
  1782. procedure TDBRadioGroup.SetValues(Value: TStrings);
  1783. begin
  1784.   FValues.Assign(Value);
  1785.   DataChange(Self);
  1786. end;
  1787.  
  1788. procedure TDBRadioGroup.Change;
  1789. begin
  1790.   if Assigned(FOnChange) then FOnChange(Self);
  1791. end;
  1792.  
  1793. procedure TDBRadioGroup.KeyPress(var Key: Char);
  1794.  
  1795. var
  1796.  
  1797. MyForm : TForm;
  1798.  
  1799. begin
  1800.  
  1801.    if Key = #13 then
  1802.    begin
  1803.        MYForm := GetParentForm( Self );
  1804.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  1805.        Key := #0;
  1806.    end;
  1807.  
  1808.    if Key <> #0 then inherited KeyPress(Key);
  1809.  
  1810.   case Key of
  1811.     #8, ' ':
  1812.       FDataLink.Edit;
  1813.     #27:
  1814.       FDataLink.Reset;
  1815.   end;
  1816. end;
  1817.  
  1818. function TDBRadioGroup.CanModify: Boolean;
  1819. begin
  1820.   Result := FDataLink.Edit;
  1821. end;
  1822.  
  1823. { TDBMemo }
  1824.  
  1825. constructor TDBMemo.Create(AOwner: TComponent);
  1826. begin
  1827.   inherited Create(AOwner);
  1828.   inherited ReadOnly := True;
  1829.   FAutoDisplay := True;
  1830.   FDataLink := TFieldDataLink.Create;
  1831.   FDataLink.Control := Self;
  1832.   FDataLink.OnDataChange := DataChange;
  1833.   FDataLink.OnEditingChange := EditingChange;
  1834.   FDataLink.OnUpdateData := UpdateData;
  1835. end;
  1836.  
  1837. destructor TDBMemo.Destroy;
  1838. begin
  1839.   FDataLink.Free;
  1840.   FDataLink := nil;
  1841.   inherited Destroy;
  1842. end;
  1843.  
  1844. procedure TDBMemo.Notification(AComponent: TComponent;
  1845.   Operation: TOperation);
  1846. begin
  1847.   inherited Notification(AComponent, Operation);
  1848.   if (Operation = opRemove) and (FDataLink <> nil) and
  1849.     (AComponent = DataSource) then DataSource := nil;
  1850. end;
  1851.  
  1852. procedure TDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
  1853. begin
  1854.   inherited KeyDown(Key, Shift);
  1855.   if FMemoLoaded then
  1856.   begin
  1857.     if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
  1858.       FDataLink.Edit;
  1859.   end else
  1860.     Key := 0;
  1861. end;
  1862.  
  1863. procedure TDBMemo.KeyPress(var Key: Char);
  1864.  
  1865. var
  1866.  
  1867. MyForm : TForm;
  1868.  
  1869. begin
  1870.  
  1871.    if Key = #13 then
  1872.    begin
  1873.        MYForm := GetParentForm( Self );
  1874.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  1875.        Key := #0;
  1876.    end;
  1877.  
  1878.    if Key <> #0 then inherited KeyPress(Key);
  1879.  
  1880.   if FMemoLoaded then
  1881.   begin
  1882.     if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
  1883.       not FDataLink.Field.IsValidChar(Key) then
  1884.     begin
  1885.       MessageBeep(0);
  1886.       Key := #0;
  1887.     end;
  1888.     case Key of
  1889.       ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
  1890.         FDataLink.Edit;
  1891.       #27:
  1892.         FDataLink.Reset;
  1893.     end;
  1894.   end else
  1895.   begin
  1896.     if Key = #13 then LoadMemo;
  1897.     Key := #0;
  1898.   end;
  1899. end;
  1900.  
  1901. procedure TDBMemo.Change;
  1902. begin
  1903.   FDataLink.Modified;
  1904.   FMemoLoaded := True;
  1905.   inherited Change;
  1906. end;
  1907.  
  1908. function TDBMemo.GetDataSource: TDataSource;
  1909. begin
  1910.   Result := FDataLink.DataSource;
  1911. end;
  1912.  
  1913. procedure TDBMemo.SetDataSource(Value: TDataSource);
  1914. begin
  1915.   FDataLink.DataSource := Value;
  1916. end;
  1917.  
  1918. function TDBMemo.GetDataField: string;
  1919. begin
  1920.   Result := FDataLink.FieldName;
  1921. end;
  1922.  
  1923. procedure TDBMemo.SetDataField(const Value: string);
  1924. begin
  1925.   FDataLink.FieldName := Value;
  1926. end;
  1927.  
  1928. function TDBMemo.GetReadOnly: Boolean;
  1929. begin
  1930.   Result := FDataLink.ReadOnly;
  1931. end;
  1932.  
  1933. procedure TDBMemo.SetReadOnly(Value: Boolean);
  1934. begin
  1935.   FDataLink.ReadOnly := Value;
  1936. end;
  1937.  
  1938. function TDBMemo.GetField: TField;
  1939. begin
  1940.   Result := FDataLink.Field;
  1941. end;
  1942.  
  1943. procedure TDBMemo.LoadMemo;
  1944. begin
  1945.   if not FMemoLoaded and (FDataLink.Field is TBlobField) then
  1946.   begin
  1947.     Lines.Assign(FDataLink.Field);
  1948.     FMemoLoaded := True;
  1949.     EditingChange(Self);
  1950.   end;
  1951. end;
  1952.  
  1953. procedure TDBMemo.DataChange(Sender: TObject);
  1954. begin
  1955.   if FDataLink.Field <> nil then
  1956.     if FDataLink.Field is TBlobField then
  1957.     begin
  1958.       if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
  1959.       begin
  1960.         FMemoLoaded := False;
  1961.         LoadMemo;
  1962.       end else
  1963.       begin
  1964.         Text := '(' + FDataLink.Field.DisplayLabel + ')';
  1965.         FMemoLoaded := False;
  1966.       end;
  1967.     end else
  1968.     begin
  1969.       if FFocused and FDataLink.CanModify then
  1970.         Text := FDataLink.Field.Text
  1971.       else
  1972.         Text := FDataLink.Field.DisplayText;
  1973.       FMemoLoaded := True;
  1974.     end
  1975.   else
  1976.   begin
  1977.     if csDesigning in ComponentState then Text := Name else Text := '';
  1978.     FMemoLoaded := False;
  1979.   end;
  1980. end;
  1981.  
  1982. procedure TDBMemo.EditingChange(Sender: TObject);
  1983. begin
  1984.   inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
  1985. end;
  1986.  
  1987. procedure TDBMemo.UpdateData(Sender: TObject);
  1988. begin
  1989.   if FDataLink.Field is TBlobField then
  1990.     FDataLink.Field.Assign(Lines)
  1991.   else
  1992.     FDataLink.Field.Text := Text;
  1993. end;
  1994.  
  1995. procedure TDBMemo.SetFocused(Value: Boolean);
  1996. begin
  1997.   if FFocused <> Value then
  1998.   begin
  1999.     FFocused := Value;
  2000.     if not (FDataLink.Field is TBlobField) then FDataLink.Reset;
  2001.   end;
  2002. end;
  2003.  
  2004. procedure TDBMemo.CMEnter(var Message: TCMEnter);
  2005. begin
  2006.   SetFocused(True);
  2007.   inherited;
  2008. end;
  2009.  
  2010. procedure TDBMemo.CMExit(var Message: TCMExit);
  2011. begin
  2012.   if not (FDataLink.Field is TBlobField) then
  2013.     try
  2014.       FDataLink.UpdateRecord;
  2015.     except
  2016.       SetFocus;
  2017.       raise;
  2018.     end;
  2019.   SetFocused(False);
  2020.   inherited;
  2021. end;
  2022.  
  2023. procedure TDBMemo.SetAutoDisplay(Value: Boolean);
  2024. begin
  2025.   if FAutoDisplay <> Value then
  2026.   begin
  2027.     FAutoDisplay := Value;
  2028.     if Value then LoadMemo;
  2029.   end;
  2030. end;
  2031.  
  2032. procedure TDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  2033. begin
  2034.   if not FMemoLoaded then LoadMemo else inherited;
  2035. end;
  2036.  
  2037. procedure TDBMemo.WMCut(var Message: TMessage);
  2038. begin
  2039.   FDataLink.Edit;
  2040.   inherited;
  2041. end;
  2042.  
  2043. procedure TDBMemo.WMPaste(var Message: TMessage);
  2044. begin
  2045.   FDataLink.Edit;
  2046.   inherited;
  2047. end;
  2048.  
  2049. { TDBImage }
  2050.  
  2051. constructor TDBImage.Create(AOwner: TComponent);
  2052. begin
  2053.   inherited Create(AOwner);
  2054.   ControlStyle := ControlStyle + [csFramed, csOpaque];
  2055.   Width := 105;
  2056.   Height := 105;
  2057.   TabStop := True;
  2058.   ParentColor := False;
  2059.   FPicture := TPicture.Create;
  2060.   FPicture.OnChange := PictureChanged;
  2061.   FBorderStyle := bsSingle;
  2062.   FAutoDisplay := True;
  2063.   FCenter := True;
  2064.   FDataLink := TFieldDataLink.Create;
  2065.   FDataLink.Control := Self;
  2066.   FDataLink.OnDataChange := DataChange;
  2067.   FDataLink.OnUpdateData := UpdateData;
  2068. end;
  2069.  
  2070. destructor TDBImage.Destroy;
  2071. begin
  2072.   FPicture.Free;
  2073.   FDataLink.Free;
  2074.   FDataLink := nil;
  2075.   inherited Destroy;
  2076. end;
  2077.  
  2078. function TDBImage.GetDataSource: TDataSource;
  2079. begin
  2080.   Result := FDataLink.DataSource;
  2081. end;
  2082.  
  2083. procedure TDBImage.SetDataSource(Value: TDataSource);
  2084. begin
  2085.   FDataLink.DataSource := Value;
  2086. end;
  2087.  
  2088. function TDBImage.GetDataField: string;
  2089. begin
  2090.   Result := FDataLink.FieldName;
  2091. end;
  2092.  
  2093. procedure TDBImage.SetDataField(const Value: string);
  2094. begin
  2095.   FDataLink.FieldName := Value;
  2096. end;
  2097.  
  2098. function TDBImage.GetReadOnly: Boolean;
  2099. begin
  2100.   Result := FDataLink.ReadOnly;
  2101. end;
  2102.  
  2103. procedure TDBImage.SetReadOnly(Value: Boolean);
  2104. begin
  2105.   FDataLink.ReadOnly := Value;
  2106. end;
  2107.  
  2108. function TDBImage.GetField: TField;
  2109. begin
  2110.   Result := FDataLink.Field;
  2111. end;
  2112.  
  2113. function TDBImage.GetPalette: HPALETTE;
  2114. begin
  2115.   Result := 0;
  2116.   if FPicture.Graphic is TBitmap then
  2117.     Result := TBitmap(FPicture.Graphic).Palette;
  2118. end;
  2119.  
  2120. procedure TDBImage.SetAutoDisplay(Value: Boolean);
  2121. begin
  2122.   if FAutoDisplay <> Value then
  2123.   begin
  2124.     FAutoDisplay := Value;
  2125.     if Value then LoadPicture;
  2126.   end;
  2127. end;
  2128.  
  2129. procedure TDBImage.SetBorderStyle(Value: TBorderStyle);
  2130. begin
  2131.   if FBorderStyle <> Value then
  2132.   begin
  2133.     FBorderStyle := Value;
  2134.     RecreateWnd;
  2135.   end;
  2136. end;
  2137.  
  2138. procedure TDBImage.SetCenter(Value: Boolean);
  2139. begin
  2140.   if FCenter <> Value then
  2141.   begin
  2142.     FCenter := Value;
  2143.     Invalidate;
  2144.   end;
  2145. end;
  2146.  
  2147. procedure TDBImage.SetPicture(Value: TPicture);
  2148. begin
  2149.   FPicture.Assign(Value);
  2150. end;
  2151.  
  2152. procedure TDBImage.SetStretch(Value: Boolean);
  2153. begin
  2154.   if FStretch <> Value then
  2155.   begin
  2156.     FStretch := Value;
  2157.     Invalidate;
  2158.   end;
  2159. end;
  2160.  
  2161. procedure TDBImage.Paint;
  2162. var
  2163.   W, H: Integer;
  2164.   R: TRect;
  2165.   S: string[63];
  2166. begin
  2167.   with Canvas do
  2168.   begin
  2169.     Brush.Style := bsSolid;
  2170.     Brush.Color := Color;
  2171.     if FPictureLoaded then
  2172.     begin
  2173.       if Stretch then
  2174.         if Picture.Graphic.Empty then
  2175.           FillRect(ClientRect) else
  2176.           StretchDraw(ClientRect, Picture.Graphic)
  2177.       else
  2178.       begin
  2179.         SetRect(R, 0, 0, Picture.Width, Picture.Height);
  2180.         if Center then OffsetRect(R, (ClientWidth - Picture.Width) div 2,
  2181.           (ClientHeight - Picture.Height) div 2);
  2182.         StretchDraw(R, Picture.Graphic);
  2183.         ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
  2184.         FillRect(ClientRect);
  2185.         SelectClipRgn(Handle, 0);
  2186.       end;
  2187.     end else
  2188.     begin
  2189.       Font := Self.Font;
  2190.       if FDataLink.Field <> nil then
  2191.         S := FDataLink.Field.DisplayLabel else
  2192.         S := Name;
  2193.       S := '(' + S + ')';
  2194.       W := TextWidth(S);
  2195.       H := TextHeight(S);
  2196.       R := ClientRect;
  2197.       TextRect(R, (R.Right - W) div 2, (R.Bottom - H) div 2, S);
  2198.     end;
  2199.     if (GetParentForm(Self).ActiveControl = Self) and
  2200.       not (csDesigning in ComponentState) then
  2201.     begin
  2202.       Brush.Color := clWindowFrame;
  2203.       FrameRect(ClientRect);
  2204.     end;
  2205.   end;
  2206. end;
  2207.  
  2208. procedure TDBImage.PictureChanged(Sender: TObject);
  2209. begin
  2210.   FDataLink.Modified;
  2211.   FPictureLoaded := True;
  2212.   Invalidate;
  2213. end;
  2214.  
  2215. procedure TDBImage.Notification(AComponent: TComponent;
  2216.   Operation: TOperation);
  2217. begin
  2218.   inherited Notification(AComponent, Operation);
  2219.   if (Operation = opRemove) and (FDataLink <> nil) and
  2220.     (AComponent = DataSource) then DataSource := nil;
  2221. end;
  2222.  
  2223. procedure TDBImage.LoadPicture;
  2224. begin
  2225.   if not FPictureLoaded and (FDataLink.Field is TBlobField) then
  2226.     Picture.Assign(FDataLink.Field);
  2227. end;
  2228.  
  2229. procedure TDBImage.DataChange(Sender: TObject);
  2230. begin
  2231.   Picture.Graphic := nil;
  2232.   FPictureLoaded := False;
  2233.   if FAutoDisplay then LoadPicture;
  2234. end;
  2235.  
  2236. procedure TDBImage.UpdateData(Sender: TObject);
  2237. begin
  2238.   if FDataLink.Field is TBlobField then
  2239.     with TBlobField(FDataLink.Field) do
  2240.       if Picture.Graphic is TBitmap then
  2241.         Assign(Picture.Graphic)
  2242.       else
  2243.         Clear;
  2244. end;
  2245.  
  2246. procedure TDBImage.CopyToClipboard;
  2247. begin
  2248.   if Picture.Graphic <> nil then Clipboard.Assign(Picture);
  2249. end;
  2250.  
  2251. procedure TDBImage.CutToClipboard;
  2252. begin
  2253.   if Picture.Graphic <> nil then
  2254.     if FDataLink.Edit then
  2255.     begin
  2256.       CopyToClipboard;
  2257.       Picture.Graphic := nil;
  2258.     end;
  2259. end;
  2260.  
  2261. procedure TDBImage.PasteFromClipboard;
  2262. begin
  2263.   if Clipboard.HasFormat(CF_PICTURE) and FDataLink.Edit then
  2264.     Picture.Assign(Clipboard);
  2265. end;
  2266.  
  2267. procedure TDBImage.CreateParams(var Params: TCreateParams);
  2268. begin
  2269.   inherited CreateParams(Params);
  2270.   if FBorderStyle = bsSingle then
  2271.     Params.Style := Params.Style or WS_BORDER;
  2272. end;
  2273.  
  2274. procedure TDBImage.KeyDown(var Key: Word; Shift: TShiftState);
  2275. begin
  2276.   inherited KeyDown(Key, Shift);
  2277.   case Key of
  2278.     VK_INSERT:
  2279.       if ssShift in Shift then PasteFromClipBoard else
  2280.         if ssCtrl in Shift then CopyToClipBoard;
  2281.     VK_DELETE:
  2282.       if ssShift in Shift then CutToClipBoard;
  2283.   end;
  2284. end;
  2285.  
  2286. procedure TDBImage.KeyPress(var Key: Char);
  2287.  
  2288. var
  2289.  
  2290. MyForm : TForm;
  2291.  
  2292. begin
  2293.  
  2294.    if Key = #13 then
  2295.    begin
  2296.        MYForm := GetParentForm( Self );
  2297.        SendMessage(MYForm.Handle, WM_NEXTDLGCTL, 0, 0);
  2298.        Key := #0;
  2299.    end;
  2300.  
  2301.    if Key <> #0 then inherited KeyPress(Key);
  2302.  
  2303.   case Key of
  2304.     ^X: CutToClipBoard;
  2305.     ^C: CopyToClipBoard;
  2306.     ^V: PasteFromClipBoard;
  2307.     #13: LoadPicture;
  2308.     #27: FDataLink.Reset;
  2309.   end;
  2310. end;
  2311.  
  2312. procedure TDBImage.CMEnter(var Message: TCMEnter);
  2313. begin
  2314.   Invalidate; { Draw the focus marker }
  2315.   inherited;
  2316. end;
  2317.  
  2318. procedure TDBImage.CMExit(var Message: TCMExit);
  2319. begin
  2320.   Invalidate; { Erase the focus marker }
  2321.   inherited;
  2322. end;
  2323.  
  2324. procedure TDBImage.CMTextChanged(var Message: TMessage);
  2325. begin
  2326.   inherited;
  2327.   if not FPictureLoaded then Invalidate;
  2328. end;
  2329.  
  2330. procedure TDBImage.WMLButtonDown(var Message: TWMLButtonDown);
  2331. begin
  2332.   if TabStop and CanFocus then SetFocus;
  2333.   inherited;
  2334. end;
  2335.  
  2336. procedure TDBImage.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  2337. begin
  2338.   LoadPicture;
  2339.   inherited;
  2340. end;
  2341.  
  2342. procedure TDBImage.WMCut(var Message: TMessage);
  2343. begin
  2344.   CutToClipboard;
  2345. end;
  2346.  
  2347. procedure TDBImage.WMCopy(var Message: TMessage);
  2348. begin
  2349.   CopyToClipboard;
  2350. end;
  2351.  
  2352. procedure TDBImage.WMPaste(var Message: TMessage);
  2353. begin
  2354.   PasteFromClipboard;
  2355. end;
  2356.  
  2357. { TDBNavigator }
  2358.  
  2359. const
  2360.   BtnStateName: array[TNavGlyph] of PChar = ('EN', 'DI');
  2361.   BtnTypeName: array[TNavigateBtn] of PChar = ('FIRST', 'PRIOR', 'NEXT',
  2362.     'LAST', 'INSERT', 'DELETE', 'EDIT', 'POST', 'CANCEL', 'REFRESH');
  2363.   BtnHintId: array[TNavigateBtn] of Word = (SFirstRecord, SPriorRecord,
  2364.     SNextRecord, SLastRecord, SInsertRecord, SDeleteRecord, SEditRecord,
  2365.     SPostEdit, SCancelEdit, SRefreshRecord);
  2366.  
  2367. constructor TDBNavigator.Create(AOwner: TComponent);
  2368. begin
  2369.   inherited Create(AOwner);
  2370.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
  2371.     [csFramed, csOpaque];
  2372.   FDataLink := TNavDataLink.Create(Self);
  2373.   FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
  2374.     nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  2375.   FHints := TStringList.Create;
  2376.   InitButtons;
  2377.   BevelOuter := bvNone;
  2378.   BevelInner := bvNone;
  2379.   Width := 241;
  2380.   Height := 25;
  2381.   ButtonWidth := 0;
  2382.   FocusedButton := nbFirst;
  2383.   FConfirmDelete := True;
  2384. end;
  2385.  
  2386. destructor TDBNavigator.Destroy;
  2387. begin
  2388.   FDataLink.Free;
  2389.   FDataLink := nil;
  2390.   inherited Destroy;
  2391. end;
  2392.  
  2393. procedure TDBNavigator.InitButtons;
  2394. var
  2395.   I: TNavigateBtn;
  2396.   Btn: TNavButton;
  2397.   X: Integer;
  2398.   ResName: array[0..40] of Char;
  2399. begin
  2400.   MinBtnSize := Point(20, 18);
  2401.   X := 0;
  2402.   for I := Low(Buttons) to High(Buttons) do
  2403.   begin
  2404.     Btn := TNavButton.Create (Self);
  2405.     Btn.Index := I;
  2406.     Btn.Visible := I in FVisibleButtons;
  2407.     Btn.Enabled := True;
  2408.     Btn.SetBounds (X, 0, MinBtnSize.X, MinBtnSize.Y);
  2409.     Btn.Glyph.Handle := LoadBitmap(HInstance,
  2410.         StrFmt(ResName, 'dbn_%s', [BtnTypeName[I]]));
  2411.     Btn.NumGlyphs := 2;
  2412.     Btn.OnClick := Click;
  2413.     Btn.OnMouseDown := BtnMouseDown;
  2414.     Btn.Parent := Self;
  2415.     Buttons[I] := Btn;
  2416.     X := X + MinBtnSize.X;
  2417.   end;
  2418.   InitHints;
  2419.   Buttons[nbPrior].NavStyle := Buttons[nbPrior].NavStyle + [nsAllowTimer];
  2420.   Buttons[nbNext].NavStyle  := Buttons[nbNext].NavStyle + [nsAllowTimer];
  2421. end;
  2422.  
  2423. procedure TDBNavigator.InitHints;
  2424. var
  2425.   I: Integer;
  2426.   J: TNavigateBtn;
  2427. begin
  2428.   for J := Low(Buttons) to High(Buttons) do
  2429.     Buttons[J].Hint := LoadStr (BtnHintId[J]);
  2430.   J := Low(Buttons);
  2431.   for I := 0 to (FHints.Count - 1) do
  2432.   begin
  2433.     if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I];
  2434.     if J = High(Buttons) then Exit;
  2435.     Inc(J);
  2436.   end;
  2437. end;
  2438.  
  2439. procedure TDBNavigator.SetHints(Value: TStrings);
  2440. begin
  2441.   FHints.Assign(Value);
  2442.   InitHints;
  2443. end;
  2444.  
  2445. procedure TDBNavigator.Notification(AComponent: TComponent;
  2446.   Operation: TOperation);
  2447. begin
  2448.   inherited Notification(AComponent, Operation);
  2449.   if (Operation = opRemove) and (FDataLink <> nil) and
  2450.     (AComponent = DataSource) then DataSource := nil;
  2451. end;
  2452.  
  2453. procedure TDBNavigator.SetVisible(Value: TButtonSet);
  2454. var
  2455.   I: TNavigateBtn;
  2456.   W, H: Integer;
  2457. begin
  2458.   W := Width;
  2459.   H := Height;
  2460.   FVisibleButtons := Value;
  2461.   for I := Low(Buttons) to High(Buttons) do
  2462.     Buttons[I].Visible := I in FVisibleButtons;
  2463.   AdjustSize (W, H);
  2464.   if (W <> Width) or (H <> Height) then
  2465.     inherited SetBounds (Left, Top, W, H);
  2466.   Invalidate;
  2467. end;
  2468.  
  2469. procedure TDBNavigator.AdjustSize (var W: Integer; var H: Integer);
  2470. var
  2471.   Count: Integer;
  2472.   MinW: Integer;
  2473.   I: TNavigateBtn;
  2474.   LastBtn: TNavigateBtn;
  2475.   Space, Temp, Remain: Integer;
  2476.   X: Integer;
  2477. begin
  2478.   if (csLoading in ComponentState) then Exit;
  2479.   if Buttons[nbFirst] = nil then Exit;
  2480.  
  2481.   Count := 0;
  2482.   LastBtn := High(Buttons);
  2483.   for I := Low(Buttons) to High(Buttons) do
  2484.   begin
  2485.     if Buttons[I].Visible then
  2486.     begin
  2487.       Inc(Count);
  2488.       LastBtn := I;
  2489.     end;
  2490.   end;
  2491.   if Count = 0 then Inc(Count);
  2492.  
  2493.   MinW := Count * (MinBtnSize.X - 1) + 1;
  2494.   if W < MinW then
  2495.     W := MinW;
  2496.   if H < MinBtnSize.Y then
  2497.     H := MinBtnSize.Y;
  2498.  
  2499.   ButtonWidth := ((W - 1) div Count) + 1;
  2500.   Temp := Count * (ButtonWidth - 1) + 1;
  2501.   if Align = alNone then
  2502.     W := Temp;
  2503.  
  2504.   X := 0;
  2505.   Remain := W - Temp;
  2506.   Temp := Count div 2;
  2507.   for I := Low(Buttons) to High(Buttons) do
  2508.   begin
  2509.     if Buttons[I].Visible then
  2510.     begin
  2511.       Space := 0;
  2512.       if Remain <> 0 then
  2513.       begin
  2514.         Dec (Temp, Remain);
  2515.         if Temp < 0 then
  2516.         begin
  2517.           Inc (Temp, Count);
  2518.           Space := 1;
  2519.         end;
  2520.       end;
  2521.       Buttons[I].SetBounds (X, 0, ButtonWidth + Space, Height);
  2522.       Inc (X, ButtonWidth - 1 + Space);
  2523.       LastBtn := I;
  2524.     end
  2525.     else
  2526.       Buttons[I].SetBounds (Width + 1, 0, ButtonWidth, Height);
  2527.   end;
  2528. end;
  2529.  
  2530. procedure TDBNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  2531. var
  2532.   W, H: Integer;
  2533. begin
  2534.   W := AWidth;
  2535.   H := AHeight;
  2536.   AdjustSize (W, H);
  2537.   inherited SetBounds (ALeft, ATop, W, H);
  2538. end;
  2539.  
  2540. procedure TDBNavigator.WMSize(var Message: TWMSize);
  2541. var
  2542.   W, H: Integer;
  2543. begin
  2544.   inherited;
  2545.  
  2546.   { check for minimum size }
  2547.   W := Width;
  2548.   H := Height;
  2549.   AdjustSize (W, H);
  2550.   if (W <> Width) or (H <> Height) then
  2551.     inherited SetBounds(Left, Top, W, H);
  2552.   Message.Result := 0;
  2553. end;
  2554.  
  2555. procedure TDBNavigator.Click(Sender: TObject);
  2556. begin
  2557.   BtnClick (TNavButton (Sender).Index);
  2558. end;
  2559.  
  2560. procedure TDBNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton;
  2561.   Shift: TShiftState; X, Y: Integer);
  2562. var
  2563.   OldFocus: TNavigateBtn;
  2564.   Form: TForm;
  2565. begin
  2566.   OldFocus := FocusedButton;
  2567.   FocusedButton := TNavButton (Sender).Index;
  2568.   if TabStop and (GetFocus <> Handle) and CanFocus then
  2569.   begin
  2570.     SetFocus;
  2571.     if (GetFocus <> Handle) then
  2572.       Exit;
  2573.   end
  2574.   else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then
  2575.   begin
  2576.     Buttons[OldFocus].Invalidate;
  2577.     Buttons[FocusedButton].Invalidate;
  2578.   end;
  2579. end;
  2580.  
  2581. procedure TDBNavigator.BtnClick(Index: TNavigateBtn);
  2582. begin
  2583.   if (DataSource <> nil) and (DataSource.State <> dsInactive) then
  2584.   begin
  2585.     with DataSource.DataSet do
  2586.     begin
  2587.       case Index of
  2588.         nbPrior: Prior;
  2589.         nbNext: Next;
  2590.         nbFirst: First;
  2591.         nbLast: Last;
  2592.         nbInsert: Insert;
  2593.         nbEdit: Edit;
  2594.         nbCancel: Cancel;
  2595.         nbPost: Post;
  2596.         nbRefresh: Refresh;
  2597.         nbDelete:
  2598.           begin
  2599.             if not FConfirmDelete or
  2600.                 (MessageDlg (LoadStr(SDeleteRecordQuestion),
  2601.                 mtConfirmation, mbOKCancel, 0) <> idCancel) then
  2602.               Delete;
  2603.           end;
  2604.       end;
  2605.     end;
  2606.   end;
  2607.   if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then
  2608.     FOnNavClick(Self, Index);
  2609. end;
  2610.  
  2611. procedure TDBNavigator.WMSetFocus(var Message: TWMSetFocus);
  2612. begin
  2613.   Buttons[FocusedButton].Invalidate;
  2614. end;
  2615.  
  2616. procedure TDBNavigator.WMKillFocus(var Message: TWMKillFocus);
  2617. begin
  2618.   Buttons[FocusedButton].Invalidate;
  2619. end;
  2620.  
  2621. procedure TDBNavigator.KeyDown(var Key: Word; Shift: TShiftState);
  2622. var
  2623.   NewFocus: TNavigateBtn;
  2624.   OldFocus: TNavigateBtn;
  2625. begin
  2626.   OldFocus := FocusedButton;
  2627.   case Key of
  2628.     VK_RIGHT:
  2629.       begin
  2630.         NewFocus := FocusedButton;
  2631.         repeat
  2632.           if NewFocus < High(Buttons) then
  2633.             NewFocus := Succ(NewFocus);
  2634.         until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
  2635.         if NewFocus <> FocusedButton then
  2636.         begin
  2637.           FocusedButton := NewFocus;
  2638.           Buttons[OldFocus].Invalidate;
  2639.           Buttons[FocusedButton].Invalidate;
  2640.         end;
  2641.       end;
  2642.     VK_LEFT:
  2643.       begin
  2644.         NewFocus := FocusedButton;
  2645.         repeat
  2646.           if NewFocus > Low(Buttons) then
  2647.             NewFocus := Pred(NewFocus);
  2648.         until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
  2649.         if NewFocus <> FocusedButton then
  2650.         begin
  2651.           FocusedButton := NewFocus;
  2652.           Buttons[OldFocus].Invalidate;
  2653.           Buttons[FocusedButton].Invalidate;
  2654.         end;
  2655.       end;
  2656.     VK_SPACE:
  2657.       begin
  2658.         if Buttons[FocusedButton].Enabled then
  2659.           Buttons[FocusedButton].Click;
  2660.       end;
  2661.   end;
  2662. end;
  2663.  
  2664. procedure TDBNavigator.WMGetDlgCode(var Message: TWMGetDlgCode);
  2665. begin
  2666.   Message.Result := DLGC_WANTARROWS;
  2667. end;
  2668.  
  2669. procedure TDBNavigator.DataChanged;
  2670. var
  2671.   UpEnable, DnEnable: Boolean;
  2672. begin
  2673.   UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF;
  2674.   DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF;
  2675.   Buttons[nbFirst].Enabled := UpEnable;
  2676.   Buttons[nbPrior].Enabled := UpEnable;
  2677.   Buttons[nbNext].Enabled := DnEnable;
  2678.   Buttons[nbLast].Enabled := DnEnable;
  2679.   Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and 
  2680.     FDataLink.DataSet.CanModify and 
  2681.     not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF);
  2682. end;
  2683.  
  2684. procedure TDBNavigator.EditingChanged;
  2685. var
  2686.   CanModify: Boolean;
  2687. begin
  2688.   CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify;
  2689.   Buttons[nbInsert].Enabled := CanModify;
  2690.   Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing;
  2691.   Buttons[nbPost].Enabled := CanModify and FDataLink.Editing;
  2692.   Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing;
  2693.   Buttons[nbRefresh].Enabled := not (FDataLink.DataSet is TQuery);
  2694. end;
  2695.  
  2696. procedure TDBNavigator.ActiveChanged;
  2697. var
  2698.   I: TNavigateBtn;
  2699. begin
  2700.   if not (Enabled and FDataLink.Active) then
  2701.     for I := Low(Buttons) to High(Buttons) do
  2702.       Buttons[I].Enabled := False
  2703.   else
  2704.   begin
  2705.     DataChanged;
  2706.     EditingChanged;
  2707.   end;
  2708. end;
  2709.  
  2710. procedure TDBNavigator.CMEnabledChanged(var Message: TMessage);
  2711. begin
  2712.   inherited;
  2713.   if not (csLoading in ComponentState) then
  2714.     ActiveChanged;
  2715. end;
  2716.  
  2717. procedure TDBNavigator.SetDataSource(Value: TDataSource);
  2718. begin
  2719.   FDataLink.DataSource := Value;
  2720.   if not (csLoading in ComponentState) then
  2721.     ActiveChanged;
  2722. end;
  2723.  
  2724. function TDBNavigator.GetDataSource: TDataSource;
  2725. begin
  2726.   Result := FDataLink.DataSource;
  2727. end;
  2728.  
  2729. procedure TDBNavigator.Loaded;
  2730. var
  2731.   W, H: Integer;
  2732. begin
  2733.   inherited Loaded;
  2734.   W := Width;
  2735.   H := Height;
  2736.   AdjustSize (W, H);
  2737.   if (W <> Width) or (H <> Height) then
  2738.     inherited SetBounds (Left, Top, W, H);
  2739.   InitHints;
  2740.   ActiveChanged;
  2741. end;
  2742.  
  2743. {TNavButton}
  2744.  
  2745. destructor TNavButton.Destroy;
  2746. begin
  2747.   if FRepeatTimer <> nil then
  2748.     FRepeatTimer.Free;
  2749.   inherited Destroy;
  2750. end;
  2751.  
  2752. procedure TNavButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2753.   X, Y: Integer);
  2754. begin
  2755.   inherited MouseDown (Button, Shift, X, Y);
  2756.   if nsAllowTimer in FNavStyle then
  2757.   begin
  2758.     if FRepeatTimer = nil then
  2759.       FRepeatTimer := TTimer.Create(Self);
  2760.  
  2761.     FRepeatTimer.OnTimer := TimerExpired;
  2762.     FRepeatTimer.Interval := InitRepeatPause;
  2763.     FRepeatTimer.Enabled  := True;
  2764.   end;
  2765. end;
  2766.  
  2767. procedure TNavButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2768.                                   X, Y: Integer);
  2769. begin
  2770.   inherited MouseUp (Button, Shift, X, Y);
  2771.   if FRepeatTimer <> nil then
  2772.     FRepeatTimer.Enabled  := False;
  2773. end;
  2774.  
  2775. procedure TNavButton.TimerExpired(Sender: TObject);
  2776. begin
  2777.   FRepeatTimer.Interval := RepeatPause;
  2778.   if (FState = bsDown) and MouseCapture then
  2779.   begin
  2780.     try
  2781.       Click;
  2782.     except
  2783.       FRepeatTimer.Enabled := False;
  2784.       raise;
  2785.     end;
  2786.   end;
  2787. end;
  2788.  
  2789. procedure TNavButton.Paint;
  2790. var
  2791.   R: TRect;
  2792. begin
  2793.   inherited Paint;
  2794.   if (GetFocus = Parent.Handle) and
  2795.      (FIndex = TDBNavigator (Parent).FocusedButton) then
  2796.   begin
  2797.     R := Bounds(0, 0, Width, Height);
  2798.     InflateRect(R, -3, -3);
  2799.     if FState = bsDown then
  2800.       OffsetRect(R, 1, 1);
  2801.     DrawFocusRect(Canvas.Handle, R);
  2802.   end;
  2803. end;
  2804.  
  2805. { TNavDataLink }
  2806.  
  2807. constructor TNavDataLink.Create(ANav: TDBNavigator);
  2808. begin
  2809.   inherited Create;
  2810.   FNavigator := ANav;
  2811. end;
  2812.  
  2813. destructor TNavDataLink.Destroy;
  2814. begin
  2815.   FNavigator := nil;
  2816.   inherited Destroy;
  2817. end;
  2818.  
  2819. procedure TNavDataLink.EditingChanged;
  2820. begin
  2821.   if FNavigator <> nil then FNavigator.EditingChanged;
  2822. end;
  2823.  
  2824. procedure TNavDataLink.DataSetChanged;
  2825. begin
  2826.   if FNavigator <> nil then FNavigator.DataChanged;
  2827. end;
  2828.  
  2829. procedure TNavDataLink.ActiveChanged;
  2830. begin
  2831.   if FNavigator <> nil then FNavigator.ActiveChanged;
  2832. end;
  2833.  
  2834. end.
  2835.