Как поместить данные в RichEdit контрол?
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;
Взято с Исходников.ru
Содержание Назад Вперед