unit dbrich;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ComCtrls, DB, DBTables, Menus, ExtCtrls, Mask, Buttons, DBCtrls;
//Замечание: вызывать Tablex.Edit необходимо перед изменением свойства paragraph
type
 TDBRichEdit = class(TRichEdit)
 private
  FDataLink: TFieldDataLink;
  FAutoDisplay: Boolean;
  FFocused: Boolean;
  FMemoLoaded: Boolean;
  FPaintControl: TPaintControl;
  procedure DataChange(Sender: TObject);
  procedure EditingChange(Sender: TObject);
  function GetDataField: string;
  function GetDataSource: TDataSource;
  function GetField: TField;
  function GetReadOnly: Boolean;
  procedure SetDataField(const Value: string);
  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 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); override;
  procedure Notification(AComponent: TComponent;
  Operation: TOperation); override;
  procedure WndProc(var Message: TMessage); override;
 public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure LoadMemo;
  property  Field: TField read GetField;
 published
  property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay
  default True;
  property DataField: string read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property ReadOnly: Boolean read GetReadOnly write SetReadOnly
  default False;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Data Controls', [TDBRichEdit]);
end;
{Mostly copied from DBMemo}
constructor TDBRichEdit.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;
 FPaintControl := TPaintControl.Create(Self, 'EDIT');
end;
destructor TDBRichEdit.Destroy;
begin
 FPaintControl.Free;
 FDataLink.Free;
 FDataLink := nil;
 inherited Destroy;
end;
procedure TDBRichEdit.Notification(AComponent: TComponent;
 Operation: TOperation);
begin
 inherited Notification(AComponent, Operation);
 if (Operation = opRemove) and (FDataLink <> nil) and
  (AComponent = DataSource) then DataSource := nil;
end;
procedure TDBRichEdit.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 else
  Key := 0;
end;
procedure TDBRichEdit.KeyPress(var Key: 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 TDBRichEdit.Change;
begin
 with FdataLink do
 begin
  {if Assigned(FdataLink) and (Assigned(DataSource))and
  (DataSource.State = dsBrowse) then
  Edit; } {make sure edits on Attributes change}
  if FMemoLoaded then Modified;
 end;
 FMemoLoaded := True;
 inherited Change;
end;
function TDBRichEdit.GetDataSource: TDataSource;
begin
 Result := FDataLink.DataSource;
end;
procedure TDBRichEdit.SetDataSource(Value: TDataSource);
begin
 FDataLink.DataSource := Value;
 if Value <> nil then Value.FreeNotification(Self);
end;
function TDBRichEdit.GetDataField: string;
begin
 Result := FDataLink.FieldName;
end;
procedure TDBRichEdit.SetDataField(const Value: string);
begin
 FDataLink.FieldName := Value;
end;
function TDBRichEdit.GetReadOnly: Boolean;
begin
 Result := FDataLink.ReadOnly;
end;