2008. április 25., péntek
How to copy one TRichEdit to another
Problem/Question/Abstract:
How to copy one TRichEdit to another
Answer:
type
TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): DWORD; stdcall;
TEditStream = record
dwCookie: Longint;
dwError: Longint;
pfnCallback: TEditStreamCallBack;
end;
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; {assume everything is ok}
if dataAvail <= cb then
begin
pcb := Read(pbBuff^, dataAvail);
if pcb <> dataAvail then {couldn't read req. amount of bytes}
result := E_FAIL;
end
else
begin
pcb := Read(pbBuff^, cb);
if pcb <> cb then
result := E_FAIL;
end;
end;
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: TRichEdit; 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: TRichEdit; 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: TRichEdit; 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: TRichEdit);
var
aMemStream: TMemoryStream;
begin
aMemStream := TMemoryStream.Create;
try
GetRTFSelection(aSource, aMemStream);
aMemStream.Position := 0;
PutRTFSelection(aDest, aMemStream);
finally
aMemStream.Free;
end;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése