unit InsertRichEditUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, RichEdit, UHISRichEd;

type
  TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint;
    var pcb: Longint): DWORD; stdcall;

  TEditStream = record
    dwCookie: Longint;
    dwError: Longint;
    pfnCallback: TEditStreamCallBack;
  end;

procedure GetRTFSelection(aRichEdit: TUHISRichEdit; IntoStream: TStream);
procedure PutRTFSelection(aRichEdit: TUHISRichEdit; SourceStream: TStream);
procedure InsertRTF(aRichEdit: TUHISRichEdit; S: string);
procedure CopyRTF(aSource, aDest: TUHISRichEdit);
procedure CopyAllRTF(aSource, aDest: TUHISRichEdit);
procedure AppendRTF(aRichEdit: TUHISRichEdit; S: string);

implementation

function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): DWORD; stdcall;
var
  TheStream: TStream;
  DataAvail: LongInt;
begin
  TheStream := TStream(dwCookie);
  with TheStream do
  begin
    DataAvail := Size - Position;
    Result := 0;
    if DataAvail <= cb then
    begin
      pcb := Read(pbBuff^, DataAvail);
      if pcb <> DataAvail then
        result := DWord(E_FAIL);
    end
    else
    begin
      pcb := Read(pbBuff^, cb);
      if pcb <> cb then
        result := DWord(E_FAIL);
    end;
  end;
  TheStream := TStream(dwCookie);
end;

function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;
  var pcb: Longint): DWORD; stdcall;
var
  TheStream: TStream;
begin
  TheStream := TStream(dwCookie);
  with TheStream do
  begin
    if cb > 0 then
      pcb := Write(pbBuff^, cb);
    Result := 0;
  end;
end;

procedure GetRTFSelection(aRichEdit: TUHISRichEdit; IntoStream: TStream);
var
  EditStream: TEditStream;
begin
  with EditStream do
  begin
    dwCookie := Longint(IntoStream);
    dwError := 0;
    pfnCallback := EditStreamOutCallBack;
  end;
  aRichEdit.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@EditStream));
end;

procedure PutRTFSelection(aRichEdit: TUHISRichEdit; SourceStream: TStream);
var
  EditStream: TEditStream;
begin
  with EditStream do
  begin
    dwCookie := Longint(SourceStream);
    dwError := 0;
    pfnCallback := EditStreamInCallBack;
  end;
  aRichEdit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@EditStream));
end;

procedure InsertRTF(aRichEdit: TUHISRichEdit; S: string);
var
  aMemStream: TMemoryStream;
begin
  if Length(S) > 0 then
  begin
    aMemStream := TMemoryStream.Create;
    try
      aMemStream.Write(S[1], length(S));
      aMemStream.Position := 0;
      PutRTFSelection(aRichEdit, aMemStream);
    finally
      aMemStream.Free;
    end;
  end;
end;

procedure CopyRTF(aSource, aDest: TUHISRichEdit);
var
  aMemStream: TMemoryStream;
begin
  aMemStream := TMemoryStream.Create;
  try
    GetRTFSelection(aSource, aMemStream);
    aMemStream.Position := 0;
    PutRTFSelection(aDest, aMemStream);
  finally
    aMemStream.Free;
  end;
end;

procedure CopyAllRTF(aSource, aDest: TUHISRichEdit);
var
  aMemStream: TMemoryStream;
begin
  aMemStream := TMemoryStream.Create;
  try
    aSource.SelectAll;
    GetRTFSelection(aSource, aMemStream);
    aMemStream.Position := 0;
    aDest.SelStart := Length(aDest.Lines.Text);
    PutRTFSelection(aDest, aMemStream);
  finally
    aMemStream.Free;
  end;
end;

procedure AppendRTF(aRichEdit: TUHISRichEdit; S: string);
var
  Start, Length, EventMask: Integer;
begin
  EventMask := SendMessage(aRichEdit.Handle, EM_SETEventMask, 0, 0);
  SendMessage(aRichEdit.Handle, WM_SETREDRAW, 0, 0);
  Start := aRichEdit.SelStart;
  Length := aRichEdit.SelLength;
  aRichEdit.SelLength := 0;
  aRichEdit.SelStart := System.Length(aRichEdit.Text);
  InsertRTF(aRichEdit, s);
  aRichEdit.SelStart := Start;
  aRichEdit.SelLength := Length;
  SendMessage(aRichEdit.Handle, WM_SETREDRAW, 1, 0);
  InvalidateRect(aRichEdit.Handle, nil, True);
  SendMessage(aRichEdit.Handle, EM_SETEventMask, 0, EventMask);
end;

end.