unit XRichEdits;

interface

uses
	ComCtrls, RichEdit, Controls, Classes, TOM_TLB, Messages, Windows;

type
{ TCustomXRichEdit }

	TCustomXRichEdit = class(TWinControl)
	private
		FDoc: ITextDocument;
		FOnChange: TNotifyEvent;
		FOnSelChange: TNotifyEvent;
		FOnResizeRequest: TRichEditResizeEvent;
		FOnProtectChange: TRichEditProtectChange;
		FOnSaveClipboard: TRichEditSaveClipboard;
		FPlainText: Boolean;
		FSingleLevelUndo: Boolean;
		FSingleCodePage: Boolean;
		FDefaultTabStop: Single;
		FSaveText: String;
		FRestoreText: Boolean;
		FReadOnly: Boolean;

		function GetDoc: ITextDocument;

		function GetText: String;
		procedure SetText(const aValue: String);
		procedure SetPlainText(aValue: Boolean);
		procedure SetSingleLevelUndo(aValue: Boolean);
		procedure SetSingleCodePage(aValue: Boolean);
		procedure SetDefaultTabStop(aValue: Single);
		procedure SetReadOnly(aValue: Boolean);

		function ProtectChange(aStartPos, anEndPos: Integer): Boolean;
		procedure UpdateTextMode;
	protected
		procedure CreateParams(var aParams: TCreateParams); override;
		procedure CreateWnd; override;
		procedure DestroyWnd; override;
		procedure CNNotify(var aMsg: TWMNotify); message CN_NOTIFY;
		procedure CNCommand(var aMsg: TWMCommand); message CN_COMMAND;
		procedure WMGetDlgCode(var aMsg: TWMGetDlgCode); message WM_GETDLGCODE;

		procedure Change; dynamic;
		procedure SelectionChange; dynamic;
		procedure RequestSize(const aRect: TRect); virtual;
		function SaveClipboard(aNumObj, aNumChars: Integer): Boolean;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
		property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
			write FOnSaveClipboard;
		property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
		property OnProtectChange: TRichEditProtectChange read FOnProtectChange
			write FOnProtectChange;
		property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
			write FOnResizeRequest;
	public
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;

		property Text: String read GetText write SetText;
		property Doc: ITextDocument read GetDoc;
		property ReadOnly: Boolean read FReadOnly write SetReadOnly;
		property PlainText: Boolean read FPlainText write SetPlainText;
		property SingleLevelUndo: Boolean read FSingleLevelUndo write SetSingleLevelUndo;
		property SingleCodePage: Boolean read FSingleCodePage write SetSingleCodePage;
		property DefaultTabStop: Single read FDefaultTabStop write SetDefaultTabStop;
	end;

  TXRichEdit = class(TCustomXRichEdit)
  published
    property Align;
		property Anchors;
    property BiDiMode;
		property BorderWidth;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
		property ImeMode;
    property ImeName;
    property Constraints;
		property ParentBiDiMode;
		property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
		property PopupMenu;
		property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
		property OnChange;
    property OnContextPopup;
		property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnProtectChange;
    property OnResizeRequest;
    property OnSaveClipboard;
    property OnSelectionChange;
    property OnStartDock;
    property OnStartDrag;
		property PlainText;
		property SingleLevelUndo;
		property SingleCodePage;
		property DefaultTabStop;
	end;


implementation

var
	FRichEditModule: THandle = 0;

constructor TCustomXRichEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
	TabStop := True;
	Width := 185;
	Height := 89;
	DoubleBuffered := False;
	FDefaultTabStop := 14.173228346456692913385826771654;
end;

destructor TCustomXRichEdit.Destroy;
begin
	inherited;
end;

procedure TCustomXRichEdit.CreateParams(var aParams: TCreateParams);
const
	RichEditModuleName = 'RICHED20.DLL';
begin
	if FRichEditModule = 0 then begin
		FRichEditModule := LoadLibrary(RichEditModuleName);
		if FRichEditModule <= HINSTANCE_ERROR then
			FRichEditModule := 0;
	end;
	inherited CreateParams(aParams);
	CreateSubClass(aParams, RICHEDIT_CLASS);
	with aParams do begin
		Style := Style or ES_NOHIDESEL or ES_MULTILINE or WS_HSCROLL or WS_VSCROLL or
			ES_AUTOHSCROLL;
		if FReadOnly then
			Style := Style or ES_READONLY
		else
			Style := Style and not ES_READONLY;
		WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
	end;
end;

function TCustomXRichEdit.GetDoc: ITextDocument;
var
	pUnk: Pointer;
	unk: IUnknown;
begin
	if not Assigned(FDoc) then begin
		pUnk := nil;
		SendMessage(Handle, EM_GETOLEINTERFACE, 0, LPARAM(@pUnk));
		unk := IUnknown(pUnk);
		FDoc := unk as ITextDocument;
	end;
	Result := FDoc;
end;

procedure TCustomXRichEdit.CreateWnd;
const
	EmptyStr: PChar = '';
