Как поместить данные в 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