source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntDBCtrls.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

File size: 61.1 KB
Line 
1
2{*****************************************************************************}
3{                                                                             }
4{    Tnt Delphi Unicode Controls                                              }
5{      http://www.tntware.com/delphicontrols/unicode/                         }
6{        Version: 2.3.0                                                       }
7{                                                                             }
8{    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
9{                                                                             }
10{*****************************************************************************}
11
12unit TntDBCtrls;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19  Classes, Windows, Messages, DB, DBCtrls, Controls, StdCtrls,
20  TntClasses, TntStdCtrls, TntControls, TntComCtrls, TntExtCtrls;
21
22type
23{TNT-WARN TPaintControl}
24  TTntPaintControl = class
25  private
26    FOwner: TWinControl;
27    FClassName: WideString;
28    FHandle: HWnd;
29    FObjectInstance: Pointer;
30    FDefWindowProc: Pointer;
31    FCtl3dButton: Boolean;
32    function GetHandle: HWnd;
33    procedure SetCtl3DButton(Value: Boolean);
34    procedure WndProc(var Message: TMessage);
35  public
36    constructor Create(AOwner: TWinControl; const ClassName: WideString);
37    destructor Destroy; override;
38    procedure DestroyHandle;
39    property Ctl3DButton: Boolean read FCtl3dButton write SetCtl3dButton;
40    property Handle: HWnd read GetHandle;
41  end;
42
43type
44{TNT-WARN TDBEdit}
45  TTntDBEdit = class(TDBEdit{TNT-ALLOW TDBEdit})
46  private
47    InheritedDataChange: TNotifyEvent;
48    FPasswordChar: WideChar;
49    procedure DataChange(Sender: TObject);
50    procedure UpdateData(Sender: TObject);
51    function GetHint: WideString;
52    procedure SetHint(const Value: WideString);
53    function IsHintStored: Boolean;
54    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
55    function GetTextMargins: TPoint;
56    function GetPasswordChar: WideChar;
57    procedure SetPasswordChar(const Value: WideChar);
58    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
59  private
60    function GetSelStart: Integer; reintroduce; virtual;
61    procedure SetSelStart(const Value: Integer); reintroduce; virtual;
62    function GetSelLength: Integer; reintroduce; virtual;
63    procedure SetSelLength(const Value: Integer); reintroduce; virtual;
64    function GetSelText: WideString; reintroduce;
65    procedure SetSelText(const Value: WideString);
66    function GetText: WideString;
67    procedure SetText(const Value: WideString);
68  protected
69    procedure CreateWindowHandle(const Params: TCreateParams); override;
70    procedure CreateWnd; override;
71    procedure DefineProperties(Filer: TFiler); override;
72    function GetActionLinkClass: TControlActionLinkClass; override;
73    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
74  public
75    constructor Create(AOwner: TComponent); override;
76    property SelText: WideString read GetSelText write SetSelText;
77    property SelStart: Integer read GetSelStart write SetSelStart;
78    property SelLength: Integer read GetSelLength write SetSelLength;
79    property Text: WideString read GetText write SetText;
80  published
81    property Hint: WideString read GetHint write SetHint stored IsHintStored;
82    property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
83  end;
84
85{TNT-WARN TDBText}
86  TTntDBText = class(TDBText{TNT-ALLOW TDBText})
87  private
88    FDataLink: TFieldDataLink;
89    InheritedDataChange: TNotifyEvent;
90    function GetHint: WideString;
91    procedure SetHint(const Value: WideString);
92    function IsHintStored: Boolean;
93    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
94    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
95    function GetCaption: TWideCaption;
96    function IsCaptionStored: Boolean;
97    procedure SetCaption(const Value: TWideCaption);
98    function GetFieldText: WideString;
99    procedure DataChange(Sender: TObject);
100  protected
101    procedure DefineProperties(Filer: TFiler); override;
102    function GetLabelText: WideString; reintroduce; virtual;
103    function GetActionLinkClass: TControlActionLinkClass; override;
104    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
105    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
106  public
107    constructor Create(AOwner: TComponent); override;
108    destructor Destroy; override;
109    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
110  published
111    property Hint: WideString read GetHint write SetHint stored IsHintStored;
112  end;
113
114{TNT-WARN TDBComboBox}
115  TTntCustomDBComboBox = class(TDBComboBox{TNT-ALLOW TDBComboBox},
116    IWideCustomListControl)
117  private
118    FDataLink: TFieldDataLink;
119    FFilter: WideString;
120    FLastTime: Cardinal;
121    procedure UpdateData(Sender: TObject);
122    procedure EditingChange(Sender: TObject);
123    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
124    procedure SetReadOnly;
125    function GetHint: WideString;
126    procedure SetHint(const Value: WideString);
127    function IsHintStored: Boolean;
128    procedure WMChar(var Message: TWMChar); message WM_CHAR;
129  private
130    FItems: TTntStrings;
131    FSaveItems: TTntStrings;
132    FSaveItemIndex: integer;
133    function GetItems: TTntStrings;
134    procedure SetItems(const Value: TTntStrings); reintroduce;
135    function GetSelStart: Integer;
136    procedure SetSelStart(const Value: Integer);
137    function GetSelLength: Integer;
138    procedure SetSelLength(const Value: Integer);
139    function GetSelText: WideString;
140    procedure SetSelText(const Value: WideString);
141    function GetText: WideString;
142    procedure SetText(const Value: WideString);
143
144    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
145  protected
146    procedure DataChange(Sender: TObject);
147    function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
148    function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
149    procedure DoEditCharMsg(var Message: TWMChar); virtual;
150    function GetFieldValue: Variant; virtual;
151    procedure SetFieldValue(const Value: Variant); virtual;
152    function GetComboValue: Variant; virtual; abstract;
153    procedure SetComboValue(const Value: Variant); virtual; abstract;
154    {$IFDEF DELPHI_7} // fix for Delphi 7 only
155    function GetItemsClass: TCustomComboBoxStringsClass; override;
156    {$ENDIF}
157  protected
158    procedure CreateWindowHandle(const Params: TCreateParams); override;
159    procedure DefineProperties(Filer: TFiler); override;
160    function GetActionLinkClass: TControlActionLinkClass; override;
161    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
162    procedure CreateWnd; override;
163    procedure DestroyWnd; override;
164    procedure WndProc(var Message: TMessage); override;
165    procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
166    procedure KeyPress(var Key: AnsiChar); override;
167  public
168    constructor Create(AOwner: TComponent); override;
169    destructor Destroy; override;
170    procedure CopySelection(Destination: TCustomListControl); override;
171    procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
172  public
173    property SelText: WideString read GetSelText write SetSelText;
174    property SelStart: Integer read GetSelStart write SetSelStart;
175    property SelLength: Integer read GetSelLength write SetSelLength;
176    property Text: WideString read GetText write SetText;
177  published
178    property Hint: WideString read GetHint write SetHint stored IsHintStored;
179    property Items: TTntStrings read GetItems write SetItems;
180  end;
181
182  TTntDBComboBox = class(TTntCustomDBComboBox)
183  protected
184    function GetFieldValue: Variant; override;
185    procedure SetFieldValue(const Value: Variant); override;
186    function GetComboValue: Variant; override;
187    procedure SetComboValue(const Value: Variant); override;
188  end;
189
190type
191{TNT-WARN TDBCheckBox}
192  TTntDBCheckBox = class(TDBCheckBox{TNT-ALLOW TDBCheckBox})
193  private
194    function GetCaption: TWideCaption;
195    procedure SetCaption(const Value: TWideCaption);
196    function GetHint: WideString;
197    procedure SetHint(const Value: WideString);
198    function IsCaptionStored: Boolean;
199    function IsHintStored: Boolean;
200  protected
201    procedure CreateWindowHandle(const Params: TCreateParams); override;
202    procedure DefineProperties(Filer: TFiler); override;
203    function GetActionLinkClass: TControlActionLinkClass; override;
204    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
205    procedure Toggle; override;
206  published
207    property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
208    property Hint: WideString read GetHint write SetHint stored IsHintStored;
209  end;
210
211{TNT-WARN TDBRichEdit}
212  TTntDBRichEdit = class(TTntCustomRichEdit)
213  private
214    FDataLink: TFieldDataLink;
215    FAutoDisplay: Boolean;
216    FFocused: Boolean;
217    FMemoLoaded: Boolean;
218    FDataSave: AnsiString;
219    procedure BeginEditing;
220    procedure DataChange(Sender: TObject);
221    procedure EditingChange(Sender: TObject);
222    function GetDataField: WideString;
223    function GetDataSource: TDataSource;
224    function GetField: TField;
225    function GetReadOnly: Boolean;
226    procedure SetDataField(const Value: WideString);
227    procedure SetDataSource(Value: TDataSource);
228    procedure SetReadOnly(Value: Boolean);
229    procedure SetAutoDisplay(Value: Boolean);
230    procedure SetFocused(Value: Boolean);
231    procedure UpdateData(Sender: TObject);
232    procedure WMCut(var Message: TMessage); message WM_CUT;
233    procedure WMPaste(var Message: TMessage); message WM_PASTE;
234    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
235    procedure CMExit(var Message: TCMExit); message CM_EXIT;
236    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
237    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
238    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
239  protected
240    procedure InternalLoadMemo; dynamic;
241    procedure InternalSaveMemo; dynamic;
242  protected
243    procedure Change; override;
244    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
245    procedure KeyPress(var Key: AnsiChar); override;
246    procedure Loaded; override;
247    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
248  public
249    constructor Create(AOwner: TComponent); override;
250    destructor Destroy; override;
251    function ExecuteAction(Action: TBasicAction): Boolean; override;
252    procedure LoadMemo; virtual;
253    function UpdateAction(Action: TBasicAction): Boolean; override;
254    function UseRightToLeftAlignment: Boolean; override;
255    property Field: TField read GetField;
256  published
257    property Align;
258    property Alignment;
259    property Anchors;
260    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
261    property BevelEdges;
262    property BevelInner;
263    property BevelOuter;
264    property BevelKind;
265    property BevelWidth;
266    property BiDiMode;
267    property BorderStyle;
268    property Color;
269    property Constraints;
270    property Ctl3D;
271    property DataField: WideString read GetDataField write SetDataField;
272    property DataSource: TDataSource read GetDataSource write SetDataSource;
273    property DragCursor;
274    property DragKind;
275    property DragMode;
276    property Enabled;
277    property Font;
278    property HideSelection;
279    property HideScrollBars;
280    property ImeMode;
281    property ImeName;
282    property MaxLength;
283    property ParentBiDiMode;
284    property ParentColor;
285    property ParentCtl3D;
286    property ParentFont;
287    property ParentShowHint;
288    property PlainText;
289    property PopupMenu;
290    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
291    property ScrollBars;
292    property ShowHint;
293    property TabOrder;
294    property TabStop;
295    property Visible;
296    property WantReturns;
297    property WantTabs;
298    property WordWrap;
299    property OnChange;
300    property OnClick;
301    property OnContextPopup;
302    property OnDblClick;
303    property OnDragDrop;
304    property OnDragOver;
305    property OnEndDock;
306    property OnEndDrag;
307    property OnEnter;
308    property OnExit;
309    property OnKeyDown;
310    property OnKeyPress;
311    property OnKeyUp;
312    {$IFDEF COMPILER_9_UP}
313    property OnMouseActivate;
314    {$ENDIF}
315    property OnMouseDown;
316    {$IFDEF COMPILER_10_UP}
317    property OnMouseEnter;
318    property OnMouseLeave;
319    {$ENDIF}
320    property OnMouseMove;
321    property OnMouseUp;
322    property OnResizeRequest;
323    property OnSelectionChange;
324    property OnProtectChange;
325    property OnSaveClipboard;
326    property OnStartDock;
327    property OnStartDrag;
328  end;
329
330type
331{TNT-WARN TDBMemo}
332  TTntDBMemo = class(TTntCustomMemo)
333  private
334    FDataLink: TFieldDataLink;
335    FAutoDisplay: Boolean;
336    FFocused: Boolean;
337    FMemoLoaded: Boolean;
338    FPaintControl: TTntPaintControl;
339    procedure DataChange(Sender: TObject);
340    procedure EditingChange(Sender: TObject);
341    function GetDataField: WideString;
342    function GetDataSource: TDataSource;
343    function GetField: TField;
344    function GetReadOnly: Boolean;
345    procedure SetDataField(const Value: WideString);
346    procedure SetDataSource(Value: TDataSource);
347    procedure SetReadOnly(Value: Boolean);
348    procedure SetAutoDisplay(Value: Boolean);
349    procedure SetFocused(Value: Boolean);
350    procedure UpdateData(Sender: TObject);
351    procedure WMCut(var Message: TMessage); message WM_CUT;
352    procedure WMPaste(var Message: TMessage); message WM_PASTE;
353    procedure WMUndo(var Message: TMessage); message WM_UNDO;
354    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
355    procedure CMExit(var Message: TCMExit); message CM_EXIT;
356    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
357    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
358    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
359  protected
360    procedure Change; override;
361    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
362    procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
363    procedure Loaded; override;
364    procedure Notification(AComponent: TComponent;
365      Operation: TOperation); override;
366    procedure WndProc(var Message: TMessage); override;
367  public
368    constructor Create(AOwner: TComponent); override;
369    destructor Destroy; override;
370    function ExecuteAction(Action: TBasicAction): Boolean; override;
371    procedure LoadMemo; virtual;
372    function UpdateAction(Action: TBasicAction): Boolean; override;
373    function UseRightToLeftAlignment: Boolean; override;
374    property Field: TField read GetField;
375  published
376    property Align;
377    property Alignment;
378    property Anchors;
379    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
380    property BevelEdges;
381    property BevelInner;
382    property BevelOuter;
383    property BevelKind;
384    property BevelWidth;
385    property BiDiMode;
386    property BorderStyle;
387    property Color;
388    property Constraints;
389    property Ctl3D;
390    property DataField: WideString read GetDataField write SetDataField;
391    property DataSource: TDataSource read GetDataSource write SetDataSource;
392    property DragCursor;
393    property DragKind;
394    property DragMode;
395    property Enabled;
396    property Font;
397    property HideSelection;   
398    property ImeMode;
399    property ImeName;
400    property MaxLength;
401    property ParentBiDiMode;
402    property ParentColor;
403    property ParentCtl3D;
404    property ParentFont;
405    property ParentShowHint;
406    property PopupMenu;
407    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
408    property ScrollBars;
409    property ShowHint;
410    property TabOrder;
411    property TabStop;
412    property Visible;
413    property WantReturns;
414    property WantTabs;
415    property WordWrap;
416    property OnChange;
417    property OnClick;
418    property OnContextPopup;
419    property OnDblClick;
420    property OnDragDrop;
421    property OnDragOver;
422    property OnEndDock;
423    property OnEndDrag;
424    property OnEnter;
425    property OnExit;
426    property OnKeyDown;
427    property OnKeyPress;
428    property OnKeyUp;
429    {$IFDEF COMPILER_9_UP}
430    property OnMouseActivate;
431    {$ENDIF}
432    property OnMouseDown;
433    {$IFDEF COMPILER_10_UP}
434    property OnMouseEnter;
435    property OnMouseLeave;
436    {$ENDIF}
437    property OnMouseMove;
438    property OnMouseUp;
439    property OnStartDock;
440    property OnStartDrag;
441  end;
442
443{ TDBRadioGroup }
444type
445  TTntDBRadioGroup = class(TTntCustomRadioGroup)
446  private
447    FDataLink: TFieldDataLink;
448    FValue: WideString;
449    FValues: TTntStrings;
450    FInSetValue: Boolean;
451    FOnChange: TNotifyEvent;
452    procedure DataChange(Sender: TObject);
453    procedure UpdateData(Sender: TObject);
454    function GetDataField: WideString;
455    function GetDataSource: TDataSource;
456    function GetField: TField;
457    function GetReadOnly: Boolean;
458    function GetButtonValue(Index: Integer): WideString;
459    procedure SetDataField(const Value: WideString);
460    procedure SetDataSource(Value: TDataSource);
461    procedure SetReadOnly(Value: Boolean);
462    procedure SetValue(const Value: WideString);
463    procedure SetItems(Value: TTntStrings);
464    procedure SetValues(Value: TTntStrings);
465    procedure CMExit(var Message: TCMExit); message CM_EXIT;
466    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
467  protected
468    procedure Change; dynamic;
469    procedure Click; override;
470    procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
471    function CanModify: Boolean; override;
472    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
473    property DataLink: TFieldDataLink read FDataLink;
474  public
475    constructor Create(AOwner: TComponent); override;
476    destructor Destroy; override;
477    function ExecuteAction(Action: TBasicAction): Boolean; override;
478    function UpdateAction(Action: TBasicAction): Boolean; override;
479    function UseRightToLeftAlignment: Boolean; override;
480    property Field: TField read GetField;
481    property ItemIndex;
482    property Value: WideString read FValue write SetValue;
483  published
484    property Align;
485    property Anchors;
486    property BiDiMode;
487    property Caption;
488    property Color;
489    property Columns;
490    property Constraints;
491    property Ctl3D;
492    property DataField: WideString read GetDataField write SetDataField;
493    property DataSource: TDataSource read GetDataSource write SetDataSource;
494    property DragCursor;
495    property DragKind;
496    property DragMode;
497    property Enabled;
498    property Font;
499    property Items write SetItems;
500    {$IFDEF COMPILER_7_UP}
501    property ParentBackground;
502    {$ENDIF}
503    property ParentBiDiMode;
504    property ParentColor;
505    property ParentCtl3D;
506    property ParentFont;
507    property ParentShowHint;
508    property PopupMenu;
509    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
510    property ShowHint;
511    property TabOrder;
512    property TabStop;
513    property Values: TTntStrings read FValues write SetValues;
514    property Visible;
515    property OnChange: TNotifyEvent read FOnChange write FOnChange;
516    property OnClick;
517    property OnContextPopup;
518    property OnDragDrop;
519    property OnDragOver;
520    property OnEndDock;
521    property OnEndDrag;
522    property OnEnter;
523    property OnExit;
524    {$IFDEF COMPILER_10_UP}
525    property OnMouseEnter;
526    property OnMouseLeave;
527    {$ENDIF}
528    property OnStartDock;
529    property OnStartDrag;
530  end;
531
532implementation
533
534uses
535  Forms, SysUtils, Graphics, Variants, TntDB,
536  TntActnList, TntGraphics, TntSysUtils, RichEdit, Mask;
537
538function FieldIsBlobLike(Field: TField): Boolean;
539begin
540  Result := False;
541  if Assigned(Field) then begin
542    if (Field.IsBlob)
543    or (Field.DataType in [Low(TBlobType).. High(TBlobType)]) then
544      Result := True
545    else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
546    and (Field.Size = MaxInt) then
547      Result := True; { wide string field filling in for a blob field }
548  end;
549end;
550
551{ TTntPaintControl }
552
553type
554  TAccessWinControl = class(TWinControl);
555
556constructor TTntPaintControl.Create(AOwner: TWinControl; const ClassName: WideString);
557begin
558  FOwner := AOwner;
559  FClassName := ClassName;
560end;
561
562destructor TTntPaintControl.Destroy;
563begin
564  DestroyHandle;
565end;
566
567procedure TTntPaintControl.DestroyHandle;
568begin
569  if FHandle <> 0 then DestroyWindow(FHandle);
570  Classes.FreeObjectInstance(FObjectInstance);
571  FHandle := 0;
572  FObjectInstance := nil;
573end;
574
575function TTntPaintControl.GetHandle: HWnd;
576var
577  Params: TCreateParams;
578begin
579  if FHandle = 0 then
580  begin
581    FObjectInstance := Classes.MakeObjectInstance(WndProc);
582    TAccessWinControl(FOwner).CreateParams(Params);
583    Params.Style := Params.Style and not (WS_HSCROLL or WS_VSCROLL);
584    if (not Win32PlatformIsUnicode) then begin
585      with Params do
586        FHandle := CreateWindowEx(ExStyle, PAnsiChar(AnsiString(FClassName)),
587          PAnsiChar(TAccessWinControl(FOwner).Text), Style or WS_VISIBLE,
588          X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
589      FDefWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
590      SetWindowLong(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
591    end else begin
592      with Params do
593        FHandle := CreateWindowExW(ExStyle, PWideChar(FClassName),
594          PWideChar(TntControl_GetText(FOwner)), Style or WS_VISIBLE,
595          X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
596      FDefWindowProc := Pointer(GetWindowLongW(FHandle, GWL_WNDPROC));
597      SetWindowLongW(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
598    end;
599    SendMessage(FHandle, WM_SETFONT, Integer(TAccessWinControl(FOwner).Font.Handle), 1);
600  end;
601  Result := FHandle;
602end;
603
604procedure TTntPaintControl.SetCtl3DButton(Value: Boolean);
605begin
606  if FHandle <> 0 then DestroyHandle;
607  FCtl3DButton := Value;
608end;
609
610procedure TTntPaintControl.WndProc(var Message: TMessage);
611begin
612  with Message do
613    if (Msg >= CN_CTLCOLORMSGBOX) and (Msg <= CN_CTLCOLORSTATIC) then
614      Result := FOwner.Perform(Msg, WParam, LParam)
615    else if (not Win32PlatformIsUnicode) then
616      Result := CallWindowProcA(FDefWindowProc, FHandle, Msg, WParam, LParam)
617    else
618      Result := CallWindowProcW(FDefWindowProc, FHandle, Msg, WParam, LParam);
619end;
620
621{ THackFieldDataLink }
622type
623  THackFieldDataLink_D6_D7_D9 = class(TDataLink)
624  protected
625    FxxxField: TField;
626    FxxxFieldName: string{TNT-ALLOW string};
627    FxxxControl: TComponent;
628    FxxxEditing: Boolean;
629    FModified: Boolean;
630  end;
631
632{$IFDEF COMPILER_6}  // verified against VCL source in Delphi 6 and BCB 6
633  THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
634{$ENDIF}
635{$IFDEF DELPHI_7}    // verified against VCL source in Delphi 7
636  THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
637{$ENDIF}
638{$IFDEF DELPHI_9}    // verified against VCL source in Delphi 9
639  THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
640{$ENDIF}
641{$IFDEF DELPHI_10}    // verified against VCL source in Delphi 10
642  THackFieldDataLink = class(TDataLink)
643  protected
644    FxxxField: TField;
645    FxxxFieldName: WideString;
646    FxxxControl: TComponent;
647    FxxxEditing: Boolean;
648    FModified: Boolean;
649  end;
650{$ENDIF}
651
652{ TTntDBEdit }
653
654type
655  THackDBEdit_D6_D7_D9 = class(TCustomMaskEdit)
656  protected
657    FDataLink: TFieldDataLink;
658    FCanvas: TControlCanvas;
659    FAlignment: TAlignment;
660    FFocused: Boolean;
661  end;
662
663{$IFDEF COMPILER_6}   // verified against VCL source in Delphi 6 and BCB 6
664  THackDBEdit = THackDBEdit_D6_D7_D9;
665{$ENDIF}
666{$IFDEF DELPHI_7}     // verified against VCL source in Delphi 7
667  THackDBEdit = THackDBEdit_D6_D7_D9;
668{$ENDIF}
669{$IFDEF DELPHI_9}     // verified against VCL source in Delphi 9
670  THackDBEdit = THackDBEdit_D6_D7_D9;
671{$ENDIF}
672{$IFDEF DELPHI_10}     // verified against VCL source in Delphi 10
673  THackDBEdit = THackDBEdit_D6_D7_D9;
674{$ENDIF}
675
676constructor TTntDBEdit.Create(AOwner: TComponent);
677begin
678  inherited;
679  InheritedDataChange := THackDBEdit(Self).FDataLink.OnDataChange;
680  THackDBEdit(Self).FDataLink.OnDataChange := DataChange;
681  THackDBEdit(Self).FDataLink.OnUpdateData := UpdateData;
682end;
683
684procedure TTntDBEdit.CreateWindowHandle(const Params: TCreateParams);
685begin
686  CreateUnicodeHandle(Self, Params, 'EDIT');
687end;
688
689procedure TTntDBEdit.CreateWnd;
690begin
691  inherited;
692  TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
693end;
694
695procedure TTntDBEdit.DefineProperties(Filer: TFiler);
696begin
697  inherited;
698  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
699end;
700
701function TTntDBEdit.GetSelStart: Integer;
702begin
703  Result := TntCustomEdit_GetSelStart(Self);
704end;
705
706procedure TTntDBEdit.SetSelStart(const Value: Integer);
707begin
708  TntCustomEdit_SetSelStart(Self, Value);
709end;
710
711function TTntDBEdit.GetSelLength: Integer;
712begin
713  Result := TntCustomEdit_GetSelLength(Self);
714end;
715
716procedure TTntDBEdit.SetSelLength(const Value: Integer);
717begin
718  TntCustomEdit_SetSelLength(Self, Value);
719end;
720
721function TTntDBEdit.GetSelText: WideString;
722begin
723  Result := TntCustomEdit_GetSelText(Self);
724end;
725
726procedure TTntDBEdit.SetSelText(const Value: WideString);
727begin
728  TntCustomEdit_SetSelText(Self, Value);
729end;
730
731function TTntDBEdit.GetPasswordChar: WideChar;
732begin
733  Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar)
734end;
735
736procedure TTntDBEdit.SetPasswordChar(const Value: WideChar);
737begin
738  TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
739end;
740
741function TTntDBEdit.GetText: WideString;
742begin
743  Result := TntControl_GetText(Self);
744end;
745
746procedure TTntDBEdit.SetText(const Value: WideString);
747begin
748  TntControl_SetText(Self, Value);
749end;
750
751procedure TTntDBEdit.DataChange(Sender: TObject);
752begin
753  with THackDBEdit(Self), Self do begin
754    if Field = nil then
755      InheritedDataChange(Sender)
756    else begin
757      if FAlignment <> Field.Alignment then
758      begin
759        EditText := '';  {forces update}
760        FAlignment := Field.Alignment;
761      end;
762      EditMask := Field.EditMask;
763      if not (csDesigning in ComponentState) then
764      begin
765        if (Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
766          MaxLength := Field.Size;
767      end;
768      if FFocused and FDataLink.CanModify then
769        Text := GetWideText(Field)
770      else
771      begin
772        Text := GetWideDisplayText(Field);
773        if FDataLink.Editing and THackFieldDataLink(FDataLink).FModified then
774          Modified := True;
775      end;
776    end;
777  end;
778end;
779
780procedure TTntDBEdit.UpdateData(Sender: TObject);
781begin
782  ValidateEdit;
783  SetWideText(Field, Text);
784end;
785
786procedure TTntDBEdit.CMEnter(var Message: TCMEnter);
787var
788  SaveFarEast: Boolean;
789begin
790  SaveFarEast := SysLocale.FarEast;
791  try
792    SysLocale.FarEast := False;
793    inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
794  finally
795    SysLocale.FarEast := SaveFarEast;
796  end;
797end;
798
799function TTntDBEdit.IsHintStored: Boolean;
800begin
801  Result := TntControl_IsHintStored(Self);
802end;
803
804function TTntDBEdit.GetHint: WideString;
805begin
806  Result := TntControl_GetHint(Self)
807end;
808
809procedure TTntDBEdit.SetHint(const Value: WideString);
810begin
811  TntControl_SetHint(Self, Value);
812end;
813
814procedure TTntDBEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
815begin
816  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
817  inherited;
818end;
819
820function TTntDBEdit.GetActionLinkClass: TControlActionLinkClass;
821begin
822  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
823end;
824
825procedure TTntDBEdit.WMPaint(var Message: TWMPaint);
826const
827  AlignStyle : array[Boolean, TAlignment] of DWORD =
828   ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
829    (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
830var
831  ALeft: Integer;
832  _Margins: TPoint;
833  R: TRect;
834  DC: HDC;
835  PS: TPaintStruct;
836  S: WideString;
837  AAlignment: TAlignment;
838  I: Integer;
839begin
840  with THackDBEdit(Self), Self do begin
841    AAlignment := FAlignment;
842    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
843    if ((AAlignment = taLeftJustify) or FFocused) and (not (csPaintCopy in ControlState))
844    or (not Win32PlatformIsUnicode) then
845    begin
846      inherited;
847      Exit;
848    end;
849  { Since edit controls do not handle justification unless multi-line (and
850    then only poorly) we will draw right and center justify manually unless
851    the edit has the focus. }
852    if FCanvas = nil then
853    begin
854      FCanvas := TControlCanvas.Create;
855      FCanvas.Control := Self;
856    end;
857    DC := Message.DC;
858    if DC = 0 then DC := BeginPaint(Handle, PS);
859    FCanvas.Handle := DC;
860    try
861      FCanvas.Font := Font;
862      with FCanvas do
863      begin
864        R := ClientRect;
865        if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
866        begin
867          Brush.Color := clWindowFrame;
868          FrameRect(R);
869          InflateRect(R, -1, -1);
870        end;
871        Brush.Color := Color;
872        if not Enabled then
873          Font.Color := clGrayText;
874        if (csPaintCopy in ControlState) and (Field <> nil) then
875        begin
876          S := GetWideDisplayText(Field);
877          case CharCase of
878            ecUpperCase:
879              S := Tnt_WideUpperCase(S);
880            ecLowerCase:
881              S := Tnt_WideLowerCase(S);
882          end;
883        end else
884          S := Text { EditText? };
885        if PasswordChar <> #0 then
886          for I := 1 to Length(S) do S[I] := PasswordChar;
887        _Margins := GetTextMargins;
888        case AAlignment of
889          taLeftJustify: ALeft := _Margins.X;
890          taRightJustify: ALeft := ClientWidth - WideCanvasTextWidth(FCanvas, S) - _Margins.X - 1;
891        else
892          ALeft := (ClientWidth - WideCanvasTextWidth(FCanvas, S)) div 2;
893        end;
894        if SysLocale.MiddleEast then UpdateTextFlags;
895        WideCanvasTextRect(FCanvas, R, ALeft, _Margins.Y, S);
896      end;
897    finally
898      FCanvas.Handle := 0;
899      if Message.DC = 0 then EndPaint(Handle, PS);
900    end;
901  end;
902end;
903
904function TTntDBEdit.GetTextMargins: TPoint;
905var
906  DC: HDC;
907  SaveFont: HFont;
908  I: Integer;
909  SysMetrics, Metrics: TTextMetric;
910begin
911  if NewStyleControls then
912  begin
913    if BorderStyle = bsNone then I := 0 else
914      if Ctl3D then I := 1 else I := 2;
915    Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
916    Result.Y := I;
917  end else
918  begin
919    if BorderStyle = bsNone then I := 0 else
920    begin
921      DC := GetDC(0);
922      GetTextMetrics(DC, SysMetrics);
923      SaveFont := SelectObject(DC, Font.Handle);
924      GetTextMetrics(DC, Metrics);
925      SelectObject(DC, SaveFont);
926      ReleaseDC(0, DC);
927      I := SysMetrics.tmHeight;
928      if I > Metrics.tmHeight then I := Metrics.tmHeight;
929      I := I div 4;
930    end;
931    Result.X := I;
932    Result.Y := I;
933  end;
934end;
935
936{ TTntDBText }
937
938constructor TTntDBText.Create(AOwner: TComponent);
939begin
940  inherited;
941  FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
942  InheritedDataChange := FDataLink.OnDataChange;
943  FDataLink.OnDataChange := DataChange;
944end;
945
946destructor TTntDBText.Destroy;
947begin
948  FDataLink := nil;
949  inherited;
950end;
951
952procedure TTntDBText.CMDialogChar(var Message: TCMDialogChar);
953begin
954  TntLabel_CMDialogChar(Self, Message, Caption);
955end;
956
957function TTntDBText.IsCaptionStored: Boolean;
958begin
959  Result := TntControl_IsCaptionStored(Self)
960end;
961
962function TTntDBText.GetCaption: TWideCaption;
963begin
964  Result := TntControl_GetText(Self);
965end;
966
967procedure TTntDBText.SetCaption(const Value: TWideCaption);
968begin
969  TntControl_SetText(Self, Value);
970end;
971
972procedure TTntDBText.DefineProperties(Filer: TFiler);
973begin
974  inherited;
975  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
976end;
977
978function TTntDBText.GetLabelText: WideString;
979begin
980  if csPaintCopy in ControlState then
981    Result := GetFieldText
982  else
983    Result := Caption;
984end;
985
986procedure TTntDBText.DoDrawText(var Rect: TRect; Flags: Integer);
987begin
988  if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
989    inherited;
990end;
991
992function TTntDBText.IsHintStored: Boolean;
993begin
994  Result := TntControl_IsHintStored(Self);
995end;
996
997function TTntDBText.GetHint: WideString;
998begin
999  Result := TntControl_GetHint(Self)
1000end;
1001
1002procedure TTntDBText.SetHint(const Value: WideString);
1003begin
1004  TntControl_SetHint(Self, Value);
1005end;
1006
1007procedure TTntDBText.CMHintShow(var Message: TMessage);
1008begin
1009  ProcessCMHintShowMsg(Message);
1010  inherited;
1011end;
1012
1013procedure TTntDBText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1014begin
1015  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1016  inherited;
1017end;
1018
1019function TTntDBText.GetActionLinkClass: TControlActionLinkClass;
1020begin
1021  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1022end;
1023
1024function TTntDBText.GetFieldText: WideString;
1025begin
1026  if Field <> nil then
1027    Result := GetWideDisplayText(Field)
1028  else
1029    if csDesigning in ComponentState then Result := Name else Result := '';
1030end;
1031
1032procedure TTntDBText.DataChange(Sender: TObject);
1033begin
1034  Caption := GetFieldText;
1035end;
1036
1037{ TTntCustomDBComboBox }
1038
1039constructor TTntCustomDBComboBox.Create(AOwner: TComponent);
1040begin
1041  inherited;
1042  FItems := TTntComboBoxStrings.Create;
1043  TTntComboBoxStrings(FItems).ComboBox := Self;
1044  FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
1045  FDataLink.OnDataChange := DataChange;
1046  FDataLink.OnUpdateData := UpdateData;
1047  FDataLink.OnEditingChange := EditingChange;
1048end;
1049
1050destructor TTntCustomDBComboBox.Destroy;
1051begin
1052  FreeAndNil(FItems);
1053  FreeAndNil(FSaveItems);
1054  FDataLink := nil;
1055  inherited;
1056end;
1057
1058procedure TTntCustomDBComboBox.CreateWindowHandle(const Params: TCreateParams);
1059begin
1060  CreateUnicodeHandle(Self, Params, 'COMBOBOX');
1061end;
1062
1063procedure TTntCustomDBComboBox.DefineProperties(Filer: TFiler);
1064begin
1065  inherited;
1066  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1067end;
1068
1069type
1070  TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
1071
1072procedure TTntCustomDBComboBox.CreateWnd;
1073var
1074  PreInheritedAnsiText: AnsiString;
1075begin
1076  PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
1077  inherited;
1078  TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
1079end;
1080
1081procedure TTntCustomDBComboBox.DestroyWnd;
1082var
1083  SavedText: WideString;
1084begin
1085  if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
1086    TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
1087    inherited;
1088    TntControl_SetStoredText(Self, SavedText);
1089  end;
1090end;
1091
1092procedure TTntCustomDBComboBox.SetReadOnly;
1093begin
1094  if (Style in [csDropDown, csSimple]) and HandleAllocated then
1095    SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.CanModify), 0);
1096end;
1097
1098procedure TTntCustomDBComboBox.EditingChange(Sender: TObject);
1099begin
1100  SetReadOnly;
1101end;
1102
1103procedure TTntCustomDBComboBox.CMEnter(var Message: TCMEnter);
1104var
1105  SaveFarEast: Boolean;
1106begin
1107  SaveFarEast := SysLocale.FarEast;
1108  try
1109    SysLocale.FarEast := False;
1110    inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
1111  finally
1112    SysLocale.FarEast := SaveFarEast;
1113  end;
1114end;
1115
1116procedure TTntCustomDBComboBox.WndProc(var Message: TMessage);
1117begin
1118  if (not (csDesigning in ComponentState))
1119  and (Message.Msg = CB_SHOWDROPDOWN)
1120  and (Message.WParam = 0)
1121  and (not FDataLink.Editing) then begin
1122    DataChange(Self); {Restore text}
1123    Dispatch(Message); {Do NOT call inherited!}
1124  end else
1125    inherited WndProc(Message);
1126end;
1127
1128procedure TTntCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
1129begin
1130  if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
1131    inherited;
1132end;
1133
1134procedure TTntCustomDBComboBox.KeyPress(var Key: AnsiChar);
1135var
1136  SaveAutoComplete: Boolean;
1137begin
1138  TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
1139  try
1140    inherited;
1141  finally
1142    TntCombo_AfterKeyPress(Self, SaveAutoComplete);
1143  end;
1144end;
1145
1146procedure TTntCustomDBComboBox.DoEditCharMsg(var Message: TWMChar);
1147begin
1148  TntCombo_AutoCompleteKeyPress(Self, Items, Message,
1149    GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
1150end;
1151
1152procedure TTntCustomDBComboBox.WMChar(var Message: TWMChar);
1153begin
1154  TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
1155  inherited;
1156end;
1157
1158function TTntCustomDBComboBox.GetItems: TTntStrings;
1159begin
1160  Result := FItems;
1161end;
1162
1163procedure TTntCustomDBComboBox.SetItems(const Value: TTntStrings);
1164begin
1165  FItems.Assign(Value);
1166  DataChange(Self);
1167end;
1168
1169function TTntCustomDBComboBox.GetSelStart: Integer;
1170begin
1171  Result := TntCombo_GetSelStart(Self);
1172end;
1173
1174procedure TTntCustomDBComboBox.SetSelStart(const Value: Integer);
1175begin
1176  TntCombo_SetSelStart(Self, Value);
1177end;
1178
1179function TTntCustomDBComboBox.GetSelLength: Integer;
1180begin
1181  Result := TntCombo_GetSelLength(Self);
1182end;
1183
1184procedure TTntCustomDBComboBox.SetSelLength(const Value: Integer);
1185begin
1186  TntCombo_SetSelLength(Self, Value);
1187end;
1188
1189function TTntCustomDBComboBox.GetSelText: WideString;
1190begin
1191  Result := TntCombo_GetSelText(Self);
1192end;
1193
1194procedure TTntCustomDBComboBox.SetSelText(const Value: WideString);
1195begin
1196  TntCombo_SetSelText(Self, Value);
1197end;
1198
1199function TTntCustomDBComboBox.GetText: WideString;
1200begin
1201  Result := TntControl_GetText(Self);
1202end;
1203
1204procedure TTntCustomDBComboBox.SetText(const Value: WideString);
1205begin
1206  TntControl_SetText(Self, Value);
1207end;
1208
1209procedure TTntCustomDBComboBox.CNCommand(var Message: TWMCommand);
1210begin
1211  if not TntCombo_CNCommand(Self, Items, Message) then
1212    inherited;
1213end;
1214
1215function TTntCustomDBComboBox.GetFieldValue: Variant;
1216begin
1217  Result := Field.Value;
1218end;
1219
1220procedure TTntCustomDBComboBox.SetFieldValue(const Value: Variant);
1221begin
1222  Field.Value := Value;
1223end;
1224
1225procedure TTntCustomDBComboBox.DataChange(Sender: TObject);
1226begin
1227  if not (Style = csSimple) and DroppedDown then Exit;
1228  if Field <> nil then
1229    SetComboValue(GetFieldValue)
1230  else
1231    if csDesigning in ComponentState then
1232      SetComboValue(Name)
1233    else
1234      SetComboValue(Null);
1235end;
1236
1237procedure TTntCustomDBComboBox.UpdateData(Sender: TObject);
1238begin
1239  SetFieldValue(GetComboValue);
1240end;
1241
1242function TTntCustomDBComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
1243begin
1244  Result := True;
1245end;
1246
1247function TTntCustomDBComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
1248begin
1249  Result := False;
1250end;
1251
1252function TTntCustomDBComboBox.IsHintStored: Boolean;
1253begin
1254  Result := TntControl_IsHintStored(Self);
1255end;
1256
1257function TTntCustomDBComboBox.GetHint: WideString;
1258begin
1259  Result := TntControl_GetHint(Self)
1260end;
1261
1262procedure TTntCustomDBComboBox.SetHint(const Value: WideString);
1263begin
1264  TntControl_SetHint(Self, Value);
1265end;
1266
1267procedure TTntCustomDBComboBox.AddItem(const Item: WideString; AObject: TObject);
1268begin
1269  TntComboBox_AddItem(Items, Item, AObject);
1270end;
1271
1272procedure TTntCustomDBComboBox.CopySelection(Destination: TCustomListControl);
1273begin
1274  TntComboBox_CopySelection(Items, ItemIndex, Destination);
1275end;
1276
1277procedure TTntCustomDBComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1278begin
1279  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1280  inherited;
1281end;
1282
1283function TTntCustomDBComboBox.GetActionLinkClass: TControlActionLinkClass;
1284begin
1285  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1286end;
1287
1288{$IFDEF DELPHI_7} // fix for Delphi 7 only
1289function TTntCustomDBComboBox.GetItemsClass: TCustomComboBoxStringsClass;
1290begin
1291  Result := TD7PatchedComboBoxStrings;
1292end;
1293{$ENDIF}
1294
1295{ TTntDBComboBox }
1296
1297function TTntDBComboBox.GetFieldValue: Variant;
1298begin
1299  Result := GetWideText(Field);
1300end;
1301
1302procedure TTntDBComboBox.SetFieldValue(const Value: Variant);
1303begin
1304  SetWideText(Field, Value);
1305end;
1306
1307procedure TTntDBComboBox.SetComboValue(const Value: Variant);
1308var
1309  I: Integer;
1310  Redraw: Boolean;
1311  OldValue: WideString;
1312  NewValue: WideString;
1313begin
1314  OldValue := VarToWideStr(GetComboValue);
1315  NewValue := VarToWideStr(Value);
1316
1317  if NewValue <> OldValue then
1318  begin
1319    if Style <> csDropDown then
1320    begin
1321      Redraw := (Style <> csSimple) and HandleAllocated;
1322      if Redraw then Items.BeginUpdate;
1323      try
1324        if NewValue = '' then I := -1 else I := Items.IndexOf(NewValue);
1325        ItemIndex := I;
1326      finally
1327        Items.EndUpdate;
1328      end;
1329      if I >= 0 then Exit;
1330    end;
1331    if Style in [csDropDown, csSimple] then Text := NewValue;
1332  end;
1333end;
1334
1335function TTntDBComboBox.GetComboValue: Variant;
1336var
1337  I: Integer;
1338begin
1339  if Style in [csDropDown, csSimple] then Result := Text else
1340  begin
1341    I := ItemIndex;
1342    if I < 0 then Result := '' else Result := Items[I];
1343  end;
1344end;
1345
1346{ TTntDBCheckBox }
1347
1348procedure TTntDBCheckBox.CreateWindowHandle(const Params: TCreateParams);
1349begin
1350  CreateUnicodeHandle(Self, Params, 'BUTTON');
1351end;
1352
1353procedure TTntDBCheckBox.DefineProperties(Filer: TFiler);
1354begin
1355  inherited;
1356  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1357end;
1358
1359function TTntDBCheckBox.IsCaptionStored: Boolean;
1360begin
1361  Result := TntControl_IsCaptionStored(Self);
1362end;
1363
1364function TTntDBCheckBox.GetCaption: TWideCaption;
1365begin
1366  Result := TntControl_GetText(Self)
1367end;
1368
1369procedure TTntDBCheckBox.SetCaption(const Value: TWideCaption);
1370begin
1371  TntControl_SetText(Self, Value);
1372end;
1373
1374function TTntDBCheckBox.IsHintStored: Boolean;
1375begin
1376  Result := TntControl_IsHintStored(Self);
1377end;
1378
1379function TTntDBCheckBox.GetHint: WideString;
1380begin
1381  Result := TntControl_GetHint(Self)
1382end;
1383
1384procedure TTntDBCheckBox.SetHint(const Value: WideString);
1385begin
1386  TntControl_SetHint(Self, Value);
1387end;
1388
1389procedure TTntDBCheckBox.Toggle;
1390var
1391  FDataLink: TDataLink;
1392begin
1393  inherited;
1394  FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
1395  FDataLink.UpdateRecord;
1396end;
1397
1398procedure TTntDBCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1399begin
1400  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1401  inherited;
1402end;
1403
1404function TTntDBCheckBox.GetActionLinkClass: TControlActionLinkClass;
1405begin
1406  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1407end;
1408
1409{ TTntDBRichEdit }
1410
1411constructor TTntDBRichEdit.Create(AOwner: TComponent);
1412begin
1413  inherited Create(AOwner);
1414  inherited ReadOnly := True;
1415  FAutoDisplay := True;
1416  FDataLink := TFieldDataLink.Create;
1417  FDataLink.Control := Self;
1418  FDataLink.OnDataChange := DataChange;
1419  FDataLink.OnEditingChange := EditingChange;
1420  FDataLink.OnUpdateData := UpdateData;
1421end;
1422
1423destructor TTntDBRichEdit.Destroy;
1424begin
1425  FDataLink.Free;
1426  FDataLink := nil;
1427  inherited Destroy;
1428end;
1429
1430procedure TTntDBRichEdit.Loaded;
1431begin
1432  inherited Loaded;
1433  if (csDesigning in ComponentState) then
1434    DataChange(Self)
1435end;
1436
1437procedure TTntDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
1438begin
1439  inherited;
1440  if (Operation = opRemove) and (FDataLink <> nil) and
1441    (AComponent = DataSource) then DataSource := nil;
1442end;
1443
1444function TTntDBRichEdit.UseRightToLeftAlignment: Boolean;
1445begin
1446  Result := DBUseRightToLeftAlignment(Self, Field);
1447end;
1448
1449procedure TTntDBRichEdit.BeginEditing;
1450begin
1451  if not FDataLink.Editing then
1452  try
1453    if FieldIsBlobLike(Field) then
1454      FDataSave := Field.AsString{TNT-ALLOW AsString};
1455    FDataLink.Edit;
1456  finally
1457    FDataSave := '';
1458  end;
1459end;
1460
1461procedure TTntDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
1462begin
1463  inherited KeyDown(Key, Shift);
1464  if FMemoLoaded then
1465  begin
1466    if (Key = VK_DELETE) or (Key = VK_BACK) or
1467      ((Key = VK_INSERT) and (ssShift in Shift)) or
1468      (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
1469      BeginEditing;
1470  end;
1471end;
1472
1473procedure TTntDBRichEdit.KeyPress(var Key: AnsiChar);
1474begin
1475  inherited KeyPress(Key);
1476  if FMemoLoaded then
1477  begin
1478    if (Key in [#32..#255]) and (Field <> nil) and
1479      not Field.IsValidChar(Key) then
1480    begin
1481      MessageBeep(0);
1482      Key := #0;
1483    end;
1484    case Key of
1485      ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
1486        BeginEditing;
1487      #27:
1488        FDataLink.Reset;
1489    end;
1490  end else
1491  begin
1492    if Key = #13 then LoadMemo;
1493    Key := #0;
1494  end;
1495end;
1496
1497procedure TTntDBRichEdit.Change;
1498begin
1499  if FMemoLoaded then
1500    FDataLink.Modified;
1501  FMemoLoaded := True;
1502  inherited Change;
1503end;
1504
1505procedure TTntDBRichEdit.CNNotify(var Message: TWMNotify);
1506begin
1507  inherited;
1508  if Message.NMHdr^.code = EN_PROTECTED then
1509    Message.Result := 0 { allow the operation (otherwise the control might appear stuck) }
1510end;
1511
1512function TTntDBRichEdit.GetDataSource: TDataSource;
1513begin
1514  Result := FDataLink.DataSource;
1515end;
1516
1517procedure TTntDBRichEdit.SetDataSource(Value: TDataSource);
1518begin
1519  FDataLink.DataSource := Value;
1520  if Value <> nil then Value.FreeNotification(Self);
1521end;
1522
1523function TTntDBRichEdit.GetDataField: WideString;
1524begin
1525  Result := FDataLink.FieldName;
1526end;
1527
1528procedure TTntDBRichEdit.SetDataField(const Value: WideString);
1529begin
1530  FDataLink.FieldName := Value;
1531end;
1532
1533function TTntDBRichEdit.GetReadOnly: Boolean;
1534begin
1535  Result := FDataLink.ReadOnly;
1536end;
1537
1538procedure TTntDBRichEdit.SetReadOnly(Value: Boolean);
1539begin
1540  FDataLink.ReadOnly := Value;
1541end;
1542
1543function TTntDBRichEdit.GetField: TField;
1544begin
1545  Result := FDataLink.Field;
1546end;
1547
1548procedure TTntDBRichEdit.InternalLoadMemo;
1549var
1550  Stream: TStringStream{TNT-ALLOW TStringStream};
1551begin
1552  if PlainText then
1553    Text := GetAsWideString(Field)
1554  else begin
1555    Stream := TStringStream{TNT-ALLOW TStringStream}.Create(Field.AsString{TNT-ALLOW AsString});
1556    try
1557      Lines.LoadFromStream(Stream);
1558    finally
1559      Stream.Free;
1560    end;
1561  end;
1562end;
1563
1564procedure TTntDBRichEdit.LoadMemo;
1565begin
1566  if not FMemoLoaded and Assigned(Field) and FieldIsBlobLike(Field) then
1567  begin
1568    try
1569      InternalLoadMemo;
1570      FMemoLoaded := True;
1571    except
1572      { Rich Edit Load failure }
1573      on E:EOutOfResources do
1574        Lines.Text := WideFormat('(%s)', [E.Message]);
1575    end;
1576    EditingChange(Self);
1577  end;
1578end;
1579
1580procedure TTntDBRichEdit.DataChange(Sender: TObject);
1581begin
1582  if Field <> nil then
1583    if FieldIsBlobLike(Field) then
1584    begin
1585      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
1586      begin
1587        { Check if the data has changed since we read it the first time }
1588        if (FDataSave <> '') and (FDataSave = Field.AsString{TNT-ALLOW AsString}) then Exit;
1589        FMemoLoaded := False;
1590        LoadMemo;
1591      end else
1592      begin
1593        Text := WideFormat('(%s)', [Field.DisplayName]);
1594        FMemoLoaded := False;
1595      end;
1596    end else
1597    begin
1598      if FFocused and FDataLink.CanModify then
1599        Text := GetWideText(Field)
1600      else
1601        Text := GetWideDisplayText(Field);
1602      FMemoLoaded := True;
1603    end
1604  else
1605  begin
1606    if csDesigning in ComponentState then Text := Name else Text := '';
1607    FMemoLoaded := False;
1608  end;
1609  if HandleAllocated then
1610    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
1611end;
1612
1613procedure TTntDBRichEdit.EditingChange(Sender: TObject);
1614begin
1615  inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
1616end;
1617
1618procedure TTntDBRichEdit.InternalSaveMemo;
1619var
1620  Stream: TStringStream{TNT-ALLOW TStringStream};
1621begin
1622  if PlainText then
1623    SetAsWideString(Field, Text)
1624  else begin
1625    Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
1626    try
1627      Lines.SaveToStream(Stream);
1628      Field.AsString{TNT-ALLOW AsString} := Stream.DataString;
1629    finally
1630      Stream.Free;
1631    end;
1632  end;
1633end;
1634
1635procedure TTntDBRichEdit.UpdateData(Sender: TObject);
1636begin
1637  if FieldIsBlobLike(Field) then
1638    InternalSaveMemo
1639  else
1640    SetAsWideString(Field, Text);
1641end;
1642
1643procedure TTntDBRichEdit.SetFocused(Value: Boolean);
1644begin
1645  if FFocused <> Value then
1646  begin
1647    FFocused := Value;
1648    if not Assigned(Field) or not FieldIsBlobLike(Field) then
1649      FDataLink.Reset;
1650  end;
1651end;
1652
1653procedure TTntDBRichEdit.CMEnter(var Message: TCMEnter);
1654begin
1655  SetFocused(True);
1656  inherited;
1657end;
1658
1659procedure TTntDBRichEdit.CMExit(var Message: TCMExit);
1660begin
1661  try
1662    FDataLink.UpdateRecord;
1663  except
1664    SetFocus;
1665    raise;
1666  end;
1667  SetFocused(False);
1668  inherited;
1669end;
1670
1671procedure TTntDBRichEdit.SetAutoDisplay(Value: Boolean);
1672begin
1673  if FAutoDisplay <> Value then
1674  begin
1675    FAutoDisplay := Value;
1676    if Value then LoadMemo;
1677  end;
1678end;
1679
1680procedure TTntDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
1681begin
1682  if not FMemoLoaded then LoadMemo else inherited;
1683end;
1684
1685procedure TTntDBRichEdit.WMCut(var Message: TMessage);
1686begin
1687  BeginEditing;
1688  inherited;
1689end;
1690
1691procedure TTntDBRichEdit.WMPaste(var Message: TMessage);
1692begin
1693  BeginEditing;
1694  inherited;
1695end;
1696
1697procedure TTntDBRichEdit.CMGetDataLink(var Message: TMessage);
1698begin
1699  Message.Result := Integer(FDataLink);
1700end;
1701
1702function TTntDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
1703begin
1704  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
1705    FDataLink.ExecuteAction(Action);
1706end;
1707
1708function TTntDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
1709begin
1710  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
1711    FDataLink.UpdateAction(Action);
1712end;
1713
1714{ TTntDBMemo }
1715
1716constructor TTntDBMemo.Create(AOwner: TComponent);
1717begin
1718  inherited Create(AOwner);
1719  inherited ReadOnly := True;
1720  ControlStyle := ControlStyle + [csReplicatable];
1721  FAutoDisplay := True;
1722  FDataLink := TFieldDataLink.Create;
1723  FDataLink.Control := Self;
1724  FDataLink.OnDataChange := DataChange;
1725  FDataLink.OnEditingChange := EditingChange;
1726  FDataLink.OnUpdateData := UpdateData;
1727  FPaintControl := TTntPaintControl.Create(Self, 'EDIT');
1728end;
1729
1730destructor TTntDBMemo.Destroy;
1731begin
1732  FPaintControl.Free;
1733  FDataLink.Free;
1734  FDataLink := nil;
1735  inherited Destroy;
1736end;
1737
1738procedure TTntDBMemo.Loaded;
1739begin
1740  inherited Loaded;
1741  if (csDesigning in ComponentState) then DataChange(Self);
1742end;
1743
1744procedure TTntDBMemo.Notification(AComponent: TComponent;
1745  Operation: TOperation);
1746begin
1747  inherited Notification(AComponent, Operation);
1748  if (Operation = opRemove) and (FDataLink <> nil) and
1749    (AComponent = DataSource) then DataSource := nil;
1750end;
1751
1752function TTntDBMemo.UseRightToLeftAlignment: Boolean;
1753begin
1754  Result := DBUseRightToLeftAlignment(Self, Field);
1755end;
1756
1757procedure TTntDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
1758begin
1759  inherited KeyDown(Key, Shift);
1760  if FMemoLoaded then
1761  begin
1762    if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
1763      FDataLink.Edit;
1764  end;
1765end;
1766
1767procedure TTntDBMemo.KeyPress(var Key: Char{TNT-ALLOW Char});
1768begin
1769  inherited KeyPress(Key);
1770  if FMemoLoaded then
1771  begin
1772    if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
1773      not FDataLink.Field.IsValidChar(Key) then
1774    begin
1775      MessageBeep(0);
1776      Key := #0;
1777    end;
1778    case Key of
1779      ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
1780        FDataLink.Edit;
1781      #27:
1782        FDataLink.Reset;
1783    end;
1784  end else
1785  begin
1786    if Key = #13 then LoadMemo;
1787    Key := #0;
1788  end;
1789end;
1790
1791procedure TTntDBMemo.Change;
1792begin
1793  if FMemoLoaded then FDataLink.Modified;
1794  FMemoLoaded := True;
1795  inherited Change;
1796end;
1797
1798function TTntDBMemo.GetDataSource: TDataSource;
1799begin
1800  Result := FDataLink.DataSource;
1801end;
1802
1803procedure TTntDBMemo.SetDataSource(Value: TDataSource);
1804begin
1805  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
1806    FDataLink.DataSource := Value;
1807  if Value <> nil then Value.FreeNotification(Self);
1808end;
1809
1810function TTntDBMemo.GetDataField: WideString;
1811begin
1812  Result := FDataLink.FieldName;
1813end;
1814
1815procedure TTntDBMemo.SetDataField(const Value: WideString);
1816begin
1817  FDataLink.FieldName := Value;
1818end;
1819
1820function TTntDBMemo.GetReadOnly: Boolean;
1821begin
1822  Result := FDataLink.ReadOnly;
1823end;
1824
1825procedure TTntDBMemo.SetReadOnly(Value: Boolean);
1826begin
1827  FDataLink.ReadOnly := Value;
1828end;
1829
1830function TTntDBMemo.GetField: TField;
1831begin
1832  Result := FDataLink.Field;
1833end;
1834
1835procedure TTntDBMemo.LoadMemo;
1836begin
1837  if not FMemoLoaded and Assigned(FDataLink.Field) and FieldIsBlobLike(FDataLink.Field) then
1838  begin
1839    try
1840      Lines.Text := GetAsWideString(FDataLink.Field);
1841      FMemoLoaded := True;
1842    except
1843      { Memo too large }
1844      on E:EInvalidOperation do
1845        Lines.Text := WideFormat('(%s)', [E.Message]);
1846    end;
1847    EditingChange(Self);
1848  end;
1849end;
1850
1851procedure TTntDBMemo.DataChange(Sender: TObject);
1852begin
1853  if FDataLink.Field <> nil then
1854    if FieldIsBlobLike(FDataLink.Field) then
1855    begin
1856      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
1857      begin
1858        FMemoLoaded := False;
1859        LoadMemo;
1860      end else
1861      begin
1862        Text := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
1863        FMemoLoaded := False;
1864        EditingChange(Self);
1865      end;
1866    end else
1867    begin
1868      if FFocused and FDataLink.CanModify then
1869        Text := GetWideText(FDataLink.Field)
1870      else
1871        Text := GetWideDisplayText(FDataLink.Field);
1872      FMemoLoaded := True;
1873    end
1874  else
1875  begin
1876    if csDesigning in ComponentState then Text := Name else Text := '';
1877    FMemoLoaded := False;
1878  end;
1879  if HandleAllocated then
1880    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
1881end;
1882
1883procedure TTntDBMemo.EditingChange(Sender: TObject);
1884begin
1885  inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
1886end;
1887
1888procedure TTntDBMemo.UpdateData(Sender: TObject);
1889begin
1890  SetAsWideString(FDataLink.Field, Text);
1891end;
1892
1893procedure TTntDBMemo.SetFocused(Value: Boolean);
1894begin
1895  if FFocused <> Value then
1896  begin
1897    FFocused := Value;
1898    if not Assigned(FDataLink.Field) or not FieldIsBlobLike(FDataLink.Field) then
1899      FDataLink.Reset;
1900  end;
1901end;
1902
1903procedure TTntDBMemo.WndProc(var Message: TMessage);
1904begin
1905  with Message do
1906    if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
1907      (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
1908  inherited;
1909end;
1910
1911procedure TTntDBMemo.CMEnter(var Message: TCMEnter);
1912begin
1913  SetFocused(True);
1914  inherited;
1915end;
1916
1917procedure TTntDBMemo.CMExit(var Message: TCMExit);
1918begin
1919  try
1920    FDataLink.UpdateRecord;
1921  except
1922    SetFocus;
1923    raise;
1924  end;
1925  SetFocused(False);
1926  inherited;
1927end;
1928
1929procedure TTntDBMemo.SetAutoDisplay(Value: Boolean);
1930begin
1931  if FAutoDisplay <> Value then
1932  begin
1933    FAutoDisplay := Value;
1934    if Value then LoadMemo;
1935  end;
1936end;
1937
1938procedure TTntDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
1939begin
1940  if not FMemoLoaded then LoadMemo else inherited;
1941end;
1942
1943procedure TTntDBMemo.WMCut(var Message: TMessage);
1944begin
1945  FDataLink.Edit;
1946  inherited;
1947end;
1948
1949procedure TTntDBMemo.WMUndo(var Message: TMessage);
1950begin
1951  FDataLink.Edit;
1952  inherited;
1953end;
1954
1955procedure TTntDBMemo.WMPaste(var Message: TMessage);
1956begin
1957  FDataLink.Edit;
1958  inherited;
1959end;
1960
1961procedure TTntDBMemo.CMGetDataLink(var Message: TMessage);
1962begin
1963  Message.Result := Integer(FDataLink);
1964end;
1965
1966procedure TTntDBMemo.WMPaint(var Message: TWMPaint);
1967var
1968  S: WideString;
1969begin
1970  if not (csPaintCopy in ControlState) then
1971    inherited
1972  else begin
1973    if FDataLink.Field <> nil then
1974      if FieldIsBlobLike(FDataLink.Field) then
1975      begin
1976        if FAutoDisplay then
1977          S := TntAdjustLineBreaks(GetAsWideString(FDataLink.Field)) else
1978          S := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
1979      end else
1980        S := GetWideDisplayText(FDataLink.Field);
1981    if (not Win32PlatformIsUnicode) then
1982      SendMessageA(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PAnsiChar(AnsiString(S))))
1983    else begin
1984      SendMessageW(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PWideChar(S)));
1985    end;
1986    SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Integer(Message.DC), 0);
1987    SendMessage(FPaintControl.Handle, WM_PAINT, Integer(Message.DC), 0);
1988  end;
1989end;
1990
1991function TTntDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
1992begin
1993  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
1994    FDataLink.ExecuteAction(Action);
1995end;
1996
1997function TTntDBMemo.UpdateAction(Action: TBasicAction): Boolean;
1998begin
1999  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
2000    FDataLink.UpdateAction(Action);
2001end;
2002
2003{ TTntDBRadioGroup }
2004
2005constructor TTntDBRadioGroup.Create(AOwner: TComponent);
2006begin
2007  inherited Create(AOwner);
2008  FDataLink := TFieldDataLink.Create;
2009  FDataLink.Control := Self;
2010  FDataLink.OnDataChange := DataChange;
2011  FDataLink.OnUpdateData := UpdateData;
2012  FValues := TTntStringList.Create;
2013end;
2014
2015destructor TTntDBRadioGroup.Destroy;
2016begin
2017  FDataLink.Free;
2018  FDataLink := nil;
2019  FValues.Free;
2020  inherited Destroy;
2021end;
2022
2023procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
2024  Operation: TOperation);
2025begin
2026  inherited Notification(AComponent, Operation);
2027  if (Operation = opRemove) and (FDataLink <> nil) and
2028    (AComponent = DataSource) then DataSource := nil;
2029end;
2030
2031function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
2032begin
2033  Result := inherited UseRightToLeftAlignment;
2034end;
2035
2036procedure TTntDBRadioGroup.DataChange(Sender: TObject);
2037begin
2038  if FDataLink.Field <> nil then
2039    Value := GetWideText(FDataLink.Field) else
2040    Value := '';
2041end;
2042
2043procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
2044begin
2045  if FDataLink.Field <> nil then
2046    SetWideText(FDataLink.Field, Value);
2047end;
2048
2049function TTntDBRadioGroup.GetDataSource: TDataSource;
2050begin
2051  Result := FDataLink.DataSource;
2052end;
2053
2054procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
2055begin
2056  FDataLink.DataSource := Value;
2057  if Value <> nil then Value.FreeNotification(Self);
2058end;
2059
2060function TTntDBRadioGroup.GetDataField: WideString;
2061begin
2062  Result := FDataLink.FieldName;
2063end;
2064
2065procedure TTntDBRadioGroup.SetDataField(const Value: WideString);
2066begin
2067  FDataLink.FieldName := Value;
2068end;
2069
2070function TTntDBRadioGroup.GetReadOnly: Boolean;
2071begin
2072  Result := FDataLink.ReadOnly;
2073end;
2074
2075procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
2076begin
2077  FDataLink.ReadOnly := Value;
2078end;
2079
2080function TTntDBRadioGroup.GetField: TField;
2081begin
2082  Result := FDataLink.Field;
2083end;
2084
2085function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
2086begin
2087  if (Index < FValues.Count) and (FValues[Index] <> '') then
2088    Result := FValues[Index]
2089  else if Index < Items.Count then
2090    Result := Items[Index]
2091  else
2092    Result := '';
2093end;
2094
2095procedure TTntDBRadioGroup.SetValue(const Value: WideString);
2096var
2097  WasFocused: Boolean;
2098  I, Index: Integer;
2099begin
2100  if FValue <> Value then
2101  begin
2102    FInSetValue := True;
2103    try
2104      WasFocused := (ItemIndex > -1) and (Buttons[ItemIndex].Focused);
2105      Index := -1;
2106      for I := 0 to Items.Count - 1 do
2107        if Value = GetButtonValue(I) then
2108        begin
2109          Index := I;
2110          Break;
2111        end;
2112      ItemIndex := Index;
2113      // Move the focus rect along with the selected index
2114      if WasFocused then
2115        Buttons[ItemIndex].SetFocus;
2116    finally
2117      FInSetValue := False;
2118    end;
2119    FValue := Value;
2120    Change;
2121  end;
2122end;
2123
2124procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
2125begin
2126  try
2127    FDataLink.UpdateRecord;
2128  except
2129    if ItemIndex >= 0 then
2130      (Controls[ItemIndex] as TTntRadioButton).SetFocus else
2131      (Controls[0] as TTntRadioButton).SetFocus;
2132    raise;
2133  end;
2134  inherited;
2135end;
2136
2137procedure TTntDBRadioGroup.CMGetDataLink(var Message: TMessage);
2138begin
2139  Message.Result := Integer(FDataLink);
2140end;
2141
2142procedure TTntDBRadioGroup.Click;
2143begin
2144  if not FInSetValue then
2145  begin
2146    inherited Click;
2147    if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
2148    if FDataLink.Editing then FDataLink.Modified;
2149  end;
2150end;
2151
2152procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
2153begin
2154  Items.Assign(Value);
2155  DataChange(Self);
2156end;
2157
2158procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
2159begin
2160  FValues.Assign(Value);
2161  DataChange(Self);
2162end;
2163
2164procedure TTntDBRadioGroup.Change;
2165begin
2166  if Assigned(FOnChange) then FOnChange(Self);
2167end;
2168
2169procedure TTntDBRadioGroup.KeyPress(var Key: Char{TNT-ALLOW Char});
2170begin
2171  inherited KeyPress(Key);
2172  case Key of
2173    #8, ' ': FDataLink.Edit;
2174    #27: FDataLink.Reset;
2175  end;
2176end;
2177
2178function TTntDBRadioGroup.CanModify: Boolean;
2179begin
2180  Result := FDataLink.Edit;
2181end;
2182
2183function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
2184begin
2185  Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
2186    DataLink.ExecuteAction(Action);
2187end;
2188
2189function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
2190begin
2191  Result := inherited UpdateAction(Action) or (DataLink <> nil) and
2192    DataLink.UpdateAction(Action);
2193end;
2194
2195end.
Note: See TracBrowser for help on using the repository browser.