path: root/plugins/Chess4Net/lib/TntUnicodeControls/Source/TntDBCtrls.pas

{*****************************************************************************}
{                                                                             }
{    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.