source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntDBCtrls.pas@ 541

Last change on this file since 541 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69
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.