Mega Code Archive
How to copy formated Rtf Text from one TRichedit to an other
<![CDATA[
Title: How to copy formated Rtf-Text from one TRichedit to an other
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 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;
]]>