summaryrefslogtreecommitdiff
path: root/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas')
-rw-r--r--plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas2195
1 files changed, 2195 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
new file mode 100644
index 0000000000..49111d4aba
--- /dev/null
+++ b/plugins/!NotAdopted/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
@@ -0,0 +1,2195 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://www.tntware.com/delphicontrols/unicode/ }
+{ Version: 2.3.0 }
+{ }
+{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
+{ }
+{*****************************************************************************}
+
+unit TntDBCtrls;
+
+{$INCLUDE TntCompilers.inc}
+
+interface
+
+uses
+ Classes, Windows, Messages, DB, DBCtrls, Controls, StdCtrls,
+ TntClasses, TntStdCtrls, TntControls, TntComCtrls, TntExtCtrls;
+
+type
+{TNT-WARN TPaintControl}
+ TTntPaintControl = class
+ private
+ FOwner: TWinControl;
+ FClassName: WideString;
+ FHandle: HWnd;
+ FObjectInstance: Pointer;
+ FDefWindowProc: Pointer;
+ FCtl3dButton: Boolean;
+ function GetHandle: HWnd;
+ procedure SetCtl3DButton(Value: Boolean);
+ procedure WndProc(var Message: TMessage);
+ public
+ constructor Create(AOwner: TWinControl; const ClassName: WideString);
+ destructor Destroy; override;
+ procedure DestroyHandle;
+ property Ctl3DButton: Boolean read FCtl3dButton write SetCtl3dButton;
+ property Handle: HWnd read GetHandle;
+ end;
+
+type
+{TNT-WARN TDBEdit}
+ TTntDBEdit = class(TDBEdit{TNT-ALLOW TDBEdit})
+ private
+ InheritedDataChange: TNotifyEvent;
+ FPasswordChar: WideChar;
+ procedure DataChange(Sender: TObject);
+ procedure UpdateData(Sender: TObject);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+ function GetTextMargins: TPoint;
+ function GetPasswordChar: WideChar;
+ procedure SetPasswordChar(const Value: WideChar);
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ private
+ function GetSelStart: Integer; reintroduce; virtual;
+ procedure SetSelStart(const Value: Integer); reintroduce; virtual;
+ function GetSelLength: Integer; reintroduce; virtual;
+ procedure SetSelLength(const Value: Integer); reintroduce; virtual;
+ function GetSelText: WideString; reintroduce;
+ procedure SetSelText(const Value: WideString);
+ function GetText: WideString;
+ procedure SetText(const Value: WideString);
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure CreateWnd; override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property SelText: WideString read GetSelText write SetSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
+ property Text: WideString read GetText write SetText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
+ end;
+
+{TNT-WARN TDBText}
+ TTntDBText = class(TDBText{TNT-ALLOW TDBText})
+ private
+ FDataLink: TFieldDataLink;
+ InheritedDataChange: TNotifyEvent;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
+ procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
+ function GetCaption: TWideCaption;
+ function IsCaptionStored: Boolean;
+ procedure SetCaption(const Value: TWideCaption);
+ function GetFieldText: WideString;
+ procedure DataChange(Sender: TObject);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetLabelText: WideString; reintroduce; virtual;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TDBComboBox}
+ TTntCustomDBComboBox = class(TDBComboBox{TNT-ALLOW TDBComboBox},
+ IWideCustomListControl)
+ private
+ FDataLink: TFieldDataLink;
+ FFilter: WideString;
+ FLastTime: Cardinal;
+ procedure UpdateData(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure SetReadOnly;
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsHintStored: Boolean;
+ procedure WMChar(var Message: TWMChar); message WM_CHAR;
+ private
+ FItems: TTntStrings;
+ FSaveItems: TTntStrings;
+ FSaveItemIndex: integer;
+ function GetItems: TTntStrings;
+ procedure SetItems(const Value: TTntStrings); reintroduce;
+ function GetSelStart: Integer;
+ procedure SetSelStart(const Value: Integer);
+ function GetSelLength: Integer;
+ procedure SetSelLength(const Value: Integer);
+ function GetSelText: WideString;
+ procedure SetSelText(const Value: WideString);
+ function GetText: WideString;
+ procedure SetText(const Value: WideString);
+
+ procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
+ protected
+ procedure DataChange(Sender: TObject);
+ function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
+ function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
+ procedure DoEditCharMsg(var Message: TWMChar); virtual;
+ function GetFieldValue: Variant; virtual;
+ procedure SetFieldValue(const Value: Variant); virtual;
+ function GetComboValue: Variant; virtual; abstract;
+ procedure SetComboValue(const Value: Variant); virtual; abstract;
+ {$IFDEF DELPHI_7} // fix for Delphi 7 only
+ function GetItemsClass: TCustomComboBoxStringsClass; override;
+ {$ENDIF}
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure CreateWnd; override;
+ procedure DestroyWnd; override;
+ procedure WndProc(var Message: TMessage); override;
+ procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
+ procedure KeyPress(var Key: AnsiChar); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure CopySelection(Destination: TCustomListControl); override;
+ procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
+ public
+ property SelText: WideString read GetSelText write SetSelText;
+ property SelStart: Integer read GetSelStart write SetSelStart;
+ property SelLength: Integer read GetSelLength write SetSelLength;
+ property Text: WideString read GetText write SetText;
+ published
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ property Items: TTntStrings read GetItems write SetItems;
+ end;
+
+ TTntDBComboBox = class(TTntCustomDBComboBox)
+ protected
+ function GetFieldValue: Variant; override;
+ procedure SetFieldValue(const Value: Variant); override;
+ function GetComboValue: Variant; override;
+ procedure SetComboValue(const Value: Variant); override;
+ end;
+
+type
+{TNT-WARN TDBCheckBox}
+ TTntDBCheckBox = class(TDBCheckBox{TNT-ALLOW TDBCheckBox})
+ private
+ function GetCaption: TWideCaption;
+ procedure SetCaption(const Value: TWideCaption);
+ function GetHint: WideString;
+ procedure SetHint(const Value: WideString);
+ function IsCaptionStored: Boolean;
+ function IsHintStored: Boolean;
+ protected
+ procedure CreateWindowHandle(const Params: TCreateParams); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetActionLinkClass: TControlActionLinkClass; override;
+ procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
+ procedure Toggle; override;
+ published
+ property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
+ property Hint: WideString read GetHint write SetHint stored IsHintStored;
+ end;
+
+{TNT-WARN TDBRichEdit}
+ TTntDBRichEdit = class(TTntCustomRichEdit)
+ private
+ FDataLink: TFieldDataLink;
+ FAutoDisplay: Boolean;
+ FFocused: Boolean;
+ FMemoLoaded: Boolean;
+ FDataSave: AnsiString;
+ procedure BeginEditing;
+ procedure DataChange(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ function GetDataField: WideString;
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ procedure SetDataField(const Value: WideString);
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetAutoDisplay(Value: Boolean);
+ procedure SetFocused(Value: Boolean);
+ procedure UpdateData(Sender: TObject);
+ procedure WMCut(var Message: TMessage); message WM_CUT;
+ procedure WMPaste(var Message: TMessage); message WM_PASTE;
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+ protected
+ procedure InternalLoadMemo; dynamic;
+ procedure InternalSaveMemo; dynamic;
+ protected
+ procedure Change; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: AnsiChar); override;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ procedure LoadMemo; virtual;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property Color;
+ property Constraints;
+ property Ctl3D;
+ property DataField: WideString read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property HideScrollBars;
+ property ImeMode;
+ property ImeName;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PlainText;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+ property WantReturns;
+ property WantTabs;
+ property WordWrap;
+ property OnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnResizeRequest;
+ property OnSelectionChange;
+ property OnProtectChange;
+ property OnSaveClipboard;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+type
+{TNT-WARN TDBMemo}
+ TTntDBMemo = class(TTntCustomMemo)
+ private
+ FDataLink: TFieldDataLink;
+ FAutoDisplay: Boolean;
+ FFocused: Boolean;
+ FMemoLoaded: Boolean;
+ FPaintControl: TTntPaintControl;
+ procedure DataChange(Sender: TObject);
+ procedure EditingChange(Sender: TObject);
+ function GetDataField: WideString;
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ procedure SetDataField(const Value: WideString);
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetAutoDisplay(Value: Boolean);
+ procedure SetFocused(Value: Boolean);
+ procedure UpdateData(Sender: TObject);
+ procedure WMCut(var Message: TMessage); message WM_CUT;
+ procedure WMPaste(var Message: TMessage); message WM_PASTE;
+ procedure WMUndo(var Message: TMessage); message WM_UNDO;
+ procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
+ procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ protected
+ procedure Change; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ procedure WndProc(var Message: TMessage); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ procedure LoadMemo; virtual;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ published
+ property Align;
+ property Alignment;
+ property Anchors;
+ property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
+ property BevelEdges;
+ property BevelInner;
+ property BevelOuter;
+ property BevelKind;
+ property BevelWidth;
+ property BiDiMode;
+ property BorderStyle;
+ property Color;
+ property Constraints;
+ property Ctl3D;
+ property DataField: WideString read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property HideSelection;
+ property ImeMode;
+ property ImeName;
+ property MaxLength;
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ScrollBars;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+ property WantReturns;
+ property WantTabs;
+ property WordWrap;
+ property OnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ {$IFDEF COMPILER_9_UP}
+ property OnMouseActivate;
+ {$ENDIF}
+ property OnMouseDown;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+{ TDBRadioGroup }
+type
+ TTntDBRadioGroup = class(TTntCustomRadioGroup)
+ private
+ FDataLink: TFieldDataLink;
+ FValue: WideString;
+ FValues: TTntStrings;
+ FInSetValue: Boolean;
+ FOnChange: TNotifyEvent;
+ procedure DataChange(Sender: TObject);
+ procedure UpdateData(Sender: TObject);
+ function GetDataField: WideString;
+ function GetDataSource: TDataSource;
+ function GetField: TField;
+ function GetReadOnly: Boolean;
+ function GetButtonValue(Index: Integer): WideString;
+ procedure SetDataField(const Value: WideString);
+ procedure SetDataSource(Value: TDataSource);
+ procedure SetReadOnly(Value: Boolean);
+ procedure SetValue(const Value: WideString);
+ procedure SetItems(Value: TTntStrings);
+ procedure SetValues(Value: TTntStrings);
+ procedure CMExit(var Message: TCMExit); message CM_EXIT;
+ procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
+ protected
+ procedure Change; dynamic;
+ procedure Click; override;
+ procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
+ function CanModify: Boolean; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ property DataLink: TFieldDataLink read FDataLink;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ExecuteAction(Action: TBasicAction): Boolean; override;
+ function UpdateAction(Action: TBasicAction): Boolean; override;
+ function UseRightToLeftAlignment: Boolean; override;
+ property Field: TField read GetField;
+ property ItemIndex;
+ property Value: WideString read FValue write SetValue;
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Caption;
+ property Color;
+ property Columns;
+ property Constraints;
+ property Ctl3D;
+ property DataField: WideString read GetDataField write SetDataField;
+ property DataSource: TDataSource read GetDataSource write SetDataSource;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property Items write SetItems;
+ {$IFDEF COMPILER_7_UP}
+ property ParentBackground;
+ {$ENDIF}
+ property ParentBiDiMode;
+ property ParentColor;
+ property ParentCtl3D;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Values: TTntStrings read FValues write SetValues;
+ property Visible;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnContextPopup;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDock;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ {$IFDEF COMPILER_10_UP}
+ property OnMouseEnter;
+ property OnMouseLeave;
+ {$ENDIF}
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+implementation
+
+uses
+ Forms, SysUtils, Graphics, Variants, TntDB,
+ TntActnList, TntGraphics, TntSysUtils, RichEdit, Mask;
+
+function FieldIsBlobLike(Field: TField): Boolean;
+begin
+ Result := False;
+ if Assigned(Field) then begin
+ if (Field.IsBlob)
+ or (Field.DataType in [Low(TBlobType).. High(TBlobType)]) then
+ Result := True
+ else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
+ and (Field.Size = MaxInt) then
+ Result := True; { wide string field filling in for a blob field }
+ end;
+end;
+
+{ TTntPaintControl }
+
+type
+ TAccessWinControl = class(TWinControl);
+
+constructor TTntPaintControl.Create(AOwner: TWinControl; const ClassName: WideString);
+begin
+ FOwner := AOwner;
+ FClassName := ClassName;
+end;
+
+destructor TTntPaintControl.Destroy;
+begin
+ DestroyHandle;
+end;
+
+procedure TTntPaintControl.DestroyHandle;
+begin
+ if FHandle <> 0 then DestroyWindow(FHandle);
+ Classes.FreeObjectInstance(FObjectInstance);
+ FHandle := 0;
+ FObjectInstance := nil;
+end;
+
+function TTntPaintControl.GetHandle: HWnd;
+var
+ Params: TCreateParams;
+begin
+ if FHandle = 0 then
+ begin
+ FObjectInstance := Classes.MakeObjectInstance(WndProc);
+ TAccessWinControl(FOwner).CreateParams(Params);
+ Params.Style := Params.Style and not (WS_HSCROLL or WS_VSCROLL);
+ if (not Win32PlatformIsUnicode) then begin
+ with Params do
+ FHandle := CreateWindowEx(ExStyle, PAnsiChar(AnsiString(FClassName)),
+ PAnsiChar(TAccessWinControl(FOwner).Text), Style or WS_VISIBLE,
+ X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
+ FDefWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
+ SetWindowLong(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
+ end else begin
+ with Params do
+ FHandle := CreateWindowExW(ExStyle, PWideChar(FClassName),
+ PWideChar(TntControl_GetText(FOwner)), Style or WS_VISIBLE,
+ X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
+ FDefWindowProc := Pointer(GetWindowLongW(FHandle, GWL_WNDPROC));
+ SetWindowLongW(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
+ end;
+ SendMessage(FHandle, WM_SETFONT, Integer(TAccessWinControl(FOwner).Font.Handle), 1);
+ end;
+ Result := FHandle;
+end;
+
+procedure TTntPaintControl.SetCtl3DButton(Value: Boolean);
+begin
+ if FHandle <> 0 then DestroyHandle;
+ FCtl3DButton := Value;
+end;
+
+procedure TTntPaintControl.WndProc(var Message: TMessage);
+begin
+ with Message do
+ if (Msg >= CN_CTLCOLORMSGBOX) and (Msg <= CN_CTLCOLORSTATIC) then
+ Result := FOwner.Perform(Msg, WParam, LParam)
+ else if (not Win32PlatformIsUnicode) then
+ Result := CallWindowProcA(FDefWindowProc, FHandle, Msg, WParam, LParam)
+ else
+ Result := CallWindowProcW(FDefWindowProc, FHandle, Msg, WParam, LParam);
+end;
+
+{ THackFieldDataLink }
+type
+ THackFieldDataLink_D6_D7_D9 = class(TDataLink)
+ protected
+ FxxxField: TField;
+ FxxxFieldName: string{TNT-ALLOW string};
+ FxxxControl: TComponent;
+ FxxxEditing: Boolean;
+ FModified: Boolean;
+ end;
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+ THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+ THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+ THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+ THackFieldDataLink = class(TDataLink)
+ protected
+ FxxxField: TField;
+ FxxxFieldName: WideString;
+ FxxxControl: TComponent;
+ FxxxEditing: Boolean;
+ FModified: Boolean;
+ end;
+{$ENDIF}
+
+{ TTntDBEdit }
+
+type
+ THackDBEdit_D6_D7_D9 = class(TCustomMaskEdit)
+ protected
+ FDataLink: TFieldDataLink;
+ FCanvas: TControlCanvas;
+ FAlignment: TAlignment;
+ FFocused: Boolean;
+ end;
+
+{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
+ THackDBEdit = THackDBEdit_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
+ THackDBEdit = THackDBEdit_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
+ THackDBEdit = THackDBEdit_D6_D7_D9;
+{$ENDIF}
+{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
+ THackDBEdit = THackDBEdit_D6_D7_D9;
+{$ENDIF}
+
+constructor TTntDBEdit.Create(AOwner: TComponent);
+begin
+ inherited;
+ InheritedDataChange := THackDBEdit(Self).FDataLink.OnDataChange;
+ THackDBEdit(Self).FDataLink.OnDataChange := DataChange;
+ THackDBEdit(Self).FDataLink.OnUpdateData := UpdateData;
+end;
+
+procedure TTntDBEdit.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'EDIT');
+end;
+
+procedure TTntDBEdit.CreateWnd;
+begin
+ inherited;
+ TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
+end;
+
+procedure TTntDBEdit.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBEdit.GetSelStart: Integer;
+begin
+ Result := TntCustomEdit_GetSelStart(Self);
+end;
+
+procedure TTntDBEdit.SetSelStart(const Value: Integer);
+begin
+ TntCustomEdit_SetSelStart(Self, Value);
+end;
+
+function TTntDBEdit.GetSelLength: Integer;
+begin
+ Result := TntCustomEdit_GetSelLength(Self);
+end;
+
+procedure TTntDBEdit.SetSelLength(const Value: Integer);
+begin
+ TntCustomEdit_SetSelLength(Self, Value);
+end;
+
+function TTntDBEdit.GetSelText: WideString;
+begin
+ Result := TntCustomEdit_GetSelText(Self);
+end;
+
+procedure TTntDBEdit.SetSelText(const Value: WideString);
+begin
+ TntCustomEdit_SetSelText(Self, Value);
+end;
+
+function TTntDBEdit.GetPasswordChar: WideChar;
+begin
+ Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar)
+end;
+
+procedure TTntDBEdit.SetPasswordChar(const Value: WideChar);
+begin
+ TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
+end;
+
+function TTntDBEdit.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntDBEdit.SetText(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntDBEdit.DataChange(Sender: TObject);
+begin
+ with THackDBEdit(Self), Self do begin
+ if Field = nil then
+ InheritedDataChange(Sender)
+ else begin
+ if FAlignment <> Field.Alignment then
+ begin
+ EditText := ''; {forces update}
+ FAlignment := Field.Alignment;
+ end;
+ EditMask := Field.EditMask;
+ if not (csDesigning in ComponentState) then
+ begin
+ if (Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
+ MaxLength := Field.Size;
+ end;
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(Field)
+ else
+ begin
+ Text := GetWideDisplayText(Field);
+ if FDataLink.Editing and THackFieldDataLink(FDataLink).FModified then
+ Modified := True;
+ end;
+ end;
+ end;
+end;
+
+procedure TTntDBEdit.UpdateData(Sender: TObject);
+begin
+ ValidateEdit;
+ SetWideText(Field, Text);
+end;
+
+procedure TTntDBEdit.CMEnter(var Message: TCMEnter);
+var
+ SaveFarEast: Boolean;
+begin
+ SaveFarEast := SysLocale.FarEast;
+ try
+ SysLocale.FarEast := False;
+ inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
+ finally
+ SysLocale.FarEast := SaveFarEast;
+ end;
+end;
+
+function TTntDBEdit.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBEdit.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBEdit.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBEdit.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+procedure TTntDBEdit.WMPaint(var Message: TWMPaint);
+const
+ AlignStyle : array[Boolean, TAlignment] of DWORD =
+ ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
+ (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
+var
+ ALeft: Integer;
+ _Margins: TPoint;
+ R: TRect;
+ DC: HDC;
+ PS: TPaintStruct;
+ S: WideString;
+ AAlignment: TAlignment;
+ I: Integer;
+begin
+ with THackDBEdit(Self), Self do begin
+ AAlignment := FAlignment;
+ if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
+ if ((AAlignment = taLeftJustify) or FFocused) and (not (csPaintCopy in ControlState))
+ or (not Win32PlatformIsUnicode) then
+ begin
+ inherited;
+ Exit;
+ end;
+ { Since edit controls do not handle justification unless multi-line (and
+ then only poorly) we will draw right and center justify manually unless
+ the edit has the focus. }
+ if FCanvas = nil then
+ begin
+ FCanvas := TControlCanvas.Create;
+ FCanvas.Control := Self;
+ end;
+ DC := Message.DC;
+ if DC = 0 then DC := BeginPaint(Handle, PS);
+ FCanvas.Handle := DC;
+ try
+ FCanvas.Font := Font;
+ with FCanvas do
+ begin
+ R := ClientRect;
+ if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
+ begin
+ Brush.Color := clWindowFrame;
+ FrameRect(R);
+ InflateRect(R, -1, -1);
+ end;
+ Brush.Color := Color;
+ if not Enabled then
+ Font.Color := clGrayText;
+ if (csPaintCopy in ControlState) and (Field <> nil) then
+ begin
+ S := GetWideDisplayText(Field);
+ case CharCase of
+ ecUpperCase:
+ S := Tnt_WideUpperCase(S);
+ ecLowerCase:
+ S := Tnt_WideLowerCase(S);
+ end;
+ end else
+ S := Text { EditText? };
+ if PasswordChar <> #0 then
+ for I := 1 to Length(S) do S[I] := PasswordChar;
+ _Margins := GetTextMargins;
+ case AAlignment of
+ taLeftJustify: ALeft := _Margins.X;
+ taRightJustify: ALeft := ClientWidth - WideCanvasTextWidth(FCanvas, S) - _Margins.X - 1;
+ else
+ ALeft := (ClientWidth - WideCanvasTextWidth(FCanvas, S)) div 2;
+ end;
+ if SysLocale.MiddleEast then UpdateTextFlags;
+ WideCanvasTextRect(FCanvas, R, ALeft, _Margins.Y, S);
+ end;
+ finally
+ FCanvas.Handle := 0;
+ if Message.DC = 0 then EndPaint(Handle, PS);
+ end;
+ end;
+end;
+
+function TTntDBEdit.GetTextMargins: TPoint;
+var
+ DC: HDC;
+ SaveFont: HFont;
+ I: Integer;
+ SysMetrics, Metrics: TTextMetric;
+begin
+ if NewStyleControls then
+ begin
+ if BorderStyle = bsNone then I := 0 else
+ if Ctl3D then I := 1 else I := 2;
+ Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
+ Result.Y := I;
+ end else
+ begin
+ if BorderStyle = bsNone then I := 0 else
+ begin
+ DC := GetDC(0);
+ GetTextMetrics(DC, SysMetrics);
+ SaveFont := SelectObject(DC, Font.Handle);
+ GetTextMetrics(DC, Metrics);
+ SelectObject(DC, SaveFont);
+ ReleaseDC(0, DC);
+ I := SysMetrics.tmHeight;
+ if I > Metrics.tmHeight then I := Metrics.tmHeight;
+ I := I div 4;
+ end;
+ Result.X := I;
+ Result.Y := I;
+ end;
+end;
+
+{ TTntDBText }
+
+constructor TTntDBText.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ InheritedDataChange := FDataLink.OnDataChange;
+ FDataLink.OnDataChange := DataChange;
+end;
+
+destructor TTntDBText.Destroy;
+begin
+ FDataLink := nil;
+ inherited;
+end;
+
+procedure TTntDBText.CMDialogChar(var Message: TCMDialogChar);
+begin
+ TntLabel_CMDialogChar(Self, Message, Caption);
+end;
+
+function TTntDBText.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self)
+end;
+
+function TTntDBText.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntDBText.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntDBText.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBText.GetLabelText: WideString;
+begin
+ if csPaintCopy in ControlState then
+ Result := GetFieldText
+ else
+ Result := Caption;
+end;
+
+procedure TTntDBText.DoDrawText(var Rect: TRect; Flags: Integer);
+begin
+ if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
+ inherited;
+end;
+
+function TTntDBText.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBText.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBText.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBText.CMHintShow(var Message: TMessage);
+begin
+ ProcessCMHintShowMsg(Message);
+ inherited;
+end;
+
+procedure TTntDBText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBText.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+function TTntDBText.GetFieldText: WideString;
+begin
+ if Field <> nil then
+ Result := GetWideDisplayText(Field)
+ else
+ if csDesigning in ComponentState then Result := Name else Result := '';
+end;
+
+procedure TTntDBText.DataChange(Sender: TObject);
+begin
+ Caption := GetFieldText;
+end;
+
+{ TTntCustomDBComboBox }
+
+constructor TTntCustomDBComboBox.Create(AOwner: TComponent);
+begin
+ inherited;
+ FItems := TTntComboBoxStrings.Create;
+ TTntComboBoxStrings(FItems).ComboBox := Self;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FDataLink.OnEditingChange := EditingChange;
+end;
+
+destructor TTntCustomDBComboBox.Destroy;
+begin
+ FreeAndNil(FItems);
+ FreeAndNil(FSaveItems);
+ FDataLink := nil;
+ inherited;
+end;
+
+procedure TTntCustomDBComboBox.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'COMBOBOX');
+end;
+
+procedure TTntCustomDBComboBox.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+type
+ TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
+
+procedure TTntCustomDBComboBox.CreateWnd;
+var
+ PreInheritedAnsiText: AnsiString;
+begin
+ PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
+ inherited;
+ TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
+end;
+
+procedure TTntCustomDBComboBox.DestroyWnd;
+var
+ SavedText: WideString;
+begin
+ if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
+ TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
+ inherited;
+ TntControl_SetStoredText(Self, SavedText);
+ end;
+end;
+
+procedure TTntCustomDBComboBox.SetReadOnly;
+begin
+ if (Style in [csDropDown, csSimple]) and HandleAllocated then
+ SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.CanModify), 0);
+end;
+
+procedure TTntCustomDBComboBox.EditingChange(Sender: TObject);
+begin
+ SetReadOnly;
+end;
+
+procedure TTntCustomDBComboBox.CMEnter(var Message: TCMEnter);
+var
+ SaveFarEast: Boolean;
+begin
+ SaveFarEast := SysLocale.FarEast;
+ try
+ SysLocale.FarEast := False;
+ inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
+ finally
+ SysLocale.FarEast := SaveFarEast;
+ end;
+end;
+
+procedure TTntCustomDBComboBox.WndProc(var Message: TMessage);
+begin
+ if (not (csDesigning in ComponentState))
+ and (Message.Msg = CB_SHOWDROPDOWN)
+ and (Message.WParam = 0)
+ and (not FDataLink.Editing) then begin
+ DataChange(Self); {Restore text}
+ Dispatch(Message); {Do NOT call inherited!}
+ end else
+ inherited WndProc(Message);
+end;
+
+procedure TTntCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
+begin
+ if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
+ inherited;
+end;
+
+procedure TTntCustomDBComboBox.KeyPress(var Key: AnsiChar);
+var
+ SaveAutoComplete: Boolean;
+begin
+ TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
+ try
+ inherited;
+ finally
+ TntCombo_AfterKeyPress(Self, SaveAutoComplete);
+ end;
+end;
+
+procedure TTntCustomDBComboBox.DoEditCharMsg(var Message: TWMChar);
+begin
+ TntCombo_AutoCompleteKeyPress(Self, Items, Message,
+ GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
+end;
+
+procedure TTntCustomDBComboBox.WMChar(var Message: TWMChar);
+begin
+ TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetItems: TTntStrings;
+begin
+ Result := FItems;
+end;
+
+procedure TTntCustomDBComboBox.SetItems(const Value: TTntStrings);
+begin
+ FItems.Assign(Value);
+ DataChange(Self);
+end;
+
+function TTntCustomDBComboBox.GetSelStart: Integer;
+begin
+ Result := TntCombo_GetSelStart(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelStart(const Value: Integer);
+begin
+ TntCombo_SetSelStart(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetSelLength: Integer;
+begin
+ Result := TntCombo_GetSelLength(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelLength(const Value: Integer);
+begin
+ TntCombo_SetSelLength(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetSelText: WideString;
+begin
+ Result := TntCombo_GetSelText(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetSelText(const Value: WideString);
+begin
+ TntCombo_SetSelText(Self, Value);
+end;
+
+function TTntCustomDBComboBox.GetText: WideString;
+begin
+ Result := TntControl_GetText(Self);
+end;
+
+procedure TTntCustomDBComboBox.SetText(const Value: WideString);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+procedure TTntCustomDBComboBox.CNCommand(var Message: TWMCommand);
+begin
+ if not TntCombo_CNCommand(Self, Items, Message) then
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetFieldValue: Variant;
+begin
+ Result := Field.Value;
+end;
+
+procedure TTntCustomDBComboBox.SetFieldValue(const Value: Variant);
+begin
+ Field.Value := Value;
+end;
+
+procedure TTntCustomDBComboBox.DataChange(Sender: TObject);
+begin
+ if not (Style = csSimple) and DroppedDown then Exit;
+ if Field <> nil then
+ SetComboValue(GetFieldValue)
+ else
+ if csDesigning in ComponentState then
+ SetComboValue(Name)
+ else
+ SetComboValue(Null);
+end;
+
+procedure TTntCustomDBComboBox.UpdateData(Sender: TObject);
+begin
+ SetFieldValue(GetComboValue);
+end;
+
+function TTntCustomDBComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
+begin
+ Result := True;
+end;
+
+function TTntCustomDBComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
+begin
+ Result := False;
+end;
+
+function TTntCustomDBComboBox.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntCustomDBComboBox.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntCustomDBComboBox.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntCustomDBComboBox.AddItem(const Item: WideString; AObject: TObject);
+begin
+ TntComboBox_AddItem(Items, Item, AObject);
+end;
+
+procedure TTntCustomDBComboBox.CopySelection(Destination: TCustomListControl);
+begin
+ TntComboBox_CopySelection(Items, ItemIndex, Destination);
+end;
+
+procedure TTntCustomDBComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntCustomDBComboBox.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{$IFDEF DELPHI_7} // fix for Delphi 7 only
+function TTntCustomDBComboBox.GetItemsClass: TCustomComboBoxStringsClass;
+begin
+ Result := TD7PatchedComboBoxStrings;
+end;
+{$ENDIF}
+
+{ TTntDBComboBox }
+
+function TTntDBComboBox.GetFieldValue: Variant;
+begin
+ Result := GetWideText(Field);
+end;
+
+procedure TTntDBComboBox.SetFieldValue(const Value: Variant);
+begin
+ SetWideText(Field, Value);
+end;
+
+procedure TTntDBComboBox.SetComboValue(const Value: Variant);
+var
+ I: Integer;
+ Redraw: Boolean;
+ OldValue: WideString;
+ NewValue: WideString;
+begin
+ OldValue := VarToWideStr(GetComboValue);
+ NewValue := VarToWideStr(Value);
+
+ if NewValue <> OldValue then
+ begin
+ if Style <> csDropDown then
+ begin
+ Redraw := (Style <> csSimple) and HandleAllocated;
+ if Redraw then Items.BeginUpdate;
+ try
+ if NewValue = '' then I := -1 else I := Items.IndexOf(NewValue);
+ ItemIndex := I;
+ finally
+ Items.EndUpdate;
+ end;
+ if I >= 0 then Exit;
+ end;
+ if Style in [csDropDown, csSimple] then Text := NewValue;
+ end;
+end;
+
+function TTntDBComboBox.GetComboValue: Variant;
+var
+ I: Integer;
+begin
+ if Style in [csDropDown, csSimple] then Result := Text else
+ begin
+ I := ItemIndex;
+ if I < 0 then Result := '' else Result := Items[I];
+ end;
+end;
+
+{ TTntDBCheckBox }
+
+procedure TTntDBCheckBox.CreateWindowHandle(const Params: TCreateParams);
+begin
+ CreateUnicodeHandle(Self, Params, 'BUTTON');
+end;
+
+procedure TTntDBCheckBox.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ TntPersistent_AfterInherited_DefineProperties(Filer, Self);
+end;
+
+function TTntDBCheckBox.IsCaptionStored: Boolean;
+begin
+ Result := TntControl_IsCaptionStored(Self);
+end;
+
+function TTntDBCheckBox.GetCaption: TWideCaption;
+begin
+ Result := TntControl_GetText(Self)
+end;
+
+procedure TTntDBCheckBox.SetCaption(const Value: TWideCaption);
+begin
+ TntControl_SetText(Self, Value);
+end;
+
+function TTntDBCheckBox.IsHintStored: Boolean;
+begin
+ Result := TntControl_IsHintStored(Self);
+end;
+
+function TTntDBCheckBox.GetHint: WideString;
+begin
+ Result := TntControl_GetHint(Self)
+end;
+
+procedure TTntDBCheckBox.SetHint(const Value: WideString);
+begin
+ TntControl_SetHint(Self, Value);
+end;
+
+procedure TTntDBCheckBox.Toggle;
+var
+ FDataLink: TDataLink;
+begin
+ inherited;
+ FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
+ FDataLink.UpdateRecord;
+end;
+
+procedure TTntDBCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
+begin
+ TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
+ inherited;
+end;
+
+function TTntDBCheckBox.GetActionLinkClass: TControlActionLinkClass;
+begin
+ Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
+end;
+
+{ TTntDBRichEdit }
+
+constructor TTntDBRichEdit.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ inherited ReadOnly := True;
+ FAutoDisplay := True;
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnEditingChange := EditingChange;
+ FDataLink.OnUpdateData := UpdateData;
+end;
+
+destructor TTntDBRichEdit.Destroy;
+begin
+ FDataLink.Free;
+ FDataLink := nil;
+ inherited Destroy;
+end;
+
+procedure TTntDBRichEdit.Loaded;
+begin
+ inherited Loaded;
+ if (csDesigning in ComponentState) then
+ DataChange(Self)
+end;
+
+procedure TTntDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBRichEdit.UseRightToLeftAlignment: Boolean;
+begin
+ Result := DBUseRightToLeftAlignment(Self, Field);
+end;
+
+procedure TTntDBRichEdit.BeginEditing;
+begin
+ if not FDataLink.Editing then
+ try
+ if FieldIsBlobLike(Field) then
+ FDataSave := Field.AsString{TNT-ALLOW AsString};
+ FDataLink.Edit;
+ finally
+ FDataSave := '';
+ end;
+end;
+
+procedure TTntDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ if FMemoLoaded then
+ begin
+ if (Key = VK_DELETE) or (Key = VK_BACK) or
+ ((Key = VK_INSERT) and (ssShift in Shift)) or
+ (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
+ BeginEditing;
+ end;
+end;
+
+procedure TTntDBRichEdit.KeyPress(var Key: AnsiChar);
+begin
+ inherited KeyPress(Key);
+ if FMemoLoaded then
+ begin
+ if (Key in [#32..#255]) and (Field <> nil) and
+ not Field.IsValidChar(Key) then
+ begin
+ MessageBeep(0);
+ Key := #0;
+ end;
+ case Key of
+ ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
+ BeginEditing;
+ #27:
+ FDataLink.Reset;
+ end;
+ end else
+ begin
+ if Key = #13 then LoadMemo;
+ Key := #0;
+ end;
+end;
+
+procedure TTntDBRichEdit.Change;
+begin
+ if FMemoLoaded then
+ FDataLink.Modified;
+ FMemoLoaded := True;
+ inherited Change;
+end;
+
+procedure TTntDBRichEdit.CNNotify(var Message: TWMNotify);
+begin
+ inherited;
+ if Message.NMHdr^.code = EN_PROTECTED then
+ Message.Result := 0 { allow the operation (otherwise the control might appear stuck) }
+end;
+
+function TTntDBRichEdit.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBRichEdit.SetDataSource(Value: TDataSource);
+begin
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBRichEdit.GetDataField: WideString;
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBRichEdit.SetDataField(const Value: WideString);
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBRichEdit.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBRichEdit.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBRichEdit.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+procedure TTntDBRichEdit.InternalLoadMemo;
+var
+ Stream: TStringStream{TNT-ALLOW TStringStream};
+begin
+ if PlainText then
+ Text := GetAsWideString(Field)
+ else begin
+ Stream := TStringStream{TNT-ALLOW TStringStream}.Create(Field.AsString{TNT-ALLOW AsString});
+ try
+ Lines.LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+ end;
+end;
+
+procedure TTntDBRichEdit.LoadMemo;
+begin
+ if not FMemoLoaded and Assigned(Field) and FieldIsBlobLike(Field) then
+ begin
+ try
+ InternalLoadMemo;
+ FMemoLoaded := True;
+ except
+ { Rich Edit Load failure }
+ on E:EOutOfResources do
+ Lines.Text := WideFormat('(%s)', [E.Message]);
+ end;
+ EditingChange(Self);
+ end;
+end;
+
+procedure TTntDBRichEdit.DataChange(Sender: TObject);
+begin
+ if Field <> nil then
+ if FieldIsBlobLike(Field) then
+ begin
+ if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
+ begin
+ { Check if the data has changed since we read it the first time }
+ if (FDataSave <> '') and (FDataSave = Field.AsString{TNT-ALLOW AsString}) then Exit;
+ FMemoLoaded := False;
+ LoadMemo;
+ end else
+ begin
+ Text := WideFormat('(%s)', [Field.DisplayName]);
+ FMemoLoaded := False;
+ end;
+ end else
+ begin
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(Field)
+ else
+ Text := GetWideDisplayText(Field);
+ FMemoLoaded := True;
+ end
+ else
+ begin
+ if csDesigning in ComponentState then Text := Name else Text := '';
+ FMemoLoaded := False;
+ end;
+ if HandleAllocated then
+ RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
+end;
+
+procedure TTntDBRichEdit.EditingChange(Sender: TObject);
+begin
+ inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
+end;
+
+procedure TTntDBRichEdit.InternalSaveMemo;
+var
+ Stream: TStringStream{TNT-ALLOW TStringStream};
+begin
+ if PlainText then
+ SetAsWideString(Field, Text)
+ else begin
+ Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
+ try
+ Lines.SaveToStream(Stream);
+ Field.AsString{TNT-ALLOW AsString} := Stream.DataString;
+ finally
+ Stream.Free;
+ end;
+ end;
+end;
+
+procedure TTntDBRichEdit.UpdateData(Sender: TObject);
+begin
+ if FieldIsBlobLike(Field) then
+ InternalSaveMemo
+ else
+ SetAsWideString(Field, Text);
+end;
+
+procedure TTntDBRichEdit.SetFocused(Value: Boolean);
+begin
+ if FFocused <> Value then
+ begin
+ FFocused := Value;
+ if not Assigned(Field) or not FieldIsBlobLike(Field) then
+ FDataLink.Reset;
+ end;
+end;
+
+procedure TTntDBRichEdit.CMEnter(var Message: TCMEnter);
+begin
+ SetFocused(True);
+ inherited;
+end;
+
+procedure TTntDBRichEdit.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ SetFocus;
+ raise;
+ end;
+ SetFocused(False);
+ inherited;
+end;
+
+procedure TTntDBRichEdit.SetAutoDisplay(Value: Boolean);
+begin
+ if FAutoDisplay <> Value then
+ begin
+ FAutoDisplay := Value;
+ if Value then LoadMemo;
+ end;
+end;
+
+procedure TTntDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+begin
+ if not FMemoLoaded then LoadMemo else inherited;
+end;
+
+procedure TTntDBRichEdit.WMCut(var Message: TMessage);
+begin
+ BeginEditing;
+ inherited;
+end;
+
+procedure TTntDBRichEdit.WMPaste(var Message: TMessage);
+begin
+ BeginEditing;
+ inherited;
+end;
+
+procedure TTntDBRichEdit.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+function TTntDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
+ FDataLink.ExecuteAction(Action);
+end;
+
+function TTntDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
+ FDataLink.UpdateAction(Action);
+end;
+
+{ TTntDBMemo }
+
+constructor TTntDBMemo.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ inherited ReadOnly := True;
+ ControlStyle := ControlStyle + [csReplicatable];
+ FAutoDisplay := True;
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnEditingChange := EditingChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FPaintControl := TTntPaintControl.Create(Self, 'EDIT');
+end;
+
+destructor TTntDBMemo.Destroy;
+begin
+ FPaintControl.Free;
+ FDataLink.Free;
+ FDataLink := nil;
+ inherited Destroy;
+end;
+
+procedure TTntDBMemo.Loaded;
+begin
+ inherited Loaded;
+ if (csDesigning in ComponentState) then DataChange(Self);
+end;
+
+procedure TTntDBMemo.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBMemo.UseRightToLeftAlignment: Boolean;
+begin
+ Result := DBUseRightToLeftAlignment(Self, Field);
+end;
+
+procedure TTntDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ if FMemoLoaded then
+ begin
+ if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
+ FDataLink.Edit;
+ end;
+end;
+
+procedure TTntDBMemo.KeyPress(var Key: Char{TNT-ALLOW Char});
+begin
+ inherited KeyPress(Key);
+ if FMemoLoaded then
+ begin
+ if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
+ not FDataLink.Field.IsValidChar(Key) then
+ begin
+ MessageBeep(0);
+ Key := #0;
+ end;
+ case Key of
+ ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
+ FDataLink.Edit;
+ #27:
+ FDataLink.Reset;
+ end;
+ end else
+ begin
+ if Key = #13 then LoadMemo;
+ Key := #0;
+ end;
+end;
+
+procedure TTntDBMemo.Change;
+begin
+ if FMemoLoaded then FDataLink.Modified;
+ FMemoLoaded := True;
+ inherited Change;
+end;
+
+function TTntDBMemo.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBMemo.SetDataSource(Value: TDataSource);
+begin
+ if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBMemo.GetDataField: WideString;
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBMemo.SetDataField(const Value: WideString);
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBMemo.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBMemo.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBMemo.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+procedure TTntDBMemo.LoadMemo;
+begin
+ if not FMemoLoaded and Assigned(FDataLink.Field) and FieldIsBlobLike(FDataLink.Field) then
+ begin
+ try
+ Lines.Text := GetAsWideString(FDataLink.Field);
+ FMemoLoaded := True;
+ except
+ { Memo too large }
+ on E:EInvalidOperation do
+ Lines.Text := WideFormat('(%s)', [E.Message]);
+ end;
+ EditingChange(Self);
+ end;
+end;
+
+procedure TTntDBMemo.DataChange(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ if FieldIsBlobLike(FDataLink.Field) then
+ begin
+ if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
+ begin
+ FMemoLoaded := False;
+ LoadMemo;
+ end else
+ begin
+ Text := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
+ FMemoLoaded := False;
+ EditingChange(Self);
+ end;
+ end else
+ begin
+ if FFocused and FDataLink.CanModify then
+ Text := GetWideText(FDataLink.Field)
+ else
+ Text := GetWideDisplayText(FDataLink.Field);
+ FMemoLoaded := True;
+ end
+ else
+ begin
+ if csDesigning in ComponentState then Text := Name else Text := '';
+ FMemoLoaded := False;
+ end;
+ if HandleAllocated then
+ RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
+end;
+
+procedure TTntDBMemo.EditingChange(Sender: TObject);
+begin
+ inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
+end;
+
+procedure TTntDBMemo.UpdateData(Sender: TObject);
+begin
+ SetAsWideString(FDataLink.Field, Text);
+end;
+
+procedure TTntDBMemo.SetFocused(Value: Boolean);
+begin
+ if FFocused <> Value then
+ begin
+ FFocused := Value;
+ if not Assigned(FDataLink.Field) or not FieldIsBlobLike(FDataLink.Field) then
+ FDataLink.Reset;
+ end;
+end;
+
+procedure TTntDBMemo.WndProc(var Message: TMessage);
+begin
+ with Message do
+ if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
+ (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
+ inherited;
+end;
+
+procedure TTntDBMemo.CMEnter(var Message: TCMEnter);
+begin
+ SetFocused(True);
+ inherited;
+end;
+
+procedure TTntDBMemo.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ SetFocus;
+ raise;
+ end;
+ SetFocused(False);
+ inherited;
+end;
+
+procedure TTntDBMemo.SetAutoDisplay(Value: Boolean);
+begin
+ if FAutoDisplay <> Value then
+ begin
+ FAutoDisplay := Value;
+ if Value then LoadMemo;
+ end;
+end;
+
+procedure TTntDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
+begin
+ if not FMemoLoaded then LoadMemo else inherited;
+end;
+
+procedure TTntDBMemo.WMCut(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.WMUndo(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.WMPaste(var Message: TMessage);
+begin
+ FDataLink.Edit;
+ inherited;
+end;
+
+procedure TTntDBMemo.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+procedure TTntDBMemo.WMPaint(var Message: TWMPaint);
+var
+ S: WideString;
+begin
+ if not (csPaintCopy in ControlState) then
+ inherited
+ else begin
+ if FDataLink.Field <> nil then
+ if FieldIsBlobLike(FDataLink.Field) then
+ begin
+ if FAutoDisplay then
+ S := TntAdjustLineBreaks(GetAsWideString(FDataLink.Field)) else
+ S := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
+ end else
+ S := GetWideDisplayText(FDataLink.Field);
+ if (not Win32PlatformIsUnicode) then
+ SendMessageA(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PAnsiChar(AnsiString(S))))
+ else begin
+ SendMessageW(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PWideChar(S)));
+ end;
+ SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Integer(Message.DC), 0);
+ SendMessage(FPaintControl.Handle, WM_PAINT, Integer(Message.DC), 0);
+ end;
+end;
+
+function TTntDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
+ FDataLink.ExecuteAction(Action);
+end;
+
+function TTntDBMemo.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
+ FDataLink.UpdateAction(Action);
+end;
+
+{ TTntDBRadioGroup }
+
+constructor TTntDBRadioGroup.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDataLink := TFieldDataLink.Create;
+ FDataLink.Control := Self;
+ FDataLink.OnDataChange := DataChange;
+ FDataLink.OnUpdateData := UpdateData;
+ FValues := TTntStringList.Create;
+end;
+
+destructor TTntDBRadioGroup.Destroy;
+begin
+ FDataLink.Free;
+ FDataLink := nil;
+ FValues.Free;
+ inherited Destroy;
+end;
+
+procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (FDataLink <> nil) and
+ (AComponent = DataSource) then DataSource := nil;
+end;
+
+function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
+begin
+ Result := inherited UseRightToLeftAlignment;
+end;
+
+procedure TTntDBRadioGroup.DataChange(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ Value := GetWideText(FDataLink.Field) else
+ Value := '';
+end;
+
+procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
+begin
+ if FDataLink.Field <> nil then
+ SetWideText(FDataLink.Field, Value);
+end;
+
+function TTntDBRadioGroup.GetDataSource: TDataSource;
+begin
+ Result := FDataLink.DataSource;
+end;
+
+procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
+begin
+ FDataLink.DataSource := Value;
+ if Value <> nil then Value.FreeNotification(Self);
+end;
+
+function TTntDBRadioGroup.GetDataField: WideString;
+begin
+ Result := FDataLink.FieldName;
+end;
+
+procedure TTntDBRadioGroup.SetDataField(const Value: WideString);
+begin
+ FDataLink.FieldName := Value;
+end;
+
+function TTntDBRadioGroup.GetReadOnly: Boolean;
+begin
+ Result := FDataLink.ReadOnly;
+end;
+
+procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
+begin
+ FDataLink.ReadOnly := Value;
+end;
+
+function TTntDBRadioGroup.GetField: TField;
+begin
+ Result := FDataLink.Field;
+end;
+
+function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
+begin
+ if (Index < FValues.Count) and (FValues[Index] <> '') then
+ Result := FValues[Index]
+ else if Index < Items.Count then
+ Result := Items[Index]
+ else
+ Result := '';
+end;
+
+procedure TTntDBRadioGroup.SetValue(const Value: WideString);
+var
+ WasFocused: Boolean;
+ I, Index: Integer;
+begin
+ if FValue <> Value then
+ begin
+ FInSetValue := True;
+ try
+ WasFocused := (ItemIndex > -1) and (Buttons[ItemIndex].Focused);
+ Index := -1;
+ for I := 0 to Items.Count - 1 do
+ if Value = GetButtonValue(I) then
+ begin
+ Index := I;
+ Break;
+ end;
+ ItemIndex := Index;
+ // Move the focus rect along with the selected index
+ if WasFocused then
+ Buttons[ItemIndex].SetFocus;
+ finally
+ FInSetValue := False;
+ end;
+ FValue := Value;
+ Change;
+ end;
+end;
+
+procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
+begin
+ try
+ FDataLink.UpdateRecord;
+ except
+ if ItemIndex >= 0 then
+ (Controls[ItemIndex] as TTntRadioButton).SetFocus else
+ (Controls[0] as TTntRadioButton).SetFocus;
+ raise;
+ end;
+ inherited;
+end;
+
+procedure TTntDBRadioGroup.CMGetDataLink(var Message: TMessage);
+begin
+ Message.Result := Integer(FDataLink);
+end;
+
+procedure TTntDBRadioGroup.Click;
+begin
+ if not FInSetValue then
+ begin
+ inherited Click;
+ if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
+ if FDataLink.Editing then FDataLink.Modified;
+ end;
+end;
+
+procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
+begin
+ Items.Assign(Value);
+ DataChange(Self);
+end;
+
+procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
+begin
+ FValues.Assign(Value);
+ DataChange(Self);
+end;
+
+procedure TTntDBRadioGroup.Change;
+begin
+ if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TTntDBRadioGroup.KeyPress(var Key: Char{TNT-ALLOW Char});
+begin
+ inherited KeyPress(Key);
+ case Key of
+ #8, ' ': FDataLink.Edit;
+ #27: FDataLink.Reset;
+ end;
+end;
+
+function TTntDBRadioGroup.CanModify: Boolean;
+begin
+ Result := FDataLink.Edit;
+end;
+
+function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
+ DataLink.ExecuteAction(Action);
+end;
+
+function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
+begin
+ Result := inherited UpdateAction(Action) or (DataLink <> nil) and
+ DataLink.UpdateAction(Action);
+end;
+
+end.