Source/TntDBCtrls.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntDBCtrls;
  13
  14 {$INCLUDE TntCompilers.inc}
  15
  16 interface
  17
  18 uses
  19   Classes, Windows, Messages, DB, DBCtrls, Controls, StdCtrls,
  20   TntClasses, TntStdCtrls, TntControls, TntComCtrls, TntExtCtrls;
  21
  22 type
  23 {TNT-WARN TPaintControl}
  24   TTntPaintControl = class
  25   private
  26     FOwner: TWinControl;
  27     FClassName: WideString;
  28     FHandle: HWnd;
  29     FObjectInstance: Pointer;
  30     FDefWindowProc: Pointer;
  31     FCtl3dButton: Boolean;
  32     function GetHandle: HWnd;
  33     procedure SetCtl3DButton(Value: Boolean);
  34     procedure WndProc(var Message: TMessage);
  35   public
  36     constructor Create(AOwner: TWinControl; const ClassName: WideString);
  37     destructor Destroy; override;
  38     procedure DestroyHandle;
  39     property Ctl3DButton: Boolean read FCtl3dButton write SetCtl3dButton;
  40     property Handle: HWnd read GetHandle;
  41   end;
  42
  43 type
  44 {TNT-WARN TDBEdit}
  45   TTntDBEdit = class(TDBEdit{TNT-ALLOW TDBEdit})
  46   private
  47     InheritedDataChange: TNotifyEvent;
  48     FPasswordChar: WideChar;
  49     procedure DataChange(Sender: TObject);
  50     procedure UpdateData(Sender: TObject);
  51     function GetHint: WideString;
  52     procedure SetHint(const Value: WideString);
  53     function IsHintStored: Boolean;
  54     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  55     function GetTextMargins: TPoint;
  56     function GetPasswordChar: WideChar;
  57     procedure SetPasswordChar(const Value: WideChar);
  58     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  59   private
  60     function GetSelStart: Integer; reintroduce; virtual;
  61     procedure SetSelStart(const Value: Integer); reintroduce; virtual;
  62     function GetSelLength: Integer; reintroduce; virtual;
  63     procedure SetSelLength(const Value: Integer); reintroduce; virtual;
  64     function GetSelText: WideString; reintroduce;
  65     procedure SetSelText(const Value: WideString);
  66     function GetText: WideString;
  67     procedure SetText(const Value: WideString);
  68   protected
  69     procedure CreateWindowHandle(const Params: TCreateParams); override;
  70     procedure CreateWnd; override;
  71     procedure DefineProperties(Filer: TFiler); override;
  72     function GetActionLinkClass: TControlActionLinkClass; override;
  73     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  74   public
  75     constructor Create(AOwner: TComponent); override;
  76     property SelText: WideString read GetSelText write SetSelText;
  77     property SelStart: Integer read GetSelStart write SetSelStart;
  78     property SelLength: Integer read GetSelLength write SetSelLength;
  79     property Text: WideString read GetText write SetText;
  80   published
  81     property Hint: WideString read GetHint write SetHint stored IsHintStored;
  82     property PasswordChar: WideChar read GetPasswordChar write SetPasswordChar default #0;
  83   end;
  84
  85 {TNT-WARN TDBText}
  86   TTntDBText = class(TDBText{TNT-ALLOW TDBText})
  87   private
  88     FDataLink: TFieldDataLink;
  89     InheritedDataChange: TNotifyEvent;
  90     function GetHint: WideString;
  91     procedure SetHint(const Value: WideString);
  92     function IsHintStored: Boolean;
  93     procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
  94     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  95     function GetCaption: TWideCaption;
  96     function IsCaptionStored: Boolean;
  97     procedure SetCaption(const Value: TWideCaption);
  98     function GetFieldText: WideString;
  99     procedure DataChange(Sender: TObject);
 100   protected
 101     procedure DefineProperties(Filer: TFiler); override;
 102     function GetLabelText: WideString; reintroduce; virtual;
 103     function GetActionLinkClass: TControlActionLinkClass; override;
 104     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
 105     procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
 106   public
 107     constructor Create(AOwner: TComponent); override;
 108     destructor Destroy; override;
 109     property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
 110   published
 111     property Hint: WideString read GetHint write SetHint stored IsHintStored;
 112   end;
 113
 114 {TNT-WARN TDBComboBox}
 115   TTntCustomDBComboBox = class(TDBComboBox{TNT-ALLOW TDBComboBox},
 116     IWideCustomListControl)
 117   private
 118     FDataLink: TFieldDataLink;
 119     FFilter: WideString;
 120     FLastTime: Cardinal;
 121     procedure UpdateData(Sender: TObject);
 122     procedure EditingChange(Sender: TObject);
 123     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
 124     procedure SetReadOnly;
 125     function GetHint: WideString;
 126     procedure SetHint(const Value: WideString);
 127     function IsHintStored: Boolean;
 128     procedure WMChar(var Message: TWMChar); message WM_CHAR;
 129   private
 130     FItems: TTntStrings;
 131     FSaveItems: TTntStrings;
 132     FSaveItemIndex: integer;
 133     function GetItems: TTntStrings;
 134     procedure SetItems(const Value: TTntStrings); reintroduce;
 135     function GetSelStart: Integer;
 136     procedure SetSelStart(const Value: Integer);
 137     function GetSelLength: Integer;
 138     procedure SetSelLength(const Value: Integer);
 139     function GetSelText: WideString;
 140     procedure SetSelText(const Value: WideString);
 141     function GetText: WideString;
 142     procedure SetText(const Value: WideString);
 143
 144     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
 145   protected
 146     procedure DataChange(Sender: TObject);
 147     function GetAutoComplete_UniqueMatchOnly: Boolean; dynamic;
 148     function GetAutoComplete_PreserveDataEntryCase: Boolean; dynamic;
 149     procedure DoEditCharMsg(var Message: TWMChar); virtual;
 150     function GetFieldValue: Variant; virtual;
 151     procedure SetFieldValue(const Value: Variant); virtual;
 152     function GetComboValue: Variant; virtual; abstract;
 153     procedure SetComboValue(const Value: Variant); virtual; abstract;
 154     {$IFDEF DELPHI_7} // fix for Delphi 7 only
 155     function GetItemsClass: TCustomComboBoxStringsClass; override;
 156     {$ENDIF}
 157   protected
 158     procedure CreateWindowHandle(const Params: TCreateParams); override;
 159     procedure DefineProperties(Filer: TFiler); override;
 160     function GetActionLinkClass: TControlActionLinkClass; override;
 161     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
 162     procedure CreateWnd; override;
 163     procedure DestroyWnd; override;
 164     procedure WndProc(var Message: TMessage); override;
 165     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer); override;
 166     procedure KeyPress(var Key: AnsiChar); override;
 167   public
 168     constructor Create(AOwner: TComponent); override;
 169     destructor Destroy; override;
 170     procedure CopySelection(Destination: TCustomListControl); override;
 171     procedure AddItem(const Item: WideString; AObject: TObject); reintroduce; virtual;
 172   public
 173     property SelText: WideString read GetSelText write SetSelText;
 174     property SelStart: Integer read GetSelStart write SetSelStart;
 175     property SelLength: Integer read GetSelLength write SetSelLength;
 176     property Text: WideString read GetText write SetText;
 177   published
 178     property Hint: WideString read GetHint write SetHint stored IsHintStored;
 179     property Items: TTntStrings read GetItems write SetItems;
 180   end;
 181
 182   TTntDBComboBox = class(TTntCustomDBComboBox)
 183   protected
 184     function GetFieldValue: Variant; override;
 185     procedure SetFieldValue(const Value: Variant); override;
 186     function GetComboValue: Variant; override;
 187     procedure SetComboValue(const Value: Variant); override;
 188   end;
 189
 190 type
 191 {TNT-WARN TDBCheckBox}
 192   TTntDBCheckBox = class(TDBCheckBox{TNT-ALLOW TDBCheckBox})
 193   private
 194     function GetCaption: TWideCaption;
 195     procedure SetCaption(const Value: TWideCaption);
 196     function GetHint: WideString;
 197     procedure SetHint(const Value: WideString);
 198     function IsCaptionStored: Boolean;
 199     function IsHintStored: Boolean;
 200   protected
 201     procedure CreateWindowHandle(const Params: TCreateParams); override;
 202     procedure DefineProperties(Filer: TFiler); override;
 203     function GetActionLinkClass: TControlActionLinkClass; override;
 204     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
 205     procedure Toggle; override;
 206   published
 207     property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
 208     property Hint: WideString read GetHint write SetHint stored IsHintStored;
 209   end;
 210
 211 {TNT-WARN TDBRichEdit}
 212   TTntDBRichEdit = class(TTntCustomRichEdit)
 213   private
 214     FDataLink: TFieldDataLink;
 215     FAutoDisplay: Boolean;
 216     FFocused: Boolean;
 217     FMemoLoaded: Boolean;
 218     FDataSave: AnsiString;
 219     procedure BeginEditing;
 220     procedure DataChange(Sender: TObject);
 221     procedure EditingChange(Sender: TObject);
 222     function GetDataField: WideString;
 223     function GetDataSource: TDataSource;
 224     function GetField: TField;
 225     function GetReadOnly: Boolean;
 226     procedure SetDataField(const Value: WideString);
 227     procedure SetDataSource(Value: TDataSource);
 228     procedure SetReadOnly(Value: Boolean);
 229     procedure SetAutoDisplay(Value: Boolean);
 230     procedure SetFocused(Value: Boolean);
 231     procedure UpdateData(Sender: TObject);
 232     procedure WMCut(var Message: TMessage); message WM_CUT;
 233     procedure WMPaste(var Message: TMessage); message WM_PASTE;
 234     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
 235     procedure CMExit(var Message: TCMExit); message CM_EXIT;
 236     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
 237     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
 238     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
 239   protected
 240     procedure InternalLoadMemo; dynamic;
 241     procedure InternalSaveMemo; dynamic;
 242   protected
 243     procedure Change; override;
 244     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 245     procedure KeyPress(var Key: AnsiChar); override;
 246     procedure Loaded; override;
 247     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 248   public
 249     constructor Create(AOwner: TComponent); override;
 250     destructor Destroy; override;
 251     function ExecuteAction(Action: TBasicAction): Boolean; override;
 252     procedure LoadMemo; virtual;
 253     function UpdateAction(Action: TBasicAction): Boolean; override;
 254     function UseRightToLeftAlignment: Boolean; override;
 255     property Field: TField read GetField;
 256   published
 257     property Align;
 258     property Alignment;
 259     property Anchors;
 260     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
 261     property BevelEdges;
 262     property BevelInner;
 263     property BevelOuter;
 264     property BevelKind;
 265     property BevelWidth;
 266     property BiDiMode;
 267     property BorderStyle;
 268     property Color;
 269     property Constraints;
 270     property Ctl3D;
 271     property DataField: WideString read GetDataField write SetDataField;
 272     property DataSource: TDataSource read GetDataSource write SetDataSource;
 273     property DragCursor;
 274     property DragKind;
 275     property DragMode;
 276     property Enabled;
 277     property Font;
 278     property HideSelection;
 279     property HideScrollBars;
 280     property ImeMode;
 281     property ImeName;
 282     property MaxLength;
 283     property ParentBiDiMode;
 284     property ParentColor;
 285     property ParentCtl3D;
 286     property ParentFont;
 287     property ParentShowHint;
 288     property PlainText;
 289     property PopupMenu;
 290     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
 291     property ScrollBars;
 292     property ShowHint;
 293     property TabOrder;
 294     property TabStop;
 295     property Visible;
 296     property WantReturns;
 297     property WantTabs;
 298     property WordWrap;
 299     property OnChange;
 300     property OnClick;
 301     property OnContextPopup;
 302     property OnDblClick;
 303     property OnDragDrop;
 304     property OnDragOver;
 305     property OnEndDock;
 306     property OnEndDrag;
 307     property OnEnter;
 308     property OnExit;
 309     property OnKeyDown;
 310     property OnKeyPress;
 311     property OnKeyUp;
 312     {$IFDEF COMPILER_9_UP}
 313     property OnMouseActivate;
 314     {$ENDIF}
 315     property OnMouseDown;
 316     {$IFDEF COMPILER_10_UP}
 317     property OnMouseEnter;
 318     property OnMouseLeave;
 319     {$ENDIF}
 320     property OnMouseMove;
 321     property OnMouseUp;
 322     property OnResizeRequest;
 323     property OnSelectionChange;
 324     property OnProtectChange;
 325     property OnSaveClipboard;
 326     property OnStartDock;
 327     property OnStartDrag;
 328   end;
 329
 330 type
 331 {TNT-WARN TDBMemo}
 332   TTntDBMemo = class(TTntCustomMemo)
 333   private
 334     FDataLink: TFieldDataLink;
 335     FAutoDisplay: Boolean;
 336     FFocused: Boolean;
 337     FMemoLoaded: Boolean;
 338     FPaintControl: TTntPaintControl;
 339     procedure DataChange(Sender: TObject);
 340     procedure EditingChange(Sender: TObject);
 341     function GetDataField: WideString;
 342     function GetDataSource: TDataSource;
 343     function GetField: TField;
 344     function GetReadOnly: Boolean;
 345     procedure SetDataField(const Value: WideString);
 346     procedure SetDataSource(Value: TDataSource);
 347     procedure SetReadOnly(Value: Boolean);
 348     procedure SetAutoDisplay(Value: Boolean);
 349     procedure SetFocused(Value: Boolean);
 350     procedure UpdateData(Sender: TObject);
 351     procedure WMCut(var Message: TMessage); message WM_CUT;
 352     procedure WMPaste(var Message: TMessage); message WM_PASTE;
 353     procedure WMUndo(var Message: TMessage); message WM_UNDO;
 354     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
 355     procedure CMExit(var Message: TCMExit); message CM_EXIT;
 356     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
 357     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
 358     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
 359   protected
 360     procedure Change; override;
 361     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
 362     procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
 363     procedure Loaded; override;
 364     procedure Notification(AComponent: TComponent;
 365       Operation: TOperation); override;
 366     procedure WndProc(var Message: TMessage); override;
 367   public
 368     constructor Create(AOwner: TComponent); override;
 369     destructor Destroy; override;
 370     function ExecuteAction(Action: TBasicAction): Boolean; override;
 371     procedure LoadMemo; virtual;
 372     function UpdateAction(Action: TBasicAction): Boolean; override;
 373     function UseRightToLeftAlignment: Boolean; override;
 374     property Field: TField read GetField;
 375   published
 376     property Align;
 377     property Alignment;
 378     property Anchors;
 379     property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
 380     property BevelEdges;
 381     property BevelInner;
 382     property BevelOuter;
 383     property BevelKind;
 384     property BevelWidth;
 385     property BiDiMode;
 386     property BorderStyle;
 387     property Color;
 388     property Constraints;
 389     property Ctl3D;
 390     property DataField: WideString read GetDataField write SetDataField;
 391     property DataSource: TDataSource read GetDataSource write SetDataSource;
 392     property DragCursor;
 393     property DragKind;
 394     property DragMode;
 395     property Enabled;
 396     property Font;
 397     property HideSelection;
 398     property ImeMode;
 399     property ImeName;
 400     property MaxLength;
 401     property ParentBiDiMode;
 402     property ParentColor;
 403     property ParentCtl3D;
 404     property ParentFont;
 405     property ParentShowHint;
 406     property PopupMenu;
 407     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
 408     property ScrollBars;
 409     property ShowHint;
 410     property TabOrder;
 411     property TabStop;
 412     property Visible;
 413     property WantReturns;
 414     property WantTabs;
 415     property WordWrap;
 416     property OnChange;
 417     property OnClick;
 418     property OnContextPopup;
 419     property OnDblClick;
 420     property OnDragDrop;
 421     property OnDragOver;
 422     property OnEndDock;
 423     property OnEndDrag;
 424     property OnEnter;
 425     property OnExit;
 426     property OnKeyDown;
 427     property OnKeyPress;
 428     property OnKeyUp;
 429     {$IFDEF COMPILER_9_UP}
 430     property OnMouseActivate;
 431     {$ENDIF}
 432     property OnMouseDown;
 433     {$IFDEF COMPILER_10_UP}
 434     property OnMouseEnter;
 435     property OnMouseLeave;
 436     {$ENDIF}
 437     property OnMouseMove;
 438     property OnMouseUp;
 439     property OnStartDock;
 440     property OnStartDrag;
 441   end;
 442
 443 { TDBRadioGroup }
 444 type
 445   TTntDBRadioGroup = class(TTntCustomRadioGroup)
 446   private
 447     FDataLink: TFieldDataLink;
 448     FValue: WideString;
 449     FValues: TTntStrings;
 450     FInSetValue: Boolean;
 451     FOnChange: TNotifyEvent;
 452     procedure DataChange(Sender: TObject);
 453     procedure UpdateData(Sender: TObject);
 454     function GetDataField: WideString;
 455     function GetDataSource: TDataSource;
 456     function GetField: TField;
 457     function GetReadOnly: Boolean;
 458     function GetButtonValue(Index: Integer): WideString;
 459     procedure SetDataField(const Value: WideString);
 460     procedure SetDataSource(Value: TDataSource);
 461     procedure SetReadOnly(Value: Boolean);
 462     procedure SetValue(const Value: WideString);
 463     procedure SetItems(Value: TTntStrings);
 464     procedure SetValues(Value: TTntStrings);
 465     procedure CMExit(var Message: TCMExit); message CM_EXIT;
 466     procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
 467   protected
 468     procedure Change; dynamic;
 469     procedure Click; override;
 470     procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
 471     function CanModify: Boolean; override;
 472     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 473     property DataLink: TFieldDataLink read FDataLink;
 474   public
 475     constructor Create(AOwner: TComponent); override;
 476     destructor Destroy; override;
 477     function ExecuteAction(Action: TBasicAction): Boolean; override;
 478     function UpdateAction(Action: TBasicAction): Boolean; override;
 479     function UseRightToLeftAlignment: Boolean; override;
 480     property Field: TField read GetField;
 481     property ItemIndex;
 482     property Value: WideString read FValue write SetValue;
 483   published
 484     property Align;
 485     property Anchors;
 486     property BiDiMode;
 487     property Caption;
 488     property Color;
 489     property Columns;
 490     property Constraints;
 491     property Ctl3D;
 492     property DataField: WideString read GetDataField write SetDataField;
 493     property DataSource: TDataSource read GetDataSource write SetDataSource;
 494     property DragCursor;
 495     property DragKind;
 496     property DragMode;
 497     property Enabled;
 498     property Font;
 499     property Items write SetItems;
 500     {$IFDEF COMPILER_7_UP}
 501     property ParentBackground;
 502     {$ENDIF}
 503     property ParentBiDiMode;
 504     property ParentColor;
 505     property ParentCtl3D;
 506     property ParentFont;
 507     property ParentShowHint;
 508     property PopupMenu;
 509     property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
 510     property ShowHint;
 511     property TabOrder;
 512     property TabStop;
 513     property Values: TTntStrings read FValues write SetValues;
 514     property Visible;
 515     property OnChange: TNotifyEvent read FOnChange write FOnChange;
 516     property OnClick;
 517     property OnContextPopup;
 518     property OnDragDrop;
 519     property OnDragOver;
 520     property OnEndDock;
 521     property OnEndDrag;
 522     property OnEnter;
 523     property OnExit;
 524     {$IFDEF COMPILER_10_UP}
 525     property OnMouseEnter;
 526     property OnMouseLeave;
 527     {$ENDIF}
 528     property OnStartDock;
 529     property OnStartDrag;
 530   end;
 531
 532 implementation
 533
 534 uses
 535   Forms, SysUtils, Graphics, Variants, TntDB,
 536   TntActnList, TntGraphics, TntSysUtils, RichEdit, Mask;
 537
 538 function FieldIsBlobLike(Field: TField): Boolean;
 539 begin
 540   Result := False;
 541   if Assigned(Field) then begin
 542     if (Field.IsBlob)
 543     or (Field.DataType in [Low(TBlobType).. High(TBlobType)]) then
 544       Result := True
 545     else if (Field is TWideStringField{TNT-ALLOW TWideStringField})
 546     and (Field.Size = MaxInt) then
 547       Result := True; { wide string field filling in for a blob field }
 548   end;
 549 end;
 550
 551 { TTntPaintControl }
 552
 553 type
 554   TAccessWinControl = class(TWinControl);
 555
 556 constructor TTntPaintControl.Create(AOwner: TWinControl; const ClassName: WideString);
 557 begin
 558   FOwner := AOwner;
 559   FClassName := ClassName;
 560 end;
 561
 562 destructor TTntPaintControl.Destroy;
 563 begin
 564   DestroyHandle;
 565 end;
 566
 567 procedure TTntPaintControl.DestroyHandle;
 568 begin
 569   if FHandle <> 0 then DestroyWindow(FHandle);
 570   Classes.FreeObjectInstance(FObjectInstance);
 571   FHandle := 0;
 572   FObjectInstance := nil;
 573 end;
 574
 575 function TTntPaintControl.GetHandle: HWnd;
 576 var
 577   Params: TCreateParams;
 578 begin
 579   if FHandle = 0 then
 580   begin
 581     FObjectInstance := Classes.MakeObjectInstance(WndProc);
 582     TAccessWinControl(FOwner).CreateParams(Params);
 583     Params.Style := Params.Style and not (WS_HSCROLL or WS_VSCROLL);
 584     if (not Win32PlatformIsUnicode) then begin
 585       with Params do
 586         FHandle := CreateWindowEx(ExStyle, PAnsiChar(AnsiString(FClassName)),
 587           PAnsiChar(TAccessWinControl(FOwner).Text), Style or WS_VISIBLE,
 588           X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
 589       FDefWindowProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
 590       SetWindowLong(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
 591     end else begin
 592       with Params do
 593         FHandle := CreateWindowExW(ExStyle, PWideChar(FClassName),
 594           PWideChar(TntControl_GetText(FOwner)), Style or WS_VISIBLE,
 595           X, Y, Width, Height, Application.Handle, 0, HInstance, nil);
 596       FDefWindowProc := Pointer(GetWindowLongW(FHandle, GWL_WNDPROC));
 597       SetWindowLongW(FHandle, GWL_WNDPROC, Integer(FObjectInstance));
 598     end;
 599     SendMessage(FHandle, WM_SETFONT, Integer(TAccessWinControl(FOwner).Font.Handle), 1);
 600   end;
 601   Result := FHandle;
 602 end;
 603
 604 procedure TTntPaintControl.SetCtl3DButton(Value: Boolean);
 605 begin
 606   if FHandle <> 0 then DestroyHandle;
 607   FCtl3DButton := Value;
 608 end;
 609
 610 procedure TTntPaintControl.WndProc(var Message: TMessage);
 611 begin
 612   with Message do
 613     if (Msg >= CN_CTLCOLORMSGBOX) and (Msg <= CN_CTLCOLORSTATIC) then
 614       Result := FOwner.Perform(Msg, WParam, LParam)
 615     else if (not Win32PlatformIsUnicode) then
 616       Result := CallWindowProcA(FDefWindowProc, FHandle, Msg, WParam, LParam)
 617     else
 618       Result := CallWindowProcW(FDefWindowProc, FHandle, Msg, WParam, LParam);
 619 end;
 620
 621 { THackFieldDataLink }
 622 type
 623   THackFieldDataLink_D6_D7_D9 = class(TDataLink)
 624   protected
 625     FxxxField: TField;
 626     FxxxFieldName: string{TNT-ALLOW string};
 627     FxxxControl: TComponent;
 628     FxxxEditing: Boolean;
 629     FModified: Boolean;
 630   end;
 631
 632 {$IFDEF COMPILER_6}  // verified against VCL source in Delphi 6 and BCB 6
 633   THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
 634 {$ENDIF}
 635 {$IFDEF DELPHI_7}    // verified against VCL source in Delphi 7
 636   THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
 637 {$ENDIF}
 638 {$IFDEF DELPHI_9}    // verified against VCL source in Delphi 9
 639   THackFieldDataLink = THackFieldDataLink_D6_D7_D9;
 640 {$ENDIF}
 641 {$IFDEF DELPHI_10}    // verified against VCL source in Delphi 10
 642   THackFieldDataLink = class(TDataLink)
 643   protected
 644     FxxxField: TField;
 645     FxxxFieldName: WideString;
 646     FxxxControl: TComponent;
 647     FxxxEditing: Boolean;
 648     FModified: Boolean;
 649   end;
 650 {$ENDIF}
 651
 652 { TTntDBEdit }
 653
 654 type
 655   THackDBEdit_D6_D7_D9 = class(TCustomMaskEdit)
 656   protected
 657     FDataLink: TFieldDataLink;
 658     FCanvas: TControlCanvas;
 659     FAlignment: TAlignment;
 660     FFocused: Boolean;
 661   end;
 662
 663 {$IFDEF COMPILER_6}   // verified against VCL source in Delphi 6 and BCB 6
 664   THackDBEdit = THackDBEdit_D6_D7_D9;
 665 {$ENDIF}
 666 {$IFDEF DELPHI_7}     // verified against VCL source in Delphi 7
 667   THackDBEdit = THackDBEdit_D6_D7_D9;
 668 {$ENDIF}
 669 {$IFDEF DELPHI_9}     // verified against VCL source in Delphi 9
 670   THackDBEdit = THackDBEdit_D6_D7_D9;
 671 {$ENDIF}
 672 {$IFDEF DELPHI_10}     // verified against VCL source in Delphi 10
 673   THackDBEdit = THackDBEdit_D6_D7_D9;
 674 {$ENDIF}
 675
 676 constructor TTntDBEdit.Create(AOwner: TComponent);
 677 begin
 678   inherited;
 679   InheritedDataChange := THackDBEdit(Self).FDataLink.OnDataChange;
 680   THackDBEdit(Self).FDataLink.OnDataChange := DataChange;
 681   THackDBEdit(Self).FDataLink.OnUpdateData := UpdateData;
 682 end;
 683
 684 procedure TTntDBEdit.CreateWindowHandle(const Params: TCreateParams);
 685 begin
 686   CreateUnicodeHandle(Self, Params, 'EDIT');
 687 end;
 688
 689 procedure TTntDBEdit.CreateWnd;
 690 begin
 691   inherited;
 692   TntCustomEdit_AfterInherited_CreateWnd(Self, FPasswordChar);
 693 end;
 694
 695 procedure TTntDBEdit.DefineProperties(Filer: TFiler);
 696 begin
 697   inherited;
 698   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 699 end;
 700
 701 function TTntDBEdit.GetSelStart: Integer;
 702 begin
 703   Result := TntCustomEdit_GetSelStart(Self);
 704 end;
 705
 706 procedure TTntDBEdit.SetSelStart(const Value: Integer);
 707 begin
 708   TntCustomEdit_SetSelStart(Self, Value);
 709 end;
 710
 711 function TTntDBEdit.GetSelLength: Integer;
 712 begin
 713   Result := TntCustomEdit_GetSelLength(Self);
 714 end;
 715
 716 procedure TTntDBEdit.SetSelLength(const Value: Integer);
 717 begin
 718   TntCustomEdit_SetSelLength(Self, Value);
 719 end;
 720
 721 function TTntDBEdit.GetSelText: WideString;
 722 begin
 723   Result := TntCustomEdit_GetSelText(Self);
 724 end;
 725
 726 procedure TTntDBEdit.SetSelText(const Value: WideString);
 727 begin
 728   TntCustomEdit_SetSelText(Self, Value);
 729 end;
 730
 731 function TTntDBEdit.GetPasswordChar: WideChar;
 732 begin
 733   Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar)
 734 end;
 735
 736 procedure TTntDBEdit.SetPasswordChar(const Value: WideChar);
 737 begin
 738   TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
 739 end;
 740
 741 function TTntDBEdit.GetText: WideString;
 742 begin
 743   Result := TntControl_GetText(Self);
 744 end;
 745
 746 procedure TTntDBEdit.SetText(const Value: WideString);
 747 begin
 748   TntControl_SetText(Self, Value);
 749 end;
 750
 751 procedure TTntDBEdit.DataChange(Sender: TObject);
 752 begin
 753   with THackDBEdit(Self), Self do begin
 754     if Field = nil then
 755       InheritedDataChange(Sender)
 756     else begin
 757       if FAlignment <> Field.Alignment then
 758       begin
 759         EditText := '';  {forces update}
 760         FAlignment := Field.Alignment;
 761       end;
 762       EditMask := Field.EditMask;
 763       if not (csDesigning in ComponentState) then
 764       begin
 765         if (Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
 766           MaxLength := Field.Size;
 767       end;
 768       if FFocused and FDataLink.CanModify then
 769         Text := GetWideText(Field)
 770       else
 771       begin
 772         Text := GetWideDisplayText(Field);
 773         if FDataLink.Editing and THackFieldDataLink(FDataLink).FModified then
 774           Modified := True;
 775       end;
 776     end;
 777   end;
 778 end;
 779
 780 procedure TTntDBEdit.UpdateData(Sender: TObject);
 781 begin
 782   ValidateEdit;
 783   SetWideText(Field, Text);
 784 end;
 785
 786 procedure TTntDBEdit.CMEnter(var Message: TCMEnter);
 787 var
 788   SaveFarEast: Boolean;
 789 begin
 790   SaveFarEast := SysLocale.FarEast;
 791   try
 792     SysLocale.FarEast := False;
 793     inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
 794   finally
 795     SysLocale.FarEast := SaveFarEast;
 796   end;
 797 end;
 798
 799 function TTntDBEdit.IsHintStored: Boolean;
 800 begin
 801   Result := TntControl_IsHintStored(Self);
 802 end;
 803
 804 function TTntDBEdit.GetHint: WideString;
 805 begin
 806   Result := TntControl_GetHint(Self)
 807 end;
 808
 809 procedure TTntDBEdit.SetHint(const Value: WideString);
 810 begin
 811   TntControl_SetHint(Self, Value);
 812 end;
 813
 814 procedure TTntDBEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
 815 begin
 816   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
 817   inherited;
 818 end;
 819
 820 function TTntDBEdit.GetActionLinkClass: TControlActionLinkClass;
 821 begin
 822   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
 823 end;
 824
 825 procedure TTntDBEdit.WMPaint(var Message: TWMPaint);
 826 const
 827   AlignStyle : array[Boolean, TAlignment] of DWORD =
 828    ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
 829     (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
 830 var
 831   ALeft: Integer;
 832   _Margins: TPoint;
 833   R: TRect;
 834   DC: HDC;
 835   PS: TPaintStruct;
 836   S: WideString;
 837   AAlignment: TAlignment;
 838   I: Integer;
 839 begin
 840   with THackDBEdit(Self), Self do begin
 841     AAlignment := FAlignment;
 842     if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
 843     if ((AAlignment = taLeftJustify) or FFocused) and (not (csPaintCopy in ControlState))
 844     or (not Win32PlatformIsUnicode) then
 845     begin
 846       inherited;
 847       Exit;
 848     end;
 849   { Since edit controls do not handle justification unless multi-line (and
 850     then only poorly) we will draw right and center justify manually unless
 851     the edit has the focus. }
 852     if FCanvas = nil then
 853     begin
 854       FCanvas := TControlCanvas.Create;
 855       FCanvas.Control := Self;
 856     end;
 857     DC := Message.DC;
 858     if DC = 0 then DC := BeginPaint(Handle, PS);
 859     FCanvas.Handle := DC;
 860     try
 861       FCanvas.Font := Font;
 862       with FCanvas do
 863       begin
 864         R := ClientRect;
 865         if not (NewStyleControls and Ctl3D) and (BorderStyle = bsSingle) then
 866         begin
 867           Brush.Color := clWindowFrame;
 868           FrameRect(R);
 869           InflateRect(R, -1, -1);
 870         end;
 871         Brush.Color := Color;
 872         if not Enabled then
 873           Font.Color := clGrayText;
 874         if (csPaintCopy in ControlState) and (Field <> nil) then
 875         begin
 876           S := GetWideDisplayText(Field);
 877           case CharCase of
 878             ecUpperCase:
 879               S := Tnt_WideUpperCase(S);
 880             ecLowerCase:
 881               S := Tnt_WideLowerCase(S);
 882           end;
 883         end else
 884           S := Text { EditText? };
 885         if PasswordChar <> #0 then
 886           for I := 1 to Length(S) do S[I] := PasswordChar;
 887         _Margins := GetTextMargins;
 888         case AAlignment of
 889           taLeftJustify: ALeft := _Margins.X;
 890           taRightJustify: ALeft := ClientWidth - WideCanvasTextWidth(FCanvas, S) - _Margins.X - 1;
 891         else
 892           ALeft := (ClientWidth - WideCanvasTextWidth(FCanvas, S)) div 2;
 893         end;
 894         if SysLocale.MiddleEast then UpdateTextFlags;
 895         WideCanvasTextRect(FCanvas, R, ALeft, _Margins.Y, S);
 896       end;
 897     finally
 898       FCanvas.Handle := 0;
 899       if Message.DC = 0 then EndPaint(Handle, PS);
 900     end;
 901   end;
 902 end;
 903
 904 function TTntDBEdit.GetTextMargins: TPoint;
 905 var
 906   DC: HDC;
 907   SaveFont: HFont;
 908   I: Integer;
 909   SysMetrics, Metrics: TTextMetric;
 910 begin
 911   if NewStyleControls then
 912   begin
 913     if BorderStyle = bsNone then I := 0 else
 914       if Ctl3D then I := 1 else I := 2;
 915     Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
 916     Result.Y := I;
 917   end else
 918   begin
 919     if BorderStyle = bsNone then I := 0 else
 920     begin
 921       DC := GetDC(0);
 922       GetTextMetrics(DC, SysMetrics);
 923       SaveFont := SelectObject(DC, Font.Handle);
 924       GetTextMetrics(DC, Metrics);
 925       SelectObject(DC, SaveFont);
 926       ReleaseDC(0, DC);
 927       I := SysMetrics.tmHeight;
 928       if I > Metrics.tmHeight then I := Metrics.tmHeight;
 929       I := I div 4;
 930     end;
 931     Result.X := I;
 932     Result.Y := I;
 933   end;
 934 end;
 935
 936 { TTntDBText }
 937
 938 constructor TTntDBText.Create(AOwner: TComponent);
 939 begin
 940   inherited;
 941   FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
 942   InheritedDataChange := FDataLink.OnDataChange;
 943   FDataLink.OnDataChange := DataChange;
 944 end;
 945
 946 destructor TTntDBText.Destroy;
 947 begin
 948   FDataLink := nil;
 949   inherited;
 950 end;
 951
 952 procedure TTntDBText.CMDialogChar(var Message: TCMDialogChar);
 953 begin
 954   TntLabel_CMDialogChar(Self, Message, Caption);
 955 end;
 956
 957 function TTntDBText.IsCaptionStored: Boolean;
 958 begin
 959   Result := TntControl_IsCaptionStored(Self)
 960 end;
 961
 962 function TTntDBText.GetCaption: TWideCaption;
 963 begin
 964   Result := TntControl_GetText(Self);
 965 end;
 966
 967 procedure TTntDBText.SetCaption(const Value: TWideCaption);
 968 begin
 969   TntControl_SetText(Self, Value);
 970 end;
 971
 972 procedure TTntDBText.DefineProperties(Filer: TFiler);
 973 begin
 974   inherited;
 975   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
 976 end;
 977
 978 function TTntDBText.GetLabelText: WideString;
 979 begin
 980   if csPaintCopy in ControlState then
 981     Result := GetFieldText
 982   else
 983     Result := Caption;
 984 end;
 985
 986 procedure TTntDBText.DoDrawText(var Rect: TRect; Flags: Integer);
 987 begin
 988   if not TntLabel_DoDrawText(Self, Rect, Flags, GetLabelText) then
 989     inherited;
 990 end;
 991
 992 function TTntDBText.IsHintStored: Boolean;
 993 begin
 994   Result := TntControl_IsHintStored(Self);
 995 end;
 996
 997 function TTntDBText.GetHint: WideString;
 998 begin
 999   Result := TntControl_GetHint(Self)
1000 end;
1001
1002 procedure TTntDBText.SetHint(const Value: WideString);
1003 begin
1004   TntControl_SetHint(Self, Value);
1005 end;
1006
1007 procedure TTntDBText.CMHintShow(var Message: TMessage);
1008 begin
1009   ProcessCMHintShowMsg(Message);
1010   inherited;
1011 end;
1012
1013 procedure TTntDBText.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1014 begin
1015   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1016   inherited;
1017 end;
1018
1019 function TTntDBText.GetActionLinkClass: TControlActionLinkClass;
1020 begin
1021   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1022 end;
1023
1024 function TTntDBText.GetFieldText: WideString;
1025 begin
1026   if Field <> nil then
1027     Result := GetWideDisplayText(Field)
1028   else
1029     if csDesigning in ComponentState then Result := Name else Result := '';
1030 end;
1031
1032 procedure TTntDBText.DataChange(Sender: TObject);
1033 begin
1034   Caption := GetFieldText;
1035 end;
1036
1037 { TTntCustomDBComboBox }
1038
1039 constructor TTntCustomDBComboBox.Create(AOwner: TComponent);
1040 begin
1041   inherited;
1042   FItems := TTntComboBoxStrings.Create;
1043   TTntComboBoxStrings(FItems).ComboBox := Self;
1044   FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
1045   FDataLink.OnDataChange := DataChange;
1046   FDataLink.OnUpdateData := UpdateData;
1047   FDataLink.OnEditingChange := EditingChange;
1048 end;
1049
1050 destructor TTntCustomDBComboBox.Destroy;
1051 begin
1052   FreeAndNil(FItems);
1053   FreeAndNil(FSaveItems);
1054   FDataLink := nil;
1055   inherited;
1056 end;
1057
1058 procedure TTntCustomDBComboBox.CreateWindowHandle(const Params: TCreateParams);
1059 begin
1060   CreateUnicodeHandle(Self, Params, 'COMBOBOX');
1061 end;
1062
1063 procedure TTntCustomDBComboBox.DefineProperties(Filer: TFiler);
1064 begin
1065   inherited;
1066   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1067 end;
1068
1069 type
1070   TAccessCustomComboBox = class(TCustomComboBox{TNT-ALLOW TCustomComboBox});
1071
1072 procedure TTntCustomDBComboBox.CreateWnd;
1073 var
1074   PreInheritedAnsiText: AnsiString;
1075 begin
1076   PreInheritedAnsiText := TAccessCustomComboBox(Self).Text;
1077   inherited;
1078   TntCombo_AfterInherited_CreateWnd(Self, Items, FSaveItems, FSaveItemIndex, PreInheritedAnsiText);
1079 end;
1080
1081 procedure TTntCustomDBComboBox.DestroyWnd;
1082 var
1083   SavedText: WideString;
1084 begin
1085   if not (csDestroyingHandle in ControlState) then begin { avoid recursion when parent is TToolBar and system font changes. }
1086     TntCombo_BeforeInherited_DestroyWnd(Self, Items, FSaveItems, ItemIndex, FSaveItemIndex, SavedText);
1087     inherited;
1088     TntControl_SetStoredText(Self, SavedText);
1089   end;
1090 end;
1091
1092 procedure TTntCustomDBComboBox.SetReadOnly;
1093 begin
1094   if (Style in [csDropDown, csSimple]) and HandleAllocated then
1095     SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.CanModify), 0);
1096 end;
1097
1098 procedure TTntCustomDBComboBox.EditingChange(Sender: TObject);
1099 begin
1100   SetReadOnly;
1101 end;
1102
1103 procedure TTntCustomDBComboBox.CMEnter(var Message: TCMEnter);
1104 var
1105   SaveFarEast: Boolean;
1106 begin
1107   SaveFarEast := SysLocale.FarEast;
1108   try
1109     SysLocale.FarEast := False;
1110     inherited; // inherited tries to work around Win95 FarEast bug, but introduces others
1111   finally
1112     SysLocale.FarEast := SaveFarEast;
1113   end;
1114 end;
1115
1116 procedure TTntCustomDBComboBox.WndProc(var Message: TMessage);
1117 begin
1118   if (not (csDesigning in ComponentState))
1119   and (Message.Msg = CB_SHOWDROPDOWN)
1120   and (Message.WParam = 0)
1121   and (not FDataLink.Editing) then begin
1122     DataChange(Self); {Restore text}
1123     Dispatch(Message); {Do NOT call inherited!}
1124   end else
1125     inherited WndProc(Message);
1126 end;
1127
1128 procedure TTntCustomDBComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
1129 begin
1130   if not TntCombo_ComboWndProc(Self, Message, ComboWnd, ComboProc, DoEditCharMsg) then
1131     inherited;
1132 end;
1133
1134 procedure TTntCustomDBComboBox.KeyPress(var Key: AnsiChar);
1135 var
1136   SaveAutoComplete: Boolean;
1137 begin
1138   TntCombo_BeforeKeyPress(Self, SaveAutoComplete);
1139   try
1140     inherited;
1141   finally
1142     TntCombo_AfterKeyPress(Self, SaveAutoComplete);
1143   end;
1144 end;
1145
1146 procedure TTntCustomDBComboBox.DoEditCharMsg(var Message: TWMChar);
1147 begin
1148   TntCombo_AutoCompleteKeyPress(Self, Items, Message,
1149     GetAutoComplete_UniqueMatchOnly, GetAutoComplete_PreserveDataEntryCase);
1150 end;
1151
1152 procedure TTntCustomDBComboBox.WMChar(var Message: TWMChar);
1153 begin
1154   TntCombo_AutoSearchKeyPress(Self, Items, Message, FFilter, FLastTime);
1155   inherited;
1156 end;
1157
1158 function TTntCustomDBComboBox.GetItems: TTntStrings;
1159 begin
1160   Result := FItems;
1161 end;
1162
1163 procedure TTntCustomDBComboBox.SetItems(const Value: TTntStrings);
1164 begin
1165   FItems.Assign(Value);
1166   DataChange(Self);
1167 end;
1168
1169 function TTntCustomDBComboBox.GetSelStart: Integer;
1170 begin
1171   Result := TntCombo_GetSelStart(Self);
1172 end;
1173
1174 procedure TTntCustomDBComboBox.SetSelStart(const Value: Integer);
1175 begin
1176   TntCombo_SetSelStart(Self, Value);
1177 end;
1178
1179 function TTntCustomDBComboBox.GetSelLength: Integer;
1180 begin
1181   Result := TntCombo_GetSelLength(Self);
1182 end;
1183
1184 procedure TTntCustomDBComboBox.SetSelLength(const Value: Integer);
1185 begin
1186   TntCombo_SetSelLength(Self, Value);
1187 end;
1188
1189 function TTntCustomDBComboBox.GetSelText: WideString;
1190 begin
1191   Result := TntCombo_GetSelText(Self);
1192 end;
1193
1194 procedure TTntCustomDBComboBox.SetSelText(const Value: WideString);
1195 begin
1196   TntCombo_SetSelText(Self, Value);
1197 end;
1198
1199 function TTntCustomDBComboBox.GetText: WideString;
1200 begin
1201   Result := TntControl_GetText(Self);
1202 end;
1203
1204 procedure TTntCustomDBComboBox.SetText(const Value: WideString);
1205 begin
1206   TntControl_SetText(Self, Value);
1207 end;
1208
1209 procedure TTntCustomDBComboBox.CNCommand(var Message: TWMCommand);
1210 begin
1211   if not TntCombo_CNCommand(Self, Items, Message) then
1212     inherited;
1213 end;
1214
1215 function TTntCustomDBComboBox.GetFieldValue: Variant;
1216 begin
1217   Result := Field.Value;
1218 end;
1219
1220 procedure TTntCustomDBComboBox.SetFieldValue(const Value: Variant);
1221 begin
1222   Field.Value := Value;
1223 end;
1224
1225 procedure TTntCustomDBComboBox.DataChange(Sender: TObject);
1226 begin
1227   if not (Style = csSimple) and DroppedDown then Exit;
1228   if Field <> nil then
1229     SetComboValue(GetFieldValue)
1230   else
1231     if csDesigning in ComponentState then
1232       SetComboValue(Name)
1233     else
1234       SetComboValue(Null);
1235 end;
1236
1237 procedure TTntCustomDBComboBox.UpdateData(Sender: TObject);
1238 begin
1239   SetFieldValue(GetComboValue);
1240 end;
1241
1242 function TTntCustomDBComboBox.GetAutoComplete_PreserveDataEntryCase: Boolean;
1243 begin
1244   Result := True;
1245 end;
1246
1247 function TTntCustomDBComboBox.GetAutoComplete_UniqueMatchOnly: Boolean;
1248 begin
1249   Result := False;
1250 end;
1251
1252 function TTntCustomDBComboBox.IsHintStored: Boolean;
1253 begin
1254   Result := TntControl_IsHintStored(Self);
1255 end;
1256
1257 function TTntCustomDBComboBox.GetHint: WideString;
1258 begin
1259   Result := TntControl_GetHint(Self)
1260 end;
1261
1262 procedure TTntCustomDBComboBox.SetHint(const Value: WideString);
1263 begin
1264   TntControl_SetHint(Self, Value);
1265 end;
1266
1267 procedure TTntCustomDBComboBox.AddItem(const Item: WideString; AObject: TObject);
1268 begin
1269   TntComboBox_AddItem(Items, Item, AObject);
1270 end;
1271
1272 procedure TTntCustomDBComboBox.CopySelection(Destination: TCustomListControl);
1273 begin
1274   TntComboBox_CopySelection(Items, ItemIndex, Destination);
1275 end;
1276
1277 procedure TTntCustomDBComboBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1278 begin
1279   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1280   inherited;
1281 end;
1282
1283 function TTntCustomDBComboBox.GetActionLinkClass: TControlActionLinkClass;
1284 begin
1285   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1286 end;
1287
1288 {$IFDEF DELPHI_7} // fix for Delphi 7 only
1289 function TTntCustomDBComboBox.GetItemsClass: TCustomComboBoxStringsClass;
1290 begin
1291   Result := TD7PatchedComboBoxStrings;
1292 end;
1293 {$ENDIF}
1294
1295 { TTntDBComboBox }
1296
1297 function TTntDBComboBox.GetFieldValue: Variant;
1298 begin
1299   Result := GetWideText(Field);
1300 end;
1301
1302 procedure TTntDBComboBox.SetFieldValue(const Value: Variant);
1303 begin
1304   SetWideText(Field, Value);
1305 end;
1306
1307 procedure TTntDBComboBox.SetComboValue(const Value: Variant);
1308 var
1309   I: Integer;
1310   Redraw: Boolean;
1311   OldValue: WideString;
1312   NewValue: WideString;
1313 begin
1314   OldValue := VarToWideStr(GetComboValue);
1315   NewValue := VarToWideStr(Value);
1316
1317   if NewValue <> OldValue then
1318   begin
1319     if Style <> csDropDown then
1320     begin
1321       Redraw := (Style <> csSimple) and HandleAllocated;
1322       if Redraw then Items.BeginUpdate;
1323       try
1324         if NewValue = '' then I := -1 else I := Items.IndexOf(NewValue);
1325         ItemIndex := I;
1326       finally
1327         Items.EndUpdate;
1328       end;
1329       if I >= 0 then Exit;
1330     end;
1331     if Style in [csDropDown, csSimple] then Text := NewValue;
1332   end;
1333 end;
1334
1335 function TTntDBComboBox.GetComboValue: Variant;
1336 var
1337   I: Integer;
1338 begin
1339   if Style in [csDropDown, csSimple] then Result := Text else
1340   begin
1341     I := ItemIndex;
1342     if I < 0 then Result := '' else Result := Items[I];
1343   end;
1344 end;
1345
1346 { TTntDBCheckBox }
1347
1348 procedure TTntDBCheckBox.CreateWindowHandle(const Params: TCreateParams);
1349 begin
1350   CreateUnicodeHandle(Self, Params, 'BUTTON');
1351 end;
1352
1353 procedure TTntDBCheckBox.DefineProperties(Filer: TFiler);
1354 begin
1355   inherited;
1356   TntPersistent_AfterInherited_DefineProperties(Filer, Self);
1357 end;
1358
1359 function TTntDBCheckBox.IsCaptionStored: Boolean;
1360 begin
1361   Result := TntControl_IsCaptionStored(Self);
1362 end;
1363
1364 function TTntDBCheckBox.GetCaption: TWideCaption;
1365 begin
1366   Result := TntControl_GetText(Self)
1367 end;
1368
1369 procedure TTntDBCheckBox.SetCaption(const Value: TWideCaption);
1370 begin
1371   TntControl_SetText(Self, Value);
1372 end;
1373
1374 function TTntDBCheckBox.IsHintStored: Boolean;
1375 begin
1376   Result := TntControl_IsHintStored(Self);
1377 end;
1378
1379 function TTntDBCheckBox.GetHint: WideString;
1380 begin
1381   Result := TntControl_GetHint(Self)
1382 end;
1383
1384 procedure TTntDBCheckBox.SetHint(const Value: WideString);
1385 begin
1386   TntControl_SetHint(Self, Value);
1387 end;
1388
1389 procedure TTntDBCheckBox.Toggle;
1390 var
1391   FDataLink: TDataLink;
1392 begin
1393   inherited;
1394   FDataLink := TDataLink(Perform(CM_GETDATALINK, 0, 0)) as TFieldDataLink;
1395   FDataLink.UpdateRecord;
1396 end;
1397
1398 procedure TTntDBCheckBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
1399 begin
1400   TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
1401   inherited;
1402 end;
1403
1404 function TTntDBCheckBox.GetActionLinkClass: TControlActionLinkClass;
1405 begin
1406   Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
1407 end;
1408
1409 { TTntDBRichEdit }
1410
1411 constructor TTntDBRichEdit.Create(AOwner: TComponent);
1412 begin
1413   inherited Create(AOwner);
1414   inherited ReadOnly := True;
1415   FAutoDisplay := True;
1416   FDataLink := TFieldDataLink.Create;
1417   FDataLink.Control := Self;
1418   FDataLink.OnDataChange := DataChange;
1419   FDataLink.OnEditingChange := EditingChange;
1420   FDataLink.OnUpdateData := UpdateData;
1421 end;
1422
1423 destructor TTntDBRichEdit.Destroy;
1424 begin
1425   FDataLink.Free;
1426   FDataLink := nil;
1427   inherited Destroy;
1428 end;
1429
1430 procedure TTntDBRichEdit.Loaded;
1431 begin
1432   inherited Loaded;
1433   if (csDesigning in ComponentState) then
1434     DataChange(Self)
1435 end;
1436
1437 procedure TTntDBRichEdit.Notification(AComponent: TComponent; Operation: TOperation);
1438 begin
1439   inherited;
1440   if (Operation = opRemove) and (FDataLink <> nil) and
1441     (AComponent = DataSource) then DataSource := nil;
1442 end;
1443
1444 function TTntDBRichEdit.UseRightToLeftAlignment: Boolean;
1445 begin
1446   Result := DBUseRightToLeftAlignment(Self, Field);
1447 end;
1448
1449 procedure TTntDBRichEdit.BeginEditing;
1450 begin
1451   if not FDataLink.Editing then
1452   try
1453     if FieldIsBlobLike(Field) then
1454       FDataSave := Field.AsString{TNT-ALLOW AsString};
1455     FDataLink.Edit;
1456   finally
1457     FDataSave := '';
1458   end;
1459 end;
1460
1461 procedure TTntDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
1462 begin
1463   inherited KeyDown(Key, Shift);
1464   if FMemoLoaded then
1465   begin
1466     if (Key = VK_DELETE) or (Key = VK_BACK) or
1467       ((Key = VK_INSERT) and (ssShift in Shift)) or
1468       (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
1469       BeginEditing;
1470   end;
1471 end;
1472
1473 procedure TTntDBRichEdit.KeyPress(var Key: AnsiChar);
1474 begin
1475   inherited KeyPress(Key);
1476   if FMemoLoaded then
1477   begin
1478     if (Key in [#32..#255]) and (Field <> nil) and
1479       not Field.IsValidChar(Key) then
1480     begin
1481       MessageBeep(0);
1482       Key := #0;
1483     end;
1484     case Key of
1485       ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
1486         BeginEditing;
1487       #27:
1488         FDataLink.Reset;
1489     end;
1490   end else
1491   begin
1492     if Key = #13 then LoadMemo;
1493     Key := #0;
1494   end;
1495 end;
1496
1497 procedure TTntDBRichEdit.Change;
1498 begin
1499   if FMemoLoaded then
1500     FDataLink.Modified;
1501   FMemoLoaded := True;
1502   inherited Change;
1503 end;
1504
1505 procedure TTntDBRichEdit.CNNotify(var Message: TWMNotify);
1506 begin
1507   inherited;
1508   if Message.NMHdr^.code = EN_PROTECTED then
1509     Message.Result := 0 { allow the operation (otherwise the control might appear stuck) }
1510 end;
1511
1512 function TTntDBRichEdit.GetDataSource: TDataSource;
1513 begin
1514   Result := FDataLink.DataSource;
1515 end;
1516
1517 procedure TTntDBRichEdit.SetDataSource(Value: TDataSource);
1518 begin
1519   FDataLink.DataSource := Value;
1520   if Value <> nil then Value.FreeNotification(Self);
1521 end;
1522
1523 function TTntDBRichEdit.GetDataField: WideString;
1524 begin
1525   Result := FDataLink.FieldName;
1526 end;
1527
1528 procedure TTntDBRichEdit.SetDataField(const Value: WideString);
1529 begin
1530   FDataLink.FieldName := Value;
1531 end;
1532
1533 function TTntDBRichEdit.GetReadOnly: Boolean;
1534 begin
1535   Result := FDataLink.ReadOnly;
1536 end;
1537
1538 procedure TTntDBRichEdit.SetReadOnly(Value: Boolean);
1539 begin
1540   FDataLink.ReadOnly := Value;
1541 end;
1542
1543 function TTntDBRichEdit.GetField: TField;
1544 begin
1545   Result := FDataLink.Field;
1546 end;
1547
1548 procedure TTntDBRichEdit.InternalLoadMemo;
1549 var
1550   Stream: TStringStream{TNT-ALLOW TStringStream};
1551 begin
1552   if PlainText then
1553     Text := GetAsWideString(Field)
1554   else begin
1555     Stream := TStringStream{TNT-ALLOW TStringStream}.Create(Field.AsString{TNT-ALLOW AsString});
1556     try
1557       Lines.LoadFromStream(Stream);
1558     finally
1559       Stream.Free;
1560     end;
1561   end;
1562 end;
1563
1564 procedure TTntDBRichEdit.LoadMemo;
1565 begin
1566   if not FMemoLoaded and Assigned(Field) and FieldIsBlobLike(Field) then
1567   begin
1568     try
1569       InternalLoadMemo;
1570       FMemoLoaded := True;
1571     except
1572       { Rich Edit Load failure }
1573       on E:EOutOfResources do
1574         Lines.Text := WideFormat('(%s)', [E.Message]);
1575     end;
1576     EditingChange(Self);
1577   end;
1578 end;
1579
1580 procedure TTntDBRichEdit.DataChange(Sender: TObject);
1581 begin
1582   if Field <> nil then
1583     if FieldIsBlobLike(Field) then
1584     begin
1585       if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
1586       begin
1587         { Check if the data has changed since we read it the first time }
1588         if (FDataSave <> '') and (FDataSave = Field.AsString{TNT-ALLOW AsString}) then Exit;
1589         FMemoLoaded := False;
1590         LoadMemo;
1591       end else
1592       begin
1593         Text := WideFormat('(%s)', [Field.DisplayName]);
1594         FMemoLoaded := False;
1595       end;
1596     end else
1597     begin
1598       if FFocused and FDataLink.CanModify then
1599         Text := GetWideText(Field)
1600       else
1601         Text := GetWideDisplayText(Field);
1602       FMemoLoaded := True;
1603     end
1604   else
1605   begin
1606     if csDesigning in ComponentState then Text := Name else Text := '';
1607     FMemoLoaded := False;
1608   end;
1609   if HandleAllocated then
1610     RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
1611 end;
1612
1613 procedure TTntDBRichEdit.EditingChange(Sender: TObject);
1614 begin
1615   inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
1616 end;
1617
1618 procedure TTntDBRichEdit.InternalSaveMemo;
1619 var
1620   Stream: TStringStream{TNT-ALLOW TStringStream};
1621 begin
1622   if PlainText then
1623     SetAsWideString(Field, Text)
1624   else begin
1625     Stream := TStringStream{TNT-ALLOW TStringStream}.Create('');
1626     try
1627       Lines.SaveToStream(Stream);
1628       Field.AsString{TNT-ALLOW AsString} := Stream.DataString;
1629     finally
1630       Stream.Free;
1631     end;
1632   end;
1633 end;
1634
1635 procedure TTntDBRichEdit.UpdateData(Sender: TObject);
1636 begin
1637   if FieldIsBlobLike(Field) then
1638     InternalSaveMemo
1639   else
1640     SetAsWideString(Field, Text);
1641 end;
1642
1643 procedure TTntDBRichEdit.SetFocused(Value: Boolean);
1644 begin
1645   if FFocused <> Value then
1646   begin
1647     FFocused := Value;
1648     if not Assigned(Field) or not FieldIsBlobLike(Field) then
1649       FDataLink.Reset;
1650   end;
1651 end;
1652
1653 procedure TTntDBRichEdit.CMEnter(var Message: TCMEnter);
1654 begin
1655   SetFocused(True);
1656   inherited;
1657 end;
1658
1659 procedure TTntDBRichEdit.CMExit(var Message: TCMExit);
1660 begin
1661   try
1662     FDataLink.UpdateRecord;
1663   except
1664     SetFocus;
1665     raise;
1666   end;
1667   SetFocused(False);
1668   inherited;
1669 end;
1670
1671 procedure TTntDBRichEdit.SetAutoDisplay(Value: Boolean);
1672 begin
1673   if FAutoDisplay <> Value then
1674   begin
1675     FAutoDisplay := Value;
1676     if Value then LoadMemo;
1677   end;
1678 end;
1679
1680 procedure TTntDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
1681 begin
1682   if not FMemoLoaded then LoadMemo else inherited;
1683 end;
1684
1685 procedure TTntDBRichEdit.WMCut(var Message: TMessage);
1686 begin
1687   BeginEditing;
1688   inherited;
1689 end;
1690
1691 procedure TTntDBRichEdit.WMPaste(var Message: TMessage);
1692 begin
1693   BeginEditing;
1694   inherited;
1695 end;
1696
1697 procedure TTntDBRichEdit.CMGetDataLink(var Message: TMessage);
1698 begin
1699   Message.Result := Integer(FDataLink);
1700 end;
1701
1702 function TTntDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
1703 begin
1704   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
1705     FDataLink.ExecuteAction(Action);
1706 end;
1707
1708 function TTntDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
1709 begin
1710   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
1711     FDataLink.UpdateAction(Action);
1712 end;
1713
1714 { TTntDBMemo }
1715
1716 constructor TTntDBMemo.Create(AOwner: TComponent);
1717 begin
1718   inherited Create(AOwner);
1719   inherited ReadOnly := True;
1720   ControlStyle := ControlStyle + [csReplicatable];
1721   FAutoDisplay := True;
1722   FDataLink := TFieldDataLink.Create;
1723   FDataLink.Control := Self;
1724   FDataLink.OnDataChange := DataChange;
1725   FDataLink.OnEditingChange := EditingChange;
1726   FDataLink.OnUpdateData := UpdateData;
1727   FPaintControl := TTntPaintControl.Create(Self, 'EDIT');
1728 end;
1729
1730 destructor TTntDBMemo.Destroy;
1731 begin
1732   FPaintControl.Free;
1733   FDataLink.Free;
1734   FDataLink := nil;
1735   inherited Destroy;
1736 end;
1737
1738 procedure TTntDBMemo.Loaded;
1739 begin
1740   inherited Loaded;
1741   if (csDesigning in ComponentState) then DataChange(Self);
1742 end;
1743
1744 procedure TTntDBMemo.Notification(AComponent: TComponent;
1745   Operation: TOperation);
1746 begin
1747   inherited Notification(AComponent, Operation);
1748   if (Operation = opRemove) and (FDataLink <> nil) and
1749     (AComponent = DataSource) then DataSource := nil;
1750 end;
1751
1752 function TTntDBMemo.UseRightToLeftAlignment: Boolean;
1753 begin
1754   Result := DBUseRightToLeftAlignment(Self, Field);
1755 end;
1756
1757 procedure TTntDBMemo.KeyDown(var Key: Word; Shift: TShiftState);
1758 begin
1759   inherited KeyDown(Key, Shift);
1760   if FMemoLoaded then
1761   begin
1762     if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
1763       FDataLink.Edit;
1764   end;
1765 end;
1766
1767 procedure TTntDBMemo.KeyPress(var Key: Char{TNT-ALLOW Char});
1768 begin
1769   inherited KeyPress(Key);
1770   if FMemoLoaded then
1771   begin
1772     if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
1773       not FDataLink.Field.IsValidChar(Key) then
1774     begin
1775       MessageBeep(0);
1776       Key := #0;
1777     end;
1778     case Key of
1779       ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
1780         FDataLink.Edit;
1781       #27:
1782         FDataLink.Reset;
1783     end;
1784   end else
1785   begin
1786     if Key = #13 then LoadMemo;
1787     Key := #0;
1788   end;
1789 end;
1790
1791 procedure TTntDBMemo.Change;
1792 begin
1793   if FMemoLoaded then FDataLink.Modified;
1794   FMemoLoaded := True;
1795   inherited Change;
1796 end;
1797
1798 function TTntDBMemo.GetDataSource: TDataSource;
1799 begin
1800   Result := FDataLink.DataSource;
1801 end;
1802
1803 procedure TTntDBMemo.SetDataSource(Value: TDataSource);
1804 begin
1805   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
1806     FDataLink.DataSource := Value;
1807   if Value <> nil then Value.FreeNotification(Self);
1808 end;
1809
1810 function TTntDBMemo.GetDataField: WideString;
1811 begin
1812   Result := FDataLink.FieldName;
1813 end;
1814
1815 procedure TTntDBMemo.SetDataField(const Value: WideString);
1816 begin
1817   FDataLink.FieldName := Value;
1818 end;
1819
1820 function TTntDBMemo.GetReadOnly: Boolean;
1821 begin
1822   Result := FDataLink.ReadOnly;
1823 end;
1824
1825 procedure TTntDBMemo.SetReadOnly(Value: Boolean);
1826 begin
1827   FDataLink.ReadOnly := Value;
1828 end;
1829
1830 function TTntDBMemo.GetField: TField;
1831 begin
1832   Result := FDataLink.Field;
1833 end;
1834
1835 procedure TTntDBMemo.LoadMemo;
1836 begin
1837   if not FMemoLoaded and Assigned(FDataLink.Field) and FieldIsBlobLike(FDataLink.Field) then
1838   begin
1839     try
1840       Lines.Text := GetAsWideString(FDataLink.Field);
1841       FMemoLoaded := True;
1842     except
1843       { Memo too large }
1844       on E:EInvalidOperation do
1845         Lines.Text := WideFormat('(%s)', [E.Message]);
1846     end;
1847     EditingChange(Self);
1848   end;
1849 end;
1850
1851 procedure TTntDBMemo.DataChange(Sender: TObject);
1852 begin
1853   if FDataLink.Field <> nil then
1854     if FieldIsBlobLike(FDataLink.Field) then
1855     begin
1856       if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
1857       begin
1858         FMemoLoaded := False;
1859         LoadMemo;
1860       end else
1861       begin
1862         Text := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
1863         FMemoLoaded := False;
1864         EditingChange(Self);
1865       end;
1866     end else
1867     begin
1868       if FFocused and FDataLink.CanModify then
1869         Text := GetWideText(FDataLink.Field)
1870       else
1871         Text := GetWideDisplayText(FDataLink.Field);
1872       FMemoLoaded := True;
1873     end
1874   else
1875   begin
1876     if csDesigning in ComponentState then Text := Name else Text := '';
1877     FMemoLoaded := False;
1878   end;
1879   if HandleAllocated then
1880     RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
1881 end;
1882
1883 procedure TTntDBMemo.EditingChange(Sender: TObject);
1884 begin
1885   inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
1886 end;
1887
1888 procedure TTntDBMemo.UpdateData(Sender: TObject);
1889 begin
1890   SetAsWideString(FDataLink.Field, Text);
1891 end;
1892
1893 procedure TTntDBMemo.SetFocused(Value: Boolean);
1894 begin
1895   if FFocused <> Value then
1896   begin
1897     FFocused := Value;
1898     if not Assigned(FDataLink.Field) or not FieldIsBlobLike(FDataLink.Field) then
1899       FDataLink.Reset;
1900   end;
1901 end;
1902
1903 procedure TTntDBMemo.WndProc(var Message: TMessage);
1904 begin
1905   with Message do
1906     if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
1907       (Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
1908   inherited;
1909 end;
1910
1911 procedure TTntDBMemo.CMEnter(var Message: TCMEnter);
1912 begin
1913   SetFocused(True);
1914   inherited;
1915 end;
1916
1917 procedure TTntDBMemo.CMExit(var Message: TCMExit);
1918 begin
1919   try
1920     FDataLink.UpdateRecord;
1921   except
1922     SetFocus;
1923     raise;
1924   end;
1925   SetFocused(False);
1926   inherited;
1927 end;
1928
1929 procedure TTntDBMemo.SetAutoDisplay(Value: Boolean);
1930 begin
1931   if FAutoDisplay <> Value then
1932   begin
1933     FAutoDisplay := Value;
1934     if Value then LoadMemo;
1935   end;
1936 end;
1937
1938 procedure TTntDBMemo.WMLButtonDblClk(var Message: TWMLButtonDblClk);
1939 begin
1940   if not FMemoLoaded then LoadMemo else inherited;
1941 end;
1942
1943 procedure TTntDBMemo.WMCut(var Message: TMessage);
1944 begin
1945   FDataLink.Edit;
1946   inherited;
1947 end;
1948
1949 procedure TTntDBMemo.WMUndo(var Message: TMessage);
1950 begin
1951   FDataLink.Edit;
1952   inherited;
1953 end;
1954
1955 procedure TTntDBMemo.WMPaste(var Message: TMessage);
1956 begin
1957   FDataLink.Edit;
1958   inherited;
1959 end;
1960
1961 procedure TTntDBMemo.CMGetDataLink(var Message: TMessage);
1962 begin
1963   Message.Result := Integer(FDataLink);
1964 end;
1965
1966 procedure TTntDBMemo.WMPaint(var Message: TWMPaint);
1967 var
1968   S: WideString;
1969 begin
1970   if not (csPaintCopy in ControlState) then
1971     inherited
1972   else begin
1973     if FDataLink.Field <> nil then
1974       if FieldIsBlobLike(FDataLink.Field) then
1975       begin
1976         if FAutoDisplay then
1977           S := TntAdjustLineBreaks(GetAsWideString(FDataLink.Field)) else
1978           S := WideFormat('(%s)', [FDataLink.Field.DisplayName]);
1979       end else
1980         S := GetWideDisplayText(FDataLink.Field);
1981     if (not Win32PlatformIsUnicode) then
1982       SendMessageA(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PAnsiChar(AnsiString(S))))
1983     else begin
1984       SendMessageW(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PWideChar(S)));
1985     end;
1986     SendMessage(FPaintControl.Handle, WM_ERASEBKGND, Integer(Message.DC), 0);
1987     SendMessage(FPaintControl.Handle, WM_PAINT, Integer(Message.DC), 0);
1988   end;
1989 end;
1990
1991 function TTntDBMemo.ExecuteAction(Action: TBasicAction): Boolean;
1992 begin
1993   Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
1994     FDataLink.ExecuteAction(Action);
1995 end;
1996
1997 function TTntDBMemo.UpdateAction(Action: TBasicAction): Boolean;
1998 begin
1999   Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
2000     FDataLink.UpdateAction(Action);
2001 end;
2002
2003 { TTntDBRadioGroup }
2004
2005 constructor TTntDBRadioGroup.Create(AOwner: TComponent);
2006 begin
2007   inherited Create(AOwner);
2008   FDataLink := TFieldDataLink.Create;
2009   FDataLink.Control := Self;
2010   FDataLink.OnDataChange := DataChange;
2011   FDataLink.OnUpdateData := UpdateData;
2012   FValues := TTntStringList.Create;
2013 end;
2014
2015 destructor TTntDBRadioGroup.Destroy;
2016 begin
2017   FDataLink.Free;
2018   FDataLink := nil;
2019   FValues.Free;
2020   inherited Destroy;
2021 end;
2022
2023 procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
2024   Operation: TOperation);
2025 begin
2026   inherited Notification(AComponent, Operation);
2027   if (Operation = opRemove) and (FDataLink <> nil) and
2028     (AComponent = DataSource) then DataSource := nil;
2029 end;
2030
2031 function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
2032 begin
2033   Result := inherited UseRightToLeftAlignment;
2034 end;
2035
2036 procedure TTntDBRadioGroup.DataChange(Sender: TObject);
2037 begin
2038   if FDataLink.Field <> nil then
2039     Value := GetWideText(FDataLink.Field) else
2040     Value := '';
2041 end;
2042
2043 procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
2044 begin
2045   if FDataLink.Field <> nil then
2046     SetWideText(FDataLink.Field, Value);
2047 end;
2048
2049 function TTntDBRadioGroup.GetDataSource: TDataSource;
2050 begin
2051   Result := FDataLink.DataSource;
2052 end;
2053
2054 procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
2055 begin
2056   FDataLink.DataSource := Value;
2057   if Value <> nil then Value.FreeNotification(Self);
2058 end;
2059
2060 function TTntDBRadioGroup.GetDataField: WideString;
2061 begin
2062   Result := FDataLink.FieldName;
2063 end;
2064
2065 procedure TTntDBRadioGroup.SetDataField(const Value: WideString);
2066 begin
2067   FDataLink.FieldName := Value;
2068 end;
2069
2070 function TTntDBRadioGroup.GetReadOnly: Boolean;
2071 begin
2072   Result := FDataLink.ReadOnly;
2073 end;
2074
2075 procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
2076 begin
2077   FDataLink.ReadOnly := Value;
2078 end;
2079
2080 function TTntDBRadioGroup.GetField: TField;
2081 begin
2082   Result := FDataLink.Field;
2083 end;
2084
2085 function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
2086 begin
2087   if (Index < FValues.Count) and (FValues[Index] <> '') then
2088     Result := FValues[Index]
2089   else if Index < Items.Count then
2090     Result := Items[Index]
2091   else
2092     Result := '';
2093 end;
2094
2095 procedure TTntDBRadioGroup.SetValue(const Value: WideString);
2096 var
2097   WasFocused: Boolean;
2098   I, Index: Integer;
2099 begin
2100   if FValue <> Value then
2101   begin
2102     FInSetValue := True;
2103     try
2104       WasFocused := (ItemIndex > -1) and (Buttons[ItemIndex].Focused);
2105       Index := -1;
2106       for I := 0 to Items.Count - 1 do
2107         if Value = GetButtonValue(I) then
2108         begin
2109           Index := I;
2110           Break;
2111         end;
2112       ItemIndex := Index;
2113       // Move the focus rect along with the selected index
2114       if WasFocused then
2115         Buttons[ItemIndex].SetFocus;
2116     finally
2117       FInSetValue := False;
2118     end;
2119     FValue := Value;
2120     Change;
2121   end;
2122 end;
2123
2124 procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
2125 begin
2126   try
2127     FDataLink.UpdateRecord;
2128   except
2129     if ItemIndex >= 0 then
2130       (Controls[ItemIndex] as TTntRadioButton).SetFocus else
2131       (Controls[0] as TTntRadioButton).SetFocus;
2132     raise;
2133   end;
2134   inherited;
2135 end;
2136
2137 procedure TTntDBRadioGroup.CMGetDataLink(var Message: TMessage);
2138 begin
2139   Message.Result := Integer(FDataLink);
2140 end;
2141
2142 procedure TTntDBRadioGroup.Click;
2143 begin
2144   if not FInSetValue then
2145   begin
2146     inherited Click;
2147     if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
2148     if FDataLink.Editing then FDataLink.Modified;
2149   end;
2150 end;
2151
2152 procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
2153 begin
2154   Items.Assign(Value);
2155   DataChange(Self);
2156 end;
2157
2158 procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
2159 begin
2160   FValues.Assign(Value);
2161   DataChange(Self);
2162 end;
2163
2164 procedure TTntDBRadioGroup.Change;
2165 begin
2166   if Assigned(FOnChange) then FOnChange(Self);
2167 end;
2168
2169 procedure TTntDBRadioGroup.KeyPress(var Key: Char{TNT-ALLOW Char});
2170 begin
2171   inherited KeyPress(Key);
2172   case Key of
2173     #8, ' ': FDataLink.Edit;
2174     #27: FDataLink.Reset;
2175   end;
2176 end;
2177
2178 function TTntDBRadioGroup.CanModify: Boolean;
2179 begin
2180   Result := FDataLink.Edit;
2181 end;
2182
2183 function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
2184 begin
2185   Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
2186     DataLink.ExecuteAction(Action);
2187 end;
2188
2189 function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
2190 begin
2191   Result := inherited UpdateAction(Action) or (DataLink <> nil) and
2192     DataLink.UpdateAction(Action);
2193 end;
2194
2195 end.