Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как поместить данные в TRichEdit-контролл?

01.01.2007
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;

Взято из https://forum.sources.ru