type
TBufferClass =
class(TObject)
Buffer: AnsiString;
Position: Integer;
end;
function StringSave(dwCookie: LongInt; pbBuff: PByte;
cb: LongInt;
var pcb: LongInt): LongInt;
stdcall;
var
S: PString;
begin
Result := NoError;
S := PAnsiString(dwCookie);
try
S^ := S^ + PChar(pbBuff);
pcb := cb;
except
Result := $0002;
// WriteError
end;
end;
function StringLoad(dwCookie: LongInt; pbBuff: PByte;
cb: LongInt;
var pcb: LongInt): LongInt;
stdcall;
var
BC: TBufferClass;
S: PAnsiString;
begin
Result := NoError;
BC := TBufferClass(dwCookie);
try
pcb := 0;
try
pcb := cb;
if pcb > Length(BC.Buffer) - BC.Position
then
pcb := Length(BC.Buffer) - BC.Position;
if pcb > 0
then
begin
S := PAnsiString(BC.Buffer);
Inc(S, BC.Position);
Move(S^, pbBuff^, pcb);
BC.Position := BC.Position + pcb;
end;
except
Result := $0003;
// ReadError
end;
finally
end;
end;
procedure LoadRichEditFromString(
Handle: THandle; S: AnsiString);
var
EditStream: TEditStream;
BC: TBufferClass;
begin
BC :=
nil;
try
BC := TBufferClass.Create;
BC.Buffer := S;
BC.Position := 0;
with EditStream
do
begin
dwCookie := Integer(BC);
pfnCallBack := @StringLoad;
dwError := 0;
end;
SendMessage(
Handle, EM_STREAMIN, SF_RTF, Longint(@EditStream));
finally
BC.Free;
end;
end;
function SaveRichEditToString(
Handle: THandle): AnsiString;
var
EditStream: TEditStream;
S: AnsiString;
begin
try
with EditStream
do
begin
dwCookie := Integer(@S);
pfnCallBack := @StringSave;
dwError := 0;
end;
SendMessage(
Handle, EM_STREAMOUT, SF_RTF, Longint(@EditStream));
finally
Result := S;
end;
end;