Copy
formated Rtf-Text from one TRichedit to an other
Author:
NicoDE
uses
RichEdit;
type
TEditStreamCallBack = function(dwCookie:
Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): DWORD;
stdcall;
TEditStream = record
dwCookie: Longint;
dwError: Longint;
pfnCallback: TEditStreamCallBack;
end;
const
EditStreamCookieDoOut = 0;
EditStreamCookieDoIn = 1;
var
EditStreamCallBackData: PChar;
EditStreamCallBackPos: Longint;
function
EditStreamCallBack(dwCookie: Longint; pbBuff: PByte; cb: Longint;
var pcb: Longint): DWORD; stdcall;
var
Size: Integer;
Data: PChar;
begin
case dwCookie of
EditStreamCookieDoOut:
begin
if EditStreamCallBackData = nil then
begin
Data := GetMemory(cb);
if Data <> nil then
try
CopyMemory(Data, pbBuff, cb);
EditStreamCallBackData := Data;
EditStreamCallBackPos := cb;
pcb := cb;
Result := ERROR_SUCCESS;
except
Result := ERROR_CANNOT_COPY;
end
else
begin
Result := ERROR_NOT_ENOUGH_MEMORY;
end;
end
else
begin
Data :=
GetMemory(EditStreamCallBackPos + cb);
if Data <> nil then
try
CopyMemory(Data,
EditStreamCallBackData, EditStreamCallBackPos);
CopyMemory(@Data[EditStreamCallBackPos],
pbBuff, cb);
FreeMemory(EditStreamCallBackData);
EditStreamCallBackData := Data;
EditStreamCallBackPos :=
EditStreamCallBackPos + cb;
pcb := cb;
Result := ERROR_SUCCESS;
except
Result := ERROR_CANNOT_COPY;
end
else
begin
Result := ERROR_NOT_ENOUGH_MEMORY;
end;
end;
end;
EditStreamCookieDoIn:
begin
if EditStreamCallBackData <> nil
then
begin
Size :=
lstrlen(EditStreamCallBackData) + 1 - EditStreamCallBackPos;
if Size > 0 then
begin
if cb < Size then
pcb := cb
else
pcb := Size;
try
CopyMemory(pbBuff,
@EditStreamCallBackData[EditStreamCallBackPos], pcb);
EditStreamCallBackPos :=
EditStreamCallBackPos + pcb;
Result := ERROR_SUCCESS;
except
Result := ERROR_CANNOT_COPY;
end;
end
else
begin
Result :=
ERROR_INSUFFICIENT_BUFFER;
end;
end
else
begin
Result := ERROR_NO_DATA;
end;
end;
else
Result := ERROR_INVALID_PARAMETER;
end;
end;
{------------------------------------------------------------------------------}
function
StreamOutRtf(const RichEdit: HWND; out Stream: PChar): Cardinal;
var
EditStream: TEditStream;
begin
if (RichEdit <> 0) and
IsWindow(RichEdit) then
begin
if
(EditStreamCallBackData = nil) then
try
EditStream.dwCookie :=
EditStreamCookieDoOut;
EditStream.dwError := ERROR_NO_DATA;
EditStream.pfnCallback :=
EditStreamCallBack;
SendMessage(RichEdit, EM_STREAMOUT,
SF_RTF, lParam(@EditStream));
Result := EditStream.dwError;
RaiseLastWin32Error;
if Result <> ERROR_SUCCESS then
begin
if EditStreamCallBackData <>
nil then
FreeMemory(EditStreamCallBackData);
end
else
begin
Stream :=
GetMemory(EditStreamCallBackPos + 1);
if Stream <> nil then
try
ZeroMemory(Stream,
EditStreamCallBackPos + 1);
CopyMemory(Stream, EditStreamCallBackData, EditStreamCallBackPos);
except
FreeMemory(Stream);
Stream := nil;
Result := ERROR_CANNOT_COPY;
end
else
begin
Result := ERROR_NOT_ENOUGH_MEMORY;
end;
if Result <> ERROR_SUCCESS
then
FreeMemory(EditStreamCallBackData);
end;
finally
EditStreamCallBackData := nil;
EditStreamCallBackPos := 0;
end
else
begin
Result := ERROR_NOT_READY;
end;
end
else
begin
Result := ERROR_INVALID_PARAMETER;
end;
end;
function
StreamInRtf(const RichEdit: HWND; const Stream: PChar): Cardinal;
var
EditStream: TEditStream;
begin
if (RichEdit <> 0) and
IsWindow(RichEdit) and (Stream <> nil) then
begin
if (EditStreamCallBackData = nil) then
try
EditStreamCallBackData := Stream;
EditStreamCallBackPos := 0;
EditStream.dwCookie :=
EditStreamCookieDoIn;
EditStream.dwError := ERROR_NO_DATA;
EditStream.pfnCallback :=
EditStreamCallBack;
SendMessage(RichEdit, EM_STREAMIN,
SF_RTF, lParam(@EditStream));
Result := EditStream.dwError;
finally
EditStreamCallBackData := nil;
EditStreamCallBackPos := 0;
end
else
begin
Result := ERROR_NOT_READY;
end;
end
else
begin
Result := ERROR_INVALID_PARAMETER;
end;
end;
{----------------------------------------------------------}
// Example:
procedure
TForm1.Button1Click(Sender: TObject);
var
Data: PChar;
P: TPoint;
begin
if StreamOutRtf(RichEdit1.Handle, Data) =
ERROR_SUCCESS then
try
if StreamInRtf(RichEdit2.Handle, Data) =
ERROR_SUCCESS then
begin
MessageBox(0, 'RTF Stream copied/
RTF-Stream kopiert.', 'ok', MB_ICONINFORMATION);
end
else
begin
MessageBox(0, 'Error while Reading the
Target Source'+
'/Fehler beim Schreiben des Ziels!', nil, 0);
end;
finally
FreeMemory(Data);
end
else
begin
MessageBox(0, 'Error while writing to
Source'+
'/Fehler beim Einlesen der Quelle!', nil, 0);
end;
end;