begin
	inherited CreateWnd;
	SendMessage(Handle, EM_SETEVENTMASK, 0,
		ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
		ENM_PROTECTED);
	Perform(WM_SETTEXT, 0, LPARAM(EmptyStr));
	Doc.DefaultTabStop := FDefaultTabStop;
	UpdateTextMode;
	if FRestoreText then begin
		Text := FSaveText;
		FSaveText := '';
		FRestoreText := False
	end;
end;

procedure TCustomXRichEdit.DestroyWnd;
begin
	FRestoreText := True;
	FSaveText := Text;
	FDoc := nil;
	inherited DestroyWnd;
end;

procedure TCustomXRichEdit.CNCommand(var aMsg: TWMCommand);
begin
	if (aMsg.NotifyCode = EN_CHANGE) then Change;
end;

procedure TCustomXRichEdit.CNNotify(var aMsg: TWMNotify);
begin
	with aMsg do
		case NMHdr^.code of
      EN_SELCHANGE: SelectionChange;
      EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
      EN_SAVECLIPBOARD:
        with PENSaveClipboard(NMHdr)^ do
          if not SaveClipboard(cObjectCount, cch) then Result := 1;
      EN_PROTECTED:
        with PENProtected(NMHdr)^.chrg do
          if not ProtectChange(cpMin, cpMax) then Result := 1;
    end;
end;

function TCustomXRichEdit.SaveClipboard(aNumObj, aNumChars: Integer): Boolean;
begin
  Result := True;
  if Assigned(OnSaveClipboard) then OnSaveClipboard(Self, aNumObj, aNumChars, Result);
end;

function TCustomXRichEdit.ProtectChange(aStartPos, anEndPos: Integer): Boolean;
begin
  Result := False;
  if Assigned(OnProtectChange) then OnProtectChange(Self, aStartPos, anEndPos, Result);
end;

procedure TCustomXRichEdit.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TCustomXRichEdit.SelectionChange;
begin
	if Assigned(OnSelectionChange) then OnSelectionChange(Self);
end;

procedure TCustomXRichEdit.RequestSize(const aRect: TRect);
begin
	if Assigned(OnResizeRequest) then OnResizeRequest(Self, aRect);
end;


procedure TCustomXRichEdit.WMGetDlgCode(var aMsg: TWMGetDlgCode);
begin
  inherited;
  aMsg.Result := aMsg.Result or DLGC_WANTTAB;
	aMsg.Result := aMsg.Result or DLGC_WANTALLKEYS;
end;

procedure TCustomXRichEdit.UpdateTextMode;
var
	aTextMode: Integer;
begin
	if FPlainText then
		aTextMode := TM_PLAINTEXT
	else
		aTextMode := TM_RICHTEXT;
	if FSingleLevelUndo then
		aTextMode := aTextMode or TM_SINGLELEVELUNDO
	else
		aTextMode := aTextMode or TM_MULTILEVELUNDO;
	if FSingleCodePage then
		aTextMode := aTextMode or TM_SINGLECODEPAGE
	else
		aTextMode := aTextMode or TM_MULTICODEPAGE;
	Perform(EM_SETTEXTMODE, aTextMode, 0);
end;

procedure TCustomXRichEdit.SetPlainText(aValue: Boolean);
begin
	if FPlainText <> aValue then begin
		FPlainText := aValue;
		UpdateTextMode;
	end
end;

procedure TCustomXRichEdit.SetSingleCodePage(aValue: Boolean);
begin
	if FSingleCodePage <> aValue then begin
		FSingleCodePage := aValue;
		UpdateTextMode;
	end
end;

procedure TCustomXRichEdit.SetSingleLevelUndo(aValue: Boolean);
begin
	if FSingleLevelUndo <> aValue then begin
		FSingleLevelUndo := aValue;
		UpdateTextMode;
	end
end;

procedure TCustomXRichEdit.SetDefaultTabStop(aValue: Single);
begin
	if FDefaultTabStop <> aValue then begin
		FDefaultTabStop := aValue;
		Doc.DefaultTabStop := aValue;
	end;
end;

function TCustomXRichEdit.GetText: String;
var
	aLen: Integer;
begin
	aLen := Perform(WM_GETTEXTLENGTH, 0, 0);
  SetString(Result, nil, aLen);
	if aLen <> 0 then
		Perform(WM_GETTEXT, aLen + 1, LPARAM(Pointer(Result)));
end;

procedure TCustomXRichEdit.SetText(const aValue: String);
var
	aRange: ITextRange;
begin
	aRange := Doc.Range(0, 0);
	aRange.MoveEnd(tomStory, 1);
	aRange.Text := aValue;
end;

procedure TCustomXRichEdit.SetReadOnly(aValue: Boolean);
begin
	if aValue <> FReadOnly then begin
		FReadOnly := aValue;
		if HandleAllocated then
			SendMessage(Handle, EM_SETREADONLY, Ord(aValue), 0);
	end;
end;

initialization
finalization
	if FRichEditModule <> 0 then FreeLibrary(FRichEditModule);
end.
 