From a0f6fd68a56068a20e7186e2dd2d7daccfbce4aa Mon Sep 17 00:00:00 2001 From: Pavel Perminov Date: Wed, 26 Sep 2012 19:02:53 +0000 Subject: Chess4Net_MI 2010.0 release (106 rev. truncated adjusted copy) git-svn-id: http://svn.miranda-ng.org/main/trunk@1666 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- .../lib/TntUnicodeControls/Source/TntDBCtrls.pas | 2195 ++++++++++++++++++++ 1 file changed, 2195 insertions(+) create mode 100644 plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas (limited to 'plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas') diff --git a/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas b/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas new file mode 100644 index 0000000000..49111d4aba --- /dev/null +++ b/plugins/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. -- cgit v1.2.3