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.
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.