1{ $Id: dbctrls.pp 64623 2021-02-19 02:18:02Z martin $}
2{
3 /***************************************************************************
4                               DbCtrls.pp
5                               ----------
6                     An interface to DB aware Controls
7                     Initial Revision : Sun Sep 14 2003
8
9
10 ***************************************************************************/
11
12 *****************************************************************************
13  This file is part of the Lazarus Component Library (LCL)
14
15  See the file COPYING.modifiedLGPL.txt, included in this distribution,
16  for details about the license.
17 *****************************************************************************
18}
19{
20@abstract(common db aware controls, as in Delphi)
21@author(Andrew Johnson <acjgenius@@earthlink.net>)
22@created(Sun Sep 14 2003)
23@lastmod($Date: 2021-02-19 03:18:02 +0100 (Fr, 19 Feb 2021) $)
24}
25unit DBCtrls;
26
27{$mode objfpc}
28{$H+}
29
30interface
31
32uses
33  Types, Classes, SysUtils, DB, Variants,
34  // LazUtils
35  LazTracer, LazUtilities,
36  // LCL
37  LCLStrConsts, LMessages, LCLType, LCLIntf, LResources, GraphType, Controls, Graphics,
38  Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls, Calendar, ImgList;
39
40Type
41  { TFieldDataLink }
42
43  TFieldDataLink = class(TDataLink)
44  private
45    FField: TField;
46    FFieldName: string;
47    FControl: TComponent;
48    // Callbacks
49    FOnDataChange: TNotifyEvent;
50    FOnEditingChange: TNotifyEvent;
51    FOnUpdateData: TNotifyEvent;
52    FOnActiveChange: TNotifyEvent;
53    // Curent State of Affairs
54    FEditing: Boolean;
55    FEditingSourceSet: boolean;
56    FEditingSource: Boolean;
57    IsModified: Boolean;
58    function FieldCanModify: boolean;
59    function IsKeyField(aField: TField): Boolean;
60    function GetCanModify: Boolean;
61    // set current field
62    procedure SetFieldName(const Value: string);
63    procedure UpdateField;
64    // make sure the field/fieldname is valid before we do stuff with it
65    procedure ValidateField;
66    procedure ResetEditingSource;
67  protected
68    // Testing Events
69    procedure ActiveChanged; override;
70    procedure EditingChanged; override;
71    procedure LayoutChanged; override;
72    procedure RecordChanged(aField: TField); override;
73    procedure UpdateData; override;
74
75    procedure FocusControl(aField: TFieldRef); Override;
76  public
77    constructor Create;
78    // for control intitiating db changes etc
79    function Edit: Boolean;
80
81    procedure Modified;
82    procedure Reset;
83
84    // Attached control
85    property Control: TComponent read FControl write FControl;
86
87    // Basic DB interfaces
88    property Field: TField read FField;
89    property FieldName: string read FFieldName write SetFieldName;
90
91    // Current State of DB
92    property CanModify: Boolean read GetCanModify;
93    property Editing: Boolean read FEditing;
94    property EditingSource: boolean read FEditingSource;
95
96    // Our Callbacks
97    property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
98    property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange;
99    property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
100    property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
101  end;
102
103
104
105  { TDBLookup }
106  {
107  TDBLookup component is typically owned by a Lookup control like
108  TDBLookupListBox or TDBLookupComboBox.
109  The ListSource is the other dataset TDataSource from which to retrieve the lookup data
110  The KeyField is the lookup key in the ListSource which corresponds to the DataField value
111  The ListField is the name of the field in the ListSource to list into the
112  Items property of the lookup control.
113  which  data
114  }
115
116  TDBLookup = class(TComponent)
117  private
118    FControlLink: TFieldDataLink;
119    FControlItems: TStrings;
120    FListLink: TDataLink;
121    FListSource: TDataSource;
122    FLookupSource: TDataSource;
123    FDataFieldNames: string;
124    FKeyFieldNames: string;
125    FListFieldName: string;
126    FListFieldIndex: Integer;
127    FDataFields: TList;  // Data Fields to lookup/edit
128    FKeyFields: TList;   // Keyfields in lookup dataset
129    FListField: TField;  // Result field in lookup dataset
130    FListKeys: array of Variant;
131    FNullValueKey: TShortcut;
132    FHasLookUpField: Boolean;
133    FLookUpFieldIsCached: Boolean;
134    FLookupCache: Boolean;
135    FInitializing: Boolean;
136    {$IF FPC_FULLVERSION < 30000}
137    FFetchingLookupData: Boolean;
138    {$ENDIF}
139    procedure ActiveChange(Sender: TObject);
140    procedure DatasetChange(Sender: TObject);
141    procedure DoInitialize;
142    procedure FetchLookupData;
143    function GetKeyFieldName: string;
144    function GetListSource: TDataSource;
145    procedure SetKeyFieldName(const Value: string);
146    procedure SetListFieldName(const Value: string);
147    procedure SetListSource(Value: TDataSource);
148    procedure SetLookupCache(const Value: boolean);
149    function HandleNullKey(var Key: Word; Shift: TShiftState): Boolean;
150  protected
151    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
152  public
153    constructor Create(AOwner: TComponent); override;
154    destructor Destroy; override;
155    procedure Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
156    function KeyFieldValue: Variant;
157    procedure UpdateData(ValueIndex: Integer; ScrollDataset: Boolean);
158    function  GetKeyValue(ValueIndex: Integer): Variant;
159    function  GetKeyIndex: Integer;
160    function  GetKeyIndex(const AKeyValue: Variant): Integer;
161    property ControlItems: TStrings read FControlItems write FControlItems;
162    property LookupCache: boolean read FLookupCache  write SetLookupCache;
163    // properties to be published by owner control
164    // these are not used where data control Field is dbLookup
165    property KeyField: string read GetKeyFieldName write SetKeyFieldName;
166    property ListField: string read FListFieldName write SetListFieldName;
167    property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
168    property ListSource: TDataSource read GetListSource write SetListSource;
169    property NullValueKey: TShortcut read FNullValueKey write FNullValueKey;
170  end;
171
172  { TDBEdit }
173
174  TDBEdit = class(TCustomMaskEdit)
175  private
176    FDataLink: TFieldDataLink;
177    FCustomEditMask: Boolean;
178    FFocusedDisplay: boolean;
179    procedure DataChange(Sender: TObject);
180    procedure UpdateData(Sender: TObject);
181    function GetDataField: string;
182    function GetDataSource: TDataSource;
183    function GetField: TField;
184    procedure SetDataField(const Value: string);
185    procedure SetDataSource(Value: TDataSource);
186    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
187  protected
188    function GetReadOnly: Boolean; override;
189    procedure SetReadOnly(Value: Boolean); override;
190    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
191    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
192
193    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
194
195    function EditCanModify: Boolean; override;
196    function GetEditText: string; override;
197
198    procedure Change; override;
199    procedure Reset; override;
200
201    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
202    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
203    procedure WndProc(var Message: TLMessage); override;
204  public
205    constructor Create(AOwner: TComponent); override;
206    destructor Destroy; override;
207    function ExecuteAction(AAction: TBasicAction): Boolean; override;
208    function UpdateAction(AAction: TBasicAction): Boolean; override;
209    property Field: TField read GetField;
210  published
211    property CustomEditMask: Boolean read FCustomEditMask write FCustomEditMask default False;
212    property DataField: string read GetDataField write SetDataField;
213    property DataSource: TDataSource read GetDataSource write SetDataSource;
214    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
215
216    property Align;
217    property Alignment;
218    property Anchors;
219    property AutoSelect;
220    property AutoSize;
221    property BiDiMode;
222    property BorderSpacing;
223    property BorderStyle;
224    property CharCase;
225    property Color;
226    property Constraints;
227    property DoubleBuffered;
228    property DragCursor;
229    property DragKind;
230    property DragMode;
231    property Enabled;
232    property EditMask;
233    property Font;
234    property MaxLength;
235    property ParentBiDiMode;
236    property ParentColor;
237    property ParentDoubleBuffered;
238    property ParentFont;
239    property ParentShowHint;
240    property PasswordChar;
241    property PopupMenu;
242    property ShowHint;
243    property TabOrder;
244    property TabStop;
245    property Visible;
246    property OnChange;
247    property OnClick;
248    property OnContextPopup;
249    property OnDblClick;
250    property OnDragDrop;
251    property OnDragOver;
252    property OnEditingDone;
253    property OnEndDrag;
254    property OnEnter;
255    property OnExit;
256    property OnKeyDown;
257    property OnKeyPress;
258    property OnKeyUp;
259    property OnMouseDown;
260    property OnMouseEnter;
261    property OnMouseLeave;
262    property OnMouseMove;
263    property OnMouseUp;
264    property OnMouseWheel;
265    property OnMouseWheelDown;
266    property OnMouseWheelUp;
267    property OnStartDrag;
268    property OnUTF8KeyPress;
269  end;
270
271
272  { TDBText }
273
274  TDBText = class(TCustomLabel)
275  private
276    FDataLink: TFieldDataLink;
277
278    procedure DataChange(Sender: TObject);
279    function GetDataField: string;
280    function GetDataSource: TDataSource;
281    function GetField: TField;
282
283    procedure SetDataField(const Value: string);
284    procedure SetDataSource(Value: TDataSource);
285    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
286  protected
287    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
288    class procedure WSRegisterClass; override;
289    procedure Loaded; override;
290  public
291    constructor Create(AOwner: TComponent); override;
292    destructor Destroy; override;
293    function ExecuteAction(AAction: TBasicAction): Boolean; override;
294    function UpdateAction(AAction: TBasicAction): Boolean; override;
295    property Field: TField read GetField;
296  published
297    property Align;
298    property Alignment;
299    property Anchors;
300    property AutoSize;
301    property BidiMode;
302    property BorderSpacing;
303    property Color;
304    property Constraints;
305    property DataField: string read GetDataField write SetDataField;
306    property DataSource: TDataSource read GetDataSource write SetDataSource;
307    property DragCursor;
308    property DragKind;
309    property DragMode;
310    property Enabled;
311    property FocusControl;
312    property Font;
313    property Layout;
314    property ParentBidiMode;
315    property ParentColor;
316    property ParentFont;
317    property ParentShowHint;
318    property PopupMenu;
319    property ShowAccelChar;
320    property ShowHint;
321    property Transparent;
322    property Visible;
323    property WordWrap;
324    property OnClick;
325    property OnDblClick;
326    property OnDragDrop;
327    property OnDragOver;
328    property OnEndDrag;
329    property OnMouseDown;
330    property OnMouseEnter;
331    property OnMouseLeave;
332    property OnMouseMove;
333    property OnMouseUp;
334    property OnMouseWheel;
335    property OnMouseWheelDown;
336    property OnMouseWheelUp;
337    property OnChangeBounds;
338    property OnContextPopup;
339    property OnResize;
340    property OnStartDrag;
341    property OptimalFill;
342  end;
343
344  { TCustomDBListBox }
345
346  TCustomDBListBox = class(TCustomListBox)
347  private
348    function GetDataField: string;
349    function GetDataSource: TDataSource;
350    function GetField: TField;
351
352    function GetReadOnly: Boolean;
353    procedure SetReadOnly(Value: Boolean);
354
355    procedure SetDataField(const Value: string);
356    procedure SetDataSource(Value: TDataSource);
357    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
358  protected
359    FDataLink: TFieldDataLink;
360    procedure DataChange(Sender: TObject); virtual; abstract;
361    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
362
363    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
364    procedure UpdateData(Sender: TObject); virtual; abstract;
365    // we need to override the Items Write method for db aware.
366    procedure SetItems(Values : TStrings); override;
367  public
368    constructor Create(AOwner: TComponent); override;
369    destructor Destroy; override;
370    function ExecuteAction(AAction: TBasicAction): Boolean; override;
371    function UpdateAction(AAction: TBasicAction): Boolean; override;
372    property Field: TField read GetField;
373    property DataField: string read GetDataField write SetDataField;
374    property DataSource: TDataSource read GetDataSource write SetDataSource;
375
376    //same as dbedit need to match the datalink status
377    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
378  end;
379
380  { TDBListBox }
381
382  TDBListBox = class(TCustomDBListBox)
383  protected
384    procedure DataChange(Sender: TObject); override;
385    procedure DoSelectionChange(User: Boolean); override;
386    procedure UpdateData(Sender: TObject); override;
387  public
388    procedure EditingDone; override;
389  published
390    property Align;
391    property Anchors;
392    property BiDiMode;
393    property BorderSpacing;
394    property BorderStyle;
395    property Color;
396    property Constraints;
397    property DataField;
398    property DataSource;
399    property DoubleBuffered;
400    property DragCursor;
401    property DragKind;
402    property DragMode;
403    property Enabled;
404    property ExtendedSelect;
405    property Font;
406    property ItemHeight;
407    property Items;
408    property MultiSelect;
409    property OnClick;
410    property OnContextPopup;
411    property OnDblClick;
412    property OnDragDrop;
413    property OnDragOver;
414    property OnDrawItem;
415    property OnEndDrag;
416    property OnEnter;
417    property OnExit;
418    property OnKeyPress;
419    property OnKeyDown;
420    property OnKeyUp;
421    property OnMouseDown;
422    property OnMouseEnter;
423    property OnMouseLeave;
424    property OnMouseMove;
425    property OnMouseUp;
426    property OnMouseWheel;
427    property OnMouseWheelDown;
428    property OnMouseWheelUp;
429    property OnResize;
430    property OnStartDrag;
431    property OnUTF8KeyPress;
432    property Options;
433    property ParentBiDiMode;
434    property ParentDoubleBuffered;
435    property ParentShowHint;
436    property PopupMenu;
437    property ReadOnly;
438    property ShowHint;
439    property Sorted;
440    property Style;
441    property TabOrder;
442    property TabStop;
443    property TopIndex;
444    property Visible;
445  end;
446
447
448  { TDBLookupListBox }
449
450  TDBLookupListBox = class(TCustomDBListBox)
451  private
452    FLookup: TDBLookup;
453    FScrollListDataset: Boolean;
454    procedure ActiveChange(Sender: TObject);
455    function GetKeyField: string;
456    function GetKeyValue: Variant;
457    function GetListField: string;
458    function GetListFieldIndex: Integer;
459    function GetListSource: TDataSource;
460    function GetLookupCache: boolean;
461    function GetNullValueKey: TShortCut;
462    procedure SetKeyField(const Value: string);
463    procedure SetKeyValue(const AValue: Variant);
464    procedure SetListField(const Value: string);
465    procedure SetListFieldIndex(const Value: Integer);
466    procedure SetListSource(const Value: TDataSource);
467    procedure SetLookupCache(const Value: boolean);
468    procedure SetNullValueKey(const AValue: TShortCut);
469    procedure UpdateLookup;
470  protected
471    procedure DataChange(Sender: TObject); override;
472    procedure DoSelectionChange(User: Boolean); override;
473    procedure InitializeWnd; override;
474    procedure DestroyWnd; override;
475    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
476    procedure Loaded; override;
477    procedure UpdateData(Sender: TObject); override;
478    function IsUnbound: boolean;
479  public
480    constructor Create(AOwner: TComponent); override;
481    property KeyValue: Variant read GetKeyValue write SetKeyValue;
482  published
483    property Align;
484    property Anchors;
485    property BiDiMode;
486    property BorderSpacing;
487    property BorderStyle;
488    property Color;
489    property Constraints;
490    property DataField;
491    property DataSource;
492    property DoubleBuffered;
493    property DragCursor;
494    property DragKind;
495    property DragMode;
496//    property ExtendedSelect;
497//    property ItemHeight;
498    property Enabled;
499    property Font;
500    property KeyField: string read GetKeyField write SetKeyField;
501    property ListField: string read GetListField write SetListField;
502    property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
503    property ListSource: TDataSource read GetListSource write SetListSource;
504    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
505    property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
506//    property MultiSelect;
507    property OnClick;
508    property OnContextPopup;
509    property OnDblClick;
510    property OnDragDrop;
511    property OnDragOver;
512//    property OnDrawItem;
513    property OnEditingDone;
514    property OnEndDrag;
515    property OnEnter;
516    property OnExit;
517    property OnKeyPress;
518    property OnKeyDown;
519    property OnKeyUp;
520    property OnMouseDown;
521    property OnMouseEnter;
522    property OnMouseLeave;
523    property OnMouseMove;
524    property OnMouseUp;
525    property OnMouseWheel;
526    property OnMouseWheelDown;
527    property OnMouseWheelUp;
528    property OnResize;
529    property OnStartDrag;
530    property OnUTF8KeyPress;
531    property Options;
532    property ParentBiDiMode;
533    property ParentDoubleBuffered;
534    property ParentShowHint;
535    property PopupMenu;
536    property ReadOnly;
537    property ScrollListDataset: Boolean read FScrollListDataset write FScrollListDataset default False;
538    property ShowHint;
539    property Sorted;
540//    property Style;
541    property TabOrder;
542    property TabStop;
543    property TopIndex;
544    property Visible;
545  end;
546
547
548  { TDBRadioGroup }
549
550  TDBRadioGroup = class(TCustomRadioGroup)
551  private
552    FDataLink: TFieldDataLink;
553    FOnChange: TNotifyEvent;
554    FValue: string;
555    FValues: TStrings;
556    FInSetValue: boolean;
557    function GetDataField: string;
558    function GetDataSource: TDataSource;
559    function GetField: TField;
560    function GetReadOnly: Boolean;
561    procedure SetDataField(const AValue: string);
562    procedure SetDataSource(const AValue: TDataSource);
563    procedure SetItems(const AValue: TStrings);
564    procedure SetReadOnly(const AValue: Boolean);
565    procedure SetValue(const AValue: string);
566    procedure SetValues(const AValue: TStrings);
567    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
568  protected
569    procedure Change; virtual;
570    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
571    procedure DataChange(Sender: TObject);
572    procedure UpdateData(Sender: TObject);
573    property DataLink: TFieldDataLink read FDataLink;
574    function GetButtonValue(Index: Integer): string;
575    procedure UpdateRadioButtonStates; override;
576  public
577    constructor Create(TheOwner: TComponent); override;
578    destructor Destroy; override;
579    procedure EditingDone; override;
580    function ExecuteAction(AAction: TBasicAction): Boolean; override;
581    function UpdateAction(AAction: TBasicAction): Boolean; override;
582    property Field: TField read GetField;
583    property ItemIndex;
584    property Value: string read FValue write SetValue;
585  published
586    property Align;
587    property Anchors;
588    property AutoFill;
589    property AutoSize;
590    property BiDiMode;
591    property BorderSpacing;
592    property Caption;
593    property ChildSizing;
594    property Color;
595    property ColumnLayout;
596    property Columns;
597    property Constraints;
598    property DataField: string read GetDataField write SetDataField;
599    property DataSource: TDataSource read GetDataSource write SetDataSource;
600    property DoubleBuffered;
601    property DragCursor;
602    property DragMode;
603    property Enabled;
604    property Font;
605    property Items write SetItems;
606    property OnChange: TNotifyEvent read FOnChange write FOnChange;
607    property OnChangeBounds;
608    property OnClick;
609    property OnContextPopup;
610    property OnDragDrop;
611    property OnDragOver;
612    property OnEndDrag;
613    property OnMouseDown;
614    property OnMouseEnter;
615    property OnMouseLeave;
616    property OnMouseMove;
617    property OnMouseUp;
618    property OnMouseWheel;
619    property OnMouseWheelDown;
620    property OnMouseWheelUp;
621    property OnResize;
622    property OnStartDrag;
623    property ParentBiDiMode;
624    property ParentColor;
625    property ParentDoubleBuffered;
626    property ParentFont;
627    property ParentShowHint;
628    property PopupMenu;
629    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
630    property ShowHint;
631    property TabOrder;
632    property TabStop;
633    property Values: TStrings read FValues write SetValues;
634    property Visible;
635  end;
636
637
638  { TDBCheckBox }
639
640  TDBCheckBox = class(TCustomCheckBox)
641  private
642    FDataLink: TFieldDataLink;
643    FValueChecked: string;
644    FValueUnchecked: string;
645    function GetDataField: string;
646    function GetDataSource: TDataSource;
647    function GetField: TField;
648    function GetReadOnly: Boolean;
649    procedure SetDataField(const AValue: string);
650    procedure SetDataSource(const AValue: TDataSource);
651    procedure SetReadOnly(const AValue: Boolean);
652    procedure SetValueChecked(const AValue: string);
653    procedure SetValueUnchecked(const AValue: string);
654    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
655  protected
656    function GetFieldCheckState: TCheckBoxState; virtual;
657    procedure DataChange(Sender: TObject);
658    procedure DoOnChange; override;
659    procedure UpdateData(Sender: TObject);
660    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
661  public
662    constructor Create(TheOwner: TComponent); override;
663    destructor Destroy; override;
664    function ExecuteAction(AAction: TBasicAction): Boolean; override;
665    function UpdateAction(AAction: TBasicAction): Boolean; override;
666    property Checked;
667    property Field: TField read GetField;
668    property State;
669  published
670    property Action;
671    property Align;
672    property Alignment;
673    property AllowGrayed;
674    property Anchors;
675    property AutoSize;
676    property BiDiMode;
677    property BorderSpacing;
678    property Caption;
679    property Color;
680    property DataField: string read GetDataField write SetDataField;
681    property DataSource: TDataSource read GetDataSource write SetDataSource;
682    property DoubleBuffered;
683    property DragCursor;
684    property DragKind;
685    property DragMode;
686    property Enabled;
687    property Font;
688    property Hint;
689    property OnChange;
690    property OnClick;
691    property OnContextPopup;
692    property OnDragDrop;
693    property OnDragOver;
694    property OnEndDrag;
695    property OnEnter;
696    property OnExit;
697    property OnMouseDown;
698    property OnMouseEnter;
699    property OnMouseLeave;
700    property OnMouseMove;
701    property OnMouseUp;
702    property OnMouseWheel;
703    property OnMouseWheelDown;
704    property OnMouseWheelUp;
705    property OnStartDrag;
706    property ParentBiDiMode;
707    property ParentColor;
708    property ParentDoubleBuffered;
709    property ParentFont;
710    property ParentShowHint;
711    property PopupMenu;
712    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
713    property ShowHint;
714    property TabOrder;
715    property TabStop;
716    property ValueChecked: string read FValueChecked write SetValueChecked;
717    property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked;
718    property Visible;
719  end;
720
721
722  { TCustomDBComboBox }
723
724  TCustomDBComboBox = class(TCustomComboBox)
725  private
726    FDataLink: TFieldDataLink;
727    FDetectedEvents: Word;
728    function GetDataField: string;
729    function GetDataSource: TDataSource;
730    function GetField: TField;
731    function GetReadOnly: Boolean;
732    procedure SetDataField(const AValue: string);
733    procedure SetDataSource(const AValue: TDataSource);
734    procedure SetReadOnly(const AValue: Boolean);
735    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
736  protected
737    function DoEdit: boolean; virtual;
738    procedure DoOnCloseUp; virtual;
739    procedure DoOnSelect; virtual;
740    procedure LMDeferredEdit(var Message: TLMessage); message LM_DEFERREDEDIT;
741    property DetectedEvents: Word read FDetectedEvents;
742  protected
743    procedure CloseUp; override;
744    Procedure Select; override;
745    procedure DataChange(Sender: TObject); virtual; abstract;
746    function  DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
747    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
748    procedure Change; override;
749    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
750    procedure UpdateData(Sender: TObject); virtual; abstract;
751    procedure UpdateRecord;
752    procedure WndProc(var Message: TLMessage); override;
753  public
754    constructor Create(TheOwner: TComponent); override;
755    destructor Destroy; override;
756    function ExecuteAction(AAction: TBasicAction): Boolean; override;
757    function UpdateAction(AAction: TBasicAction): Boolean; override;
758    procedure EditingDone; override;
759    property Field: TField read GetField;
760    property Text;
761    property ItemIndex;
762    property DataField: string read GetDataField write SetDataField;
763    property DataSource: TDataSource read GetDataSource write SetDataSource;
764    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
765  end;
766
767
768  { TDBComboBox }
769
770  TDBComboBox = class(TCustomDBComboBox)
771  protected
772    procedure DataChange(Sender: TObject); override;
773    procedure KeyPress(var Key: char); override;
774    procedure UpdateData(Sender: TObject); override;
775  published
776    property Align;
777    property Anchors;
778    property ArrowKeysTraverseList;
779    property AutoComplete;
780    property AutoCompleteText;
781    property AutoDropDown;
782    property AutoSelect;
783    property AutoSize;
784    property BiDiMode;
785    property BorderSpacing;
786    property BorderStyle;
787    property CharCase;
788    property Color;
789    property DataField;
790    property DataSource;
791    property DoubleBuffered;
792    property DragCursor;
793    property DragKind;
794    property DragMode;
795    property DropDownCount;
796    property Enabled;
797    property Font;
798    property ItemHeight;
799    property Items;
800    property ItemWidth;
801    property MaxLength default -1;
802    property OnChange;
803    property OnChangeBounds;
804    property OnClick;
805    property OnCloseUp;
806    property OnContextPopup;
807    property OnDblClick;
808    property OnDragDrop;
809    property OnDragOver;
810    property OnDrawItem;
811    property OnDropDown;
812    property OnEditingDone;
813    property OnEndDrag;
814    property OnEnter;
815    property OnExit;
816    property OnKeyDown;
817    property OnKeyPress;
818    property OnKeyUp;
819    property OnMouseDown;
820    property OnMouseEnter;
821    property OnMouseLeave;
822    property OnMouseMove;
823    property OnMouseUp;
824    property OnMouseWheel;
825    property OnMouseWheelDown;
826    property OnMouseWheelUp;
827    property OnSelect;
828    property OnStartDrag;
829    property OnUTF8KeyPress;
830    property ParentBiDiMode;
831    property ParentColor;
832    property ParentDoubleBuffered;
833    property ParentFont;
834    property ParentShowHint;
835    property PopupMenu;
836    property ReadOnly;
837    property ShowHint;
838    property Sorted;
839    property Style;
840    property TabOrder;
841    property TabStop;
842    property Visible;
843  end;
844
845
846  { TDBLookupComboBox }
847
848  TDBLookupComboBox = class(TCustomDBComboBox)
849  protected
850    function DoEdit: boolean; override;
851    function IsUnbound: boolean;
852  private
853    FLookup: TDBLookup;
854    FScrollListDataset: Boolean;
855    procedure ActiveChange(Sender: TObject);
856    function GetKeyField: string;
857    function GetKeyValue: variant;
858    function GetListField: string;
859    function GetListFieldIndex: Integer;
860    function GetListSource: TDataSource;
861    function GetLookupCache: boolean;
862    function GetNullValueKey: TShortCut;
863    procedure SetKeyField(const Value: string);
864    procedure SetKeyValue(const AValue: variant);
865    procedure SetListField(const Value: string);
866    procedure SetListFieldIndex(const Value: Integer);
867    procedure SetListSource(const Value: TDataSource);
868    procedure SetLookupCache(const Value: boolean);
869    procedure SetNullValueKey(const AValue: TShortCut);
870    procedure UpdateLookup;
871    procedure UpdateItemIndex;
872  protected
873    procedure InitializeWnd; override;
874    procedure DestroyWnd; override;
875    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
876    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
877    procedure Loaded; override;
878    procedure UpdateData(Sender: TObject); override;
879    procedure DataChange(Sender: TObject); override;
880    procedure DoOnSelect; override;
881  public
882    constructor Create(AOwner: TComponent); override;
883    property KeyValue: variant read GetKeyValue write SetKeyValue;
884  published
885    property Align;
886    property Anchors;
887    property ArrowKeysTraverseList;
888    property AutoComplete;
889    //property AutoCompleteText;
890    property AutoDropDown;
891    property AutoSelect;
892    property AutoSize;
893    property BiDiMode;
894    property BorderSpacing;
895    property BorderStyle;
896    property CharCase;
897    property Color;
898    property Constraints;
899    property DataField;
900    property DataSource;
901    property DoubleBuffered;
902    property DragCursor;
903    property DragKind;
904    property DragMode;
905    property DropDownCount;
906    property Enabled;
907    property Font;
908//    property ItemHeight;
909//    property ItemWidth;
910    property KeyField: string read GetKeyField write SetKeyField;
911    property ListField: string read GetListField write SetListField;
912    property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
913    property ListSource: TDataSource read GetListSource write SetListSource;
914    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
915//    property MaxLength default -1;
916    property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
917    property OnChange;
918    property OnChangeBounds;
919    property OnClick;
920    property OnCloseUp;
921    property OnContextPopup;
922    property OnDblClick;
923    property OnDragDrop;
924    property OnDragOver;
925    property OnDrawItem;
926    property OnDropDown;
927    property OnEditingDone;
928    property OnEndDrag;
929    property OnEnter;
930    property OnExit;
931    property OnKeyDown;
932    property OnKeyPress;
933    property OnKeyUp;
934    property OnMouseDown;
935    property OnMouseEnter;
936    property OnMouseLeave;
937    property OnMouseMove;
938    property OnMouseUp;
939    property OnMouseWheel;
940    property OnMouseWheelDown;
941    property OnMouseWheelUp;
942    property OnSelect;
943    property OnStartDrag;
944    property OnUTF8KeyPress;
945    property ParentBiDiMode;
946    property ParentColor;
947    property ParentDoubleBuffered;
948    property ParentFont;
949    property ParentShowHint;
950    property PopupMenu;
951    property ReadOnly;
952    property ScrollListDataset: Boolean read FScrollListDataset write FScrollListDataset default False;
953    property ShowHint;
954    property Sorted;
955    property Style;
956    property TabOrder;
957    property TabStop;
958    property Visible;
959  end;
960
961  { TDBMemo }
962
963  TDBMemo = class(TCustomMemo)
964  private
965    FDataLink: TFieldDataLink;
966    FAutoDisplay: Boolean;
967    FDBMemoFocused: Boolean;
968    FDBMemoLoaded: Boolean;
969    function GetDataField: string;
970    function GetDataSource: TDataSource;
971    function GetField: TField;
972    procedure SetAutoDisplay(const AValue: Boolean);
973    procedure SetDataField(const AValue: string);
974    procedure SetDataSource(const AValue: TDataSource);
975    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
976  protected
977    function GetReadOnly: Boolean; override;
978    procedure SetReadOnly(AValue: Boolean); override;
979    procedure DataChange(Sender: TObject);
980    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
981    procedure UpdateData(Sender: TObject);
982    procedure Change; override;
983    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
984    procedure KeyPress(var Key:Char); override;
985    procedure WndProc(var Message : TLMessage); override;
986    class procedure WSRegisterClass; override;
987  public
988    constructor Create(TheOwner: TComponent); override;
989    destructor Destroy; override;
990    procedure EditingDone; override;
991    procedure LoadMemo; virtual;
992    function ExecuteAction(AAction: TBasicAction): Boolean; override;
993    function UpdateAction(AAction: TBasicAction): Boolean; override;
994    property Field: TField read GetField;
995  published
996    property Align;
997    property Alignment;
998    property Anchors;
999    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
1000    property BiDiMode;
1001    property BorderSpacing;
1002    property BorderStyle;
1003    property CharCase;
1004    property Color;
1005    property Constraints;
1006    property DataField: string read GetDataField write SetDataField;
1007    property DataSource: TDataSource read GetDataSource write SetDataSource;
1008    property DoubleBuffered;
1009    property DragCursor;
1010    property DragKind;
1011    property DragMode;
1012    property Enabled;
1013    property Font;
1014    property MaxLength;
1015    property OnChange;
1016    property OnClick;
1017    property OnContextPopup;
1018    property OnDblClick;
1019    property OnDragDrop;
1020    property OnDragOver;
1021    property OnEditingDone;
1022    property OnEndDrag;
1023    property OnEnter;
1024    property OnExit;
1025    property OnKeyDown;
1026    property OnKeyPress;
1027    property OnKeyUp;
1028    property OnMouseDown;
1029    property OnMouseEnter;
1030    property OnMouseLeave;
1031    property OnMouseMove;
1032    property OnMouseUp;
1033    property OnMouseWheel;
1034    property OnMouseWheelDown;
1035    property OnMouseWheelUp;
1036    property OnResize;
1037    property OnStartDrag;
1038    property OnUTF8KeyPress;
1039    property ParentBiDiMode;
1040    property ParentDoubleBuffered;
1041    property ParentFont;
1042    property ParentShowHint;
1043    property PopupMenu;
1044    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
1045    property ScrollBars;
1046    property ShowHint;
1047    property TabOrder;
1048    property Tabstop;
1049    property Visible;
1050    property WantReturns;
1051    property WantTabs;
1052    property WordWrap;
1053  end;
1054
1055
1056  { TDBGroupBox }
1057
1058  TDBGroupBox = class(TCustomGroupBox)
1059  private
1060    FDataLink: TFieldDataLink;
1061    function GetDataField: string;
1062    function GetDataSource: TDataSource;
1063    function GetField: TField;
1064    procedure SetDataField(const AValue: string);
1065    procedure SetDataSource(const AValue: TDataSource);
1066    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
1067  protected
1068    procedure DataChange(Sender: TObject);
1069    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1070  public
1071    constructor Create(TheOwner: TComponent); override;
1072    destructor Destroy; override;
1073    function ExecuteAction(AAction: TBasicAction): Boolean; override;
1074    function UpdateAction(AAction: TBasicAction): Boolean; override;
1075    property Field: TField read GetField;
1076  published
1077    property Align;
1078    property Anchors;
1079    property BiDiMode;
1080    property BorderSpacing;
1081    property Caption;
1082    property ClientHeight;
1083    property ClientWidth;
1084    property Color;
1085    property Constraints;
1086    property Cursor;
1087    property DataField: string read GetDataField write SetDataField;
1088    property DataSource: TDataSource read GetDataSource write SetDataSource;
1089    property DoubleBuffered;
1090    property DragCursor;
1091    property DragKind;
1092    property DragMode;
1093    property Enabled;
1094    property Font;
1095    property OnClick;
1096    property OnContextPopup;
1097    property OnDblClick;
1098    property OnDragDrop;
1099    property OnDragOver;
1100    property OnEndDrag;
1101    property OnEnter;
1102    property OnExit;
1103    property OnKeyDown;
1104    property OnKeyPress;
1105    property OnKeyUp;
1106    property OnMouseDown;
1107    property OnMouseEnter;
1108    property OnMouseLeave;
1109    property OnMouseMove;
1110    property OnMouseUp;
1111    property OnMouseWheel;
1112    property OnMouseWheelDown;
1113    property OnMouseWheelUp;
1114    property OnResize;
1115    property OnStartDrag;
1116    property OnUTF8KeyPress;
1117    property ParentBiDiMode;
1118    property ParentColor;
1119    property ParentDoubleBuffered;
1120    property ParentFont;
1121    property ParentShowHint;
1122    property PopupMenu;
1123    property ShowHint;
1124    property TabOrder;
1125    property TabStop;
1126    property Visible;
1127  end;
1128
1129
1130  { TDBImage }
1131
1132  TOnDBImageRead = procedure(Sender: TObject; S: TStream; var GraphExt : string) of object;
1133  TOnDBImageWrite = procedure(Sender: TObject; S: TStream; GraphExt : string) of object;
1134
1135  TDBImage = class(TCustomImage)
1136  private
1137    FDataLink: TFieldDataLink;
1138    FAutoDisplay: Boolean;
1139    FOnDBImageRead: TOnDBImageRead;
1140    FOnDBImageWrite: TOnDBImageWrite;
1141    FQuickDraw: Boolean;
1142    FPictureLoaded: boolean;
1143    FUpdatingRecord: boolean;
1144    FWriteHeader: Boolean;
1145    function GetDataField: string;
1146    function GetDataSource: TDataSource;
1147    function GetField: TField;
1148    function GetReadOnly: Boolean;
1149    procedure SetAutoDisplay(const AValue: Boolean);
1150    procedure SetDataField(const AValue: string);
1151    procedure SetDataSource(const AValue: TDataSource);
1152    procedure SetReadOnly(const AValue: Boolean);
1153    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
1154  protected
1155    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1156    procedure DataChange(Sender: TObject);
1157    procedure UpdateData(Sender: TObject); virtual;
1158    procedure PictureChanged(Sender: TObject); override;
1159    class procedure WSRegisterClass; override;
1160    procedure DoCopyToClipboard;
1161  public
1162    constructor Create(TheOwner: TComponent); override;
1163    destructor Destroy; override;
1164    function ExecuteAction(AAction: TBasicAction): Boolean; override;
1165    function UpdateAction(AAction: TBasicAction): Boolean; override;
1166    property Field: TField read GetField;
1167    procedure Change; virtual;
1168
1169    procedure LoadPicture; virtual;
1170    procedure CopyToClipboard;
1171    procedure CutToClipboard;
1172    procedure PasteFromClipboard;
1173    property PictureLoaded : boolean read FPictureLoaded;
1174  published
1175    property Align;
1176    property Anchors;
1177    property AntialiasingMode;
1178    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
1179    property AutoSize;
1180    property BorderSpacing;
1181    property Center;
1182    property Constraints;
1183    property DataField: string read GetDataField write SetDataField;
1184    property DataSource: TDataSource read GetDataSource write SetDataSource;
1185    property DragCursor;
1186    property DragKind;
1187    property DragMode;
1188    property KeepOriginXWhenClipped;
1189    property KeepOriginYWhenClipped;
1190    property OnClick;
1191    property OnContextPopup;
1192    property OnDblClick;
1193    property OnDBImageRead: TOnDBImageRead read  FOnDBImageRead write FOnDBImageRead;
1194    property OnDBImageWrite: TOnDBImageWrite read FOnDBImageWrite write FOnDBImageWrite;
1195    property PopupMenu;
1196    property OnDragDrop;
1197    property OnDragOver;
1198    property OnEndDrag;
1199    property OnMouseDown;
1200    property OnMouseEnter;
1201    property OnMouseLeave;
1202    property OnMouseMove;
1203    property OnMouseUp;
1204    property OnMouseWheel;
1205    property OnMouseWheelDown;
1206    property OnMouseWheelUp;
1207    property OnResize;
1208    property OnStartDrag;
1209    property ParentShowHint;
1210    property Proportional;
1211    property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
1212    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
1213    property ShowHint;
1214    property Stretch;
1215    property StretchInEnabled;
1216    property StretchOutEnabled;
1217    property Transparent;
1218    property Visible;
1219    property WriteHeader: Boolean read FWriteHeader write FWriteHeader default True;
1220  end;
1221
1222  { TDBCalendar }
1223
1224  TDBCalendar = class(TCalendar)
1225  private
1226    FDataLink: TFieldDataLink;
1227
1228    procedure DataChange(Sender: TObject);
1229    procedure UpdateData(Sender: TObject);
1230    function GetDataField: string;
1231    function GetDataSource: TDataSource;
1232    function GetField: TField;
1233
1234    function GetReadOnly: Boolean;
1235    procedure SetReadOnly(Value: Boolean);
1236
1237    procedure SetDate(const AValue: String);
1238
1239    procedure SetDataField(const Value: string);
1240    procedure SetDataSource(Value: TDataSource);
1241    procedure UpdateDate(const AValue: string);
1242    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
1243  protected
1244    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1245  public
1246    constructor Create(TheOwner: TComponent); override;
1247    destructor Destroy; override;
1248    procedure EditingDone; override;
1249    function ExecuteAction(AAction: TBasicAction): Boolean; override;
1250    function UpdateAction(AAction: TBasicAction): Boolean; override;
1251
1252    property Field: TField read GetField;
1253  published
1254    property BorderSpacing;
1255    property DataField: string read GetDataField write SetDataField;
1256    property DataSource: TDataSource read GetDataSource write SetDataSource;
1257
1258    Property Date write SetDate stored False;
1259    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
1260
1261    property DisplaySettings stored False;
1262    property DoubleBuffered;
1263    property DragCursor;
1264    property DragMode;
1265    property ParentDoubleBuffered;
1266    property Visible;
1267    property OnClick;
1268    property OnContextPopup;
1269    property OnDragDrop;
1270    property OnDragOver;
1271    property OnEndDrag;
1272    property OnMouseMove;
1273    property OnMouseDown;
1274    property OnDayChanged;
1275    property OnMonthChanged;
1276    property OnStartDrag;
1277    property OnYearChanged;
1278  end;
1279
1280
1281  { TDBCustomNavigator }
1282
1283type
1284  TDBNavButton = class;
1285  TDBNavFocusableButton = class;
1286  TDBNavDataLink = class;
1287
1288  TDBNavGlyph = (ngEnabled, ngDisabled);
1289  TDBNavButtonType = (nbFirst, nbPrior, nbNext, nbLast,
1290                  nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh);
1291  TDBNavButtonSet = set of TDBNavButtonType;
1292  TDBNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
1293  TDBNavButtonDirection = (nbdHorizontal,nbdVertical);
1294  TDBNavigatorOption = (navFocusableButtons);
1295  TDBNavigatorOptions = set of TDBNavigatorOption;
1296
1297  // for Delphi compatibility
1298  TNavigateBtn = TDBNavButtonType;
1299
1300  TDBNavClickEvent = procedure(Sender: TObject;
1301                                Button: TDBNavButtonType) of object;
1302
1303const
1304  DefaultDBNavigatorButtons = [nbFirst, nbPrior, nbNext, nbLast,
1305    nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
1306  DBNavButtonResourceName: array[TDBNavButtonType] of string = (
1307 { nbFirst   } 'DBNavFirst',
1308 { nbPrior   } 'DBNavPrior',
1309 { nbNext    } 'DBNavNext',
1310 { nbLast    } 'DBNavLast',
1311 { nbInsert  } 'DBNavInsert',
1312 { nbDelete  } 'DBNavDelete',
1313 { nbEdit    } 'DBNavEdit',
1314 { nbPost    } 'DBNavPost',
1315 { nbCancel  } 'DBNavCancel',
1316 { nbRefresh } 'DBNavRefresh'
1317    );
1318
1319type
1320
1321  { TDBCustomNavigator }
1322
1323  TDBCustomNavigator = class(TCustomPanel)
1324  private
1325    FBeforeAction: TDBNavClickEvent;
1326    FDataLink: TDBNavDataLink;
1327    FDirection: TDBNavButtonDirection;
1328    FOnNavClick: TDBNavClickEvent;
1329    FVisibleButtons: TDBNavButtonSet;
1330    FDefaultHints: TStrings;
1331    FHints: TStrings;
1332    FUpdateButtonsLock: integer;
1333    FOriginalHints: String;
1334    FOptions: TDBNavigatorOptions;
1335    FFlat: Boolean;
1336    FConfirmDelete: Boolean;
1337    FUpdateButtonsNeeded: boolean;
1338    FShowButtonHints: boolean;
1339    FImages: TCustomImageList;
1340    FImageChangeLink: TChangeLink;
1341    procedure DefaultHintsChanged(Sender: TObject);
1342    function GetDataSource: TDataSource;
1343    function GetHints: TStrings;
1344    procedure SetDataSource(const AValue: TDataSource);
1345    procedure SetDirection(const AValue: TDBNavButtonDirection);
1346    procedure SetFlat(const AValue: Boolean);
1347    procedure SetHints(const AValue: TStrings);
1348    procedure SetImages(AValue: TCustomImageList);
1349    procedure SetOptions(AValue: TDBNavigatorOptions);
1350    procedure SetShowButtonHints(const AValue: boolean);
1351    procedure SetVisibleButtons(const AValue: TDBNavButtonSet);
1352    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
1353    procedure ImageListChange(Sender: TObject);
1354  protected
1355    Buttons: array[TDBNavButtonType] of TDBNavButton;
1356    FocusableButtons: array[TDBNavButtonType] of TDBNavFocusableButton;
1357    procedure DataChanged; virtual;
1358    procedure EditingChanged; virtual;
1359    procedure ActiveChanged; virtual;
1360    procedure Loaded; override;
1361    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1362    procedure UpdateButtons; virtual;
1363    procedure UpdateHints; virtual;
1364    procedure HintsChanged(Sender: TObject); virtual;
1365    procedure ButtonClickHandler(Sender: TObject); virtual;
1366    class function GetControlClassDefaultSize: TSize; override;
1367    procedure BeginUpdateButtons; virtual;
1368    procedure EndUpdateButtons; virtual;
1369    procedure SetEnabled(Value: Boolean); override;
1370  public
1371    constructor Create(TheOwner: TComponent); override;
1372    destructor Destroy; override;
1373    procedure BtnClick(Index: TNavigateBtn); virtual;
1374    function VisibleButtonCount: integer; virtual;
1375  public
1376    property BeforeAction: TDBNavClickEvent read FBeforeAction write FBeforeAction;
1377    property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
1378    property DataSource: TDataSource read GetDataSource write SetDataSource;
1379    property Direction: TDBNavButtonDirection read FDirection write SetDirection default nbdHorizontal;
1380    property Flat: Boolean read FFlat write SetFlat default False;
1381    property Hints: TStrings read GetHints write SetHints;
1382    property Options: TDBNavigatorOptions read FOptions write SetOptions;
1383    property OnClick: TDBNavClickEvent read FOnNavClick write FOnNavClick;
1384    property VisibleButtons: TDBNavButtonSet read FVisibleButtons
1385                             write SetVisibleButtons default DefaultDBNavigatorButtons;
1386    property ShowButtonHints: boolean read FShowButtonHints write SetShowButtonHints default true;
1387    property Images: TCustomImageList read FImages write SetImages;
1388  end;
1389
1390
1391  { TDBNavButton }
1392
1393  TDBNavButton = class(TSpeedButton)
1394  private
1395    FIndex: TDBNavButtonType;
1396    FNavStyle: TDBNavButtonStyle;
1397  protected
1398  public
1399    destructor Destroy; override;
1400    property NavStyle: TDBNavButtonStyle read FNavStyle write FNavStyle;
1401    property Index: TDBNavButtonType read FIndex write FIndex;
1402  end;
1403
1404  { TDBNavFocusableButton }
1405
1406  TDBNavFocusableButton = class(TBitBtn)
1407  private
1408    FIndex: TDBNavButtonType;
1409    FNavStyle: TDBNavButtonStyle;
1410  public
1411    property NavStyle: TDBNavButtonStyle read FNavStyle write FNavStyle;
1412    property Index: TDBNavButtonType read FIndex write FIndex;
1413  end;
1414
1415  { TNavDataLink }
1416
1417  TDBNavDataLink = class(TDataLink)
1418  private
1419    FNavigator: TDBCustomNavigator;
1420  protected
1421    procedure EditingChanged; override;
1422    procedure DataSetChanged; override;
1423    procedure ActiveChanged; override;
1424  public
1425    constructor Create(TheNavigator: TDBCustomNavigator);
1426  end;
1427
1428
1429  { TDBNavigator }
1430
1431  TDBNavigator = class(TDBCustomNavigator)
1432  published
1433    property Align default alNone;
1434    property Alignment;
1435    property Anchors;
1436    property AutoSize;
1437    property BidiMode;
1438    property BeforeAction;
1439    property BevelInner;
1440    property BevelOuter;
1441    property BevelWidth;
1442    property BorderSpacing;
1443    property BorderStyle;
1444    property BorderWidth;
1445    property Caption;
1446    property ChildSizing;
1447    property ClientHeight;
1448    property ClientWidth;
1449    property Color default clBackground;
1450    property ConfirmDelete;
1451    property DataSource;
1452    property Direction;
1453    property DoubleBuffered;
1454    property DragCursor;
1455    property DragMode;
1456    property Enabled;
1457    property Flat;
1458    property Font;
1459    property Hints;
1460    property OnClick;
1461    property OnContextPopup;
1462    property OnDblClick;
1463    property OnDragDrop;
1464    property OnDragOver;
1465    property OnEndDrag;
1466    property OnEnter;
1467    property OnExit;
1468    property OnMouseDown;
1469    property OnMouseEnter;
1470    property OnMouseLeave;
1471    property OnMouseMove;
1472    property OnMouseUp;
1473    property OnMouseWheel;
1474    property OnMouseWheelDown;
1475    property OnMouseWheelUp;
1476    property OnResize;
1477    property OnStartDrag;
1478    property Options;
1479    property ParentBidiMode;
1480    property ParentColor;
1481    property ParentDoubleBuffered;
1482    property ParentFont;
1483    property ParentShowHint;
1484    property PopupMenu;
1485    property ShowHint;
1486    property TabOrder;
1487    property TabStop default False;
1488    property Visible;
1489    property VisibleButtons;
1490    property Images;
1491  end;
1492
1493procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
1494  NewDataSource: TDataSource);
1495
1496procedure Register;
1497
1498implementation
1499
1500{$R lcl_dbnav_images.res}
1501
1502uses
1503  InterfaceBase, Clipbrd;
1504
1505var
1506  FieldClasses: TFpList;
1507
1508procedure RegField(const FieldClass: TFieldClass);
1509begin
1510  if FieldClasses = nil then FieldClasses := TFpList.Create;
1511  if (FieldClass <> Nil) And (FieldClasses.IndexOf(FieldClass) = -1) then
1512  begin
1513    FieldClasses.Add(FieldClass);
1514    RegisterNoIcon([FieldClass]);
1515    RegisterClass(FieldClass);
1516  end;
1517end;
1518
1519procedure RegFields(const AFieldClasses: array of TFieldClass);
1520var I: Integer;
1521begin
1522  for I := Low(AFieldClasses) to High(AFieldClasses) do
1523    RegField(AFieldClasses[I]);
1524end;
1525
1526procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
1527  NewDataSource: TDataSource);
1528begin
1529  if Link.DataSource=NewDataSource then exit;
1530  if Link.DataSource<>nil then
1531    Link.DataSource.RemoveFreeNotification(AControl);
1532  Link.DataSource:=NewDataSource;
1533  if Link.DataSource<>nil then
1534    Link.DataSource.FreeNotification(AControl);
1535end;
1536
1537function FieldIsEditable(Field: TField): boolean;
1538begin
1539  result := (Field<>nil) and (not Field.Calculated) and
1540            (Field.DataType<>ftAutoInc) and (Field.FieldKind<>fkLookup)
1541end;
1542
1543function FieldCanAcceptKey(Field: TField; AKey: char): boolean;
1544begin
1545  Result := FieldIsEditable(Field) and Field.IsValidChar(AKey);
1546end;
1547
1548procedure Register;
1549begin
1550  RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
1551    TDBImage,TDBListBox,TDBLookupListBox,TDBComboBox,TDBLookupComboBox,
1552    TDBCheckBox, TDBRadioGroup, TDBCalendar,TDBGroupBox]);
1553  RegFields(DefaultFieldClasses);
1554  RegField(TIntegerField);
1555end;
1556
1557function TFieldDataLink.FieldCanModify: boolean;
1558var
1559  FieldList: TList;
1560  i: Integer;
1561begin
1562  result := Assigned(FField);
1563  if not result then
1564    exit;
1565
1566  if FField.FieldKind=fkLookup then
1567  begin
1568    FieldList := TList.Create;
1569    try
1570      DataSet.GetFieldList(FieldList, FField.KeyFields);
1571      result := (FieldList.Count>0);
1572      i := 0;
1573      while result and (i<FieldList.Count) do
1574      begin
1575        result := TField(FieldList[i]).CanModify;
1576        inc(i);
1577      end;
1578    finally
1579      FieldList.Free;
1580    end;
1581  end else
1582    result := FField.CanModify;
1583end;
1584
1585function TFieldDataLink.IsKeyField(aField: TField): Boolean;
1586var
1587  KeyFieldName, KeyFields: String;
1588  StrPos: Integer;
1589begin
1590  KeyFields := FField.KeyFields;
1591  StrPos := 1;
1592  while StrPos <= Length(KeyFields) do
1593  begin
1594    KeyFieldName := ExtractFieldName(KeyFields, StrPos);
1595    if SameText(aField.FieldName, KeyFieldName) then
1596    begin
1597      Result := True;
1598      Exit;
1599    end;
1600  end;
1601  Result := False;
1602end;
1603
1604{TFieldDataLink  Private Methods}
1605{
1606  If the field exists and can be modified, then
1607  we CanModify as long as this hasn't been set
1608  ReadOnly somewhere else. Do we need any extra tests here?
1609}
1610function TFieldDataLink.GetCanModify: Boolean;
1611begin
1612  if FieldCanModify then
1613    Result := not ReadOnly
1614  else
1615    Result := False;
1616end;
1617
1618{
1619  Set the FieldName and then notify the changes though EditingChanged and Reset
1620  Ensure FField is nil if something goes wrong or FieldName is empty
1621}
1622procedure TFieldDataLink.SetFieldName(const Value: string);
1623begin
1624  if FFieldName <> Value then
1625  begin
1626    FFieldName := Value;
1627    UpdateField;
1628    if Active then
1629    begin
1630      EditingChanged;
1631      Reset;
1632    end;
1633  end;
1634end;
1635
1636procedure TFieldDataLink.UpdateField;
1637begin
1638  if Active and (FFieldName <> '') then
1639    FField := DataSet.FieldByName(FFieldName)
1640  else
1641    FField := nil;
1642end;
1643
1644{
1645  This function checks if FField is still associated with the dataset
1646  If not update the field
1647}
1648procedure TFieldDataLink.ValidateField;
1649begin
1650  if not (DataSet.FindField(FFieldName) = FField) then
1651    UpdateField;
1652end;
1653
1654procedure TFieldDataLink.ResetEditingSource;
1655begin
1656  FEditingSource := false;
1657  FEditingSourceSet := false;
1658end;
1659
1660{TFieldDataLink  Protected Methods}
1661
1662{ Delphi Help ->
1663    Changes to the Active property trigger the ActiveChanged method.
1664    If an OnActiveChange event handler is assigned, ActiveChanged calls
1665    this event handler. If ActiveChanged is triggered by a transition into
1666    an active state, then before calling the event handler, ActiveChanged makes
1667    sure that the Field for this TFieldDataLink is still valid.
1668  <-- Delphi Help
1669
1670   Update the field instance. When not Active field will be set to nil
1671   Call OnActiveChange
1672}
1673procedure TFieldDataLink.ActiveChanged;
1674begin
1675  if FFieldName <> '' then
1676  begin
1677    UpdateField;
1678    EditingChanged;
1679    Reset;
1680  end;
1681  if Assigned(FOnActiveChange) then
1682    FOnActiveChange(Self);
1683end;
1684
1685{ Delphi Help ->
1686    Changing the field binding can change the validity of the CanModify
1687    property, since individual field components can disallow edits. If
1688    TFieldDataLink is in an editing state when the Field property is changed,
1689    EditingChanged checks the CanModify property. If CanModify is False, it
1690    changes back out of the editing state.
1691
1692    Note: This differs significantly from the inherited EditingChanged method
1693    of TDataLink. The functionality of the inherited method is replaced in
1694    TFieldDataLink by the OnEditingChange event handler.
1695  <-- Delphi Help
1696
1697  ok so another event... but this time we simply change modified state
1698  if Editing and not CanModify? or do we also change to match if
1699  if not Editing and CanModify? i.e If Editing <> CanModify??  Will assume
1700  the latter just in case. easy to change back if I am wrong.
1701
1702  Also based on this we replace parent routine, so do we need to keep track
1703  of Editing state ourself? I hope this is right. Anyone know for sure?
1704
1705  OK .. based on the Modified routine we need to turn off
1706  our IsModified routine when succesfull right? so for now just turn
1707  it off as per my example.
1708}
1709procedure TFieldDataLink.EditingChanged;
1710var
1711  RealEditState : Boolean;
1712begin
1713  RealEditState := (CanModify and Inherited Editing);
1714
1715  if (FEditing <> RealEditState) then
1716  begin
1717    FEditing := RealEditState;
1718    if not FEditing then
1719    begin
1720      IsModified := False;
1721      ResetEditingSource;
1722    end;
1723    if Assigned(FOnEditingChange) then
1724      FOnEditingChange(Self);
1725  end;
1726end;
1727
1728{ Delphi Help ->
1729    LayoutChanged is called after changes in the layout of one of the
1730    containers of the Control for this TFieldDataLink that might change the
1731    validity of its field binding. For example, if the Control is embedded
1732    within a TCustomDBGrid, and one of the columns is deleted, the Field
1733    property for the Control might become invalid.
1734  <-- Delphi Help
1735
1736  Ensure FField is valid and notify
1737}
1738procedure TFieldDataLink.LayoutChanged;
1739begin
1740  ValidateField;
1741  if FField <> nil then
1742  begin
1743    EditingChanged;
1744    RecordChanged(nil);
1745  end;
1746end;
1747
1748{ Delphi Help ->
1749    Applications can not call this protected method. It is triggered
1750    automatically when the contents of the current record change.
1751    RecordChanged calls the OnDataChange event handler if there is one.
1752
1753    TDataLink.RecordChanged:
1754    The Field parameter indicates which field of the current record has changed in value.
1755    If Field is nil (Delphi) or NULL (C++), any number of fields within the current record may have changed.
1756  <-- Delphi Help
1757
1758  Call Reset if AField = FField or aField = nil
1759}
1760procedure TFieldDataLink.RecordChanged(aField: TField);
1761begin
1762  if (aField = nil) or (aField = FField) or
1763   ((FField <> nil) and (FField.FieldKind = fkLookup) and IsKeyField(aField)) then
1764    Reset;
1765end;
1766
1767{ Delphi Help ->
1768    UpdateData overrides the default UpdateData method to call the
1769    OnUpdateData event handler where the data-aware control can write any
1770    pending edits to the record in the dataset.
1771  <-- Delphi Help
1772
1773  where..can write pending events. So I guess when we have already
1774  called Modified? Aka if not IsModified exit otherwise call event?
1775  works for me.
1776}
1777procedure TFieldDataLink.UpdateData;
1778begin
1779  if not IsModified then
1780    exit;
1781  try
1782    if Assigned(FOnUpdateData) then
1783      FOnUpdateData(Self);
1784  finally
1785    IsModified := False;
1786  end;
1787end;
1788
1789{ Delphi Help ->
1790    Call FocusControl to give the Control associated with this TFieldDataLink
1791    object the input focus. FocusControl checks whether the Control can receive
1792    input focus, and if so, calls its SetFocus method to move focus to the
1793    Control.
1794  <-- Delphi Help
1795
1796  Check if the field matches and if Control is TWinControl than call SetFocus
1797  Set the FieldRef to nil so no other control get focus
1798}
1799
1800procedure TFieldDataLink.FocusControl(aField: TFieldRef);
1801var
1802  WinControl: TWinControl;
1803begin
1804  if Assigned(aField) and (aField^ = FField) and (FControl is TWinControl) then
1805  begin
1806    WinControl := TWinControl(FControl);
1807    if WinControl.CanFocus then
1808    begin
1809      aField^ := nil;
1810      WinControl.SetFocus;
1811    end;
1812  end;
1813end;
1814
1815{TFieldDataLink  Public Methods}
1816
1817constructor TFieldDataLink.Create;
1818begin
1819  inherited Create;
1820  VisualControl := True;
1821  //FField := nil;
1822  //FFieldname := '';
1823end;
1824
1825{ Delphi Help ->
1826    Use Edit to try to ensure that the contents of the field can be modified.
1827    A return value of True indicates that the field was already in an editing
1828    state, or that the DataSource was successfully changed to allow editing.
1829    A return value of False indicates that the DataSource could not be changed
1830    to allow editing. For example, if the CanModify property is False, Edit
1831    fails, and returns False.
1832  <-- Delphi Help
1833
1834  ok so the way I see it, since the inherited function calls EditingChanged,
1835  which we have already overriden to modify our own Editing state if its invalid,
1836  I should just be calling the inherited routine here, but only if CanModify,
1837  since there is no point otherwise. But since we _are_ keeping track of editing
1838  state ourselves we return our own state, not the inherited. If anyone know
1839  better please fix.
1840}
1841function TFieldDataLink.Edit: Boolean;
1842var
1843  editingSrc: Boolean;
1844begin
1845  editingSrc := (not FEditing) and (Dataset<>nil) and not(Dataset.State in dsEditModes);
1846
1847  if (not FEditing) and CanModify then
1848    inherited Edit;
1849
1850  Result := FEditing;
1851
1852  if not FEditingSourceSet then
1853  begin
1854    // should be triggered one time only if editing succeeded
1855    FEditingSource := FEditing and editingSrc;
1856    FEditingSourceSet := true;
1857  end;
1858end;
1859
1860{ Delphi Help ->
1861    Call Modified when the Control for this TFieldDataLink begins processing
1862    edits.
1863  <-- Delphi Help
1864
1865  ok so. well _that's_ helpfull. for the moment going to keep track
1866  by adding an IsModified... based on the other functions thus far
1867  we need to know whether we are in state, so I am assuming it goes
1868
1869  Call Modified ->
1870    IsModified:=True;//Waiting for modifications
1871
1872  Call SomeFunction->
1873    If IsModified then begin
1874      (do something)
1875      IsModified := False;//All modifications complete
1876    end
1877    else
1878     (do something else? exit?);
1879}
1880procedure TFieldDataLink.Modified;
1881begin
1882  IsModified := True;
1883end;
1884
1885{ Delphi Help ->
1886    The Control that owns a TFieldDataLink object calls its Reset method to
1887    process a UI action that cancels edits to the field. Reset calls the
1888    OnDataChange event handler without writing any pending changes to the
1889    record in the dataset.
1890  <-- Delphi Help
1891
1892  Just call to the OnDataChange Event, and turn off IsModified
1893}
1894procedure TFieldDataLink.Reset;
1895begin
1896  if Assigned(FOnDataChange) then
1897    FOnDataChange(Self);
1898
1899  IsModified := False;
1900  ResetEditingSource;
1901end;
1902
1903CONST
1904  DBCBEVENT_CHANGE   = 1;   // CustomDBCombobox Detected change event
1905  DBCBEVENT_SELECT   = 2;   // CustomDBCombobox Detected select event
1906  DBCBEVENT_CLOSEUP  = 4;   // CustomDBCombobox Detected closeup event
1907  DBCBEVENT_WHEEL    = 8;   // CustomDBCombobox Detected mousewheel event
1908
1909{$Include dblookup.inc}
1910{$Include dbedit.inc}
1911{$Include dbtext.inc}
1912{$Include customdblistbox.inc}
1913{$Include dblistbox.inc}
1914{$Include dblookuplistbox.inc}
1915{$Include dbradiogroup.inc}
1916{$Include dbcheckbox.inc}
1917{$Include customdbcombobox.inc}
1918{$Include dbcombobox.inc}
1919{$Include dblookupcombobox.inc}
1920{$Include dbmemo.inc}
1921{$Include dbgroupbox.inc}
1922{$Include dbimage.inc}
1923{$Include dbcalendar.inc}
1924{$Include dbcustomnavigator.inc}
1925
1926
1927initialization
1928  RegisterPropertyToSkip(TField,'Calculated','VCL compatibility property', '');
1929
1930finalization
1931  FieldClasses.Free;
1932
1933end.
1934