summaryrefslogtreecommitdiff
path: root/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas')
-rw-r--r--plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas2195
1 files changed, 0 insertions, 2195 deletions
diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
deleted file mode 100644
index 49111d4aba..0000000000
--- a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas
+++ /dev/null
@@ -1,2195 +0,0 @@
-
-{*****************************************************************************}
-{ }
-{ 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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-19 10:43:26 +0000