uses
RichEdit
redt1里面有一些文本.
RichEdit MaxLenght 属性设置为 2147483645 可以存储2G大小的文件
通过代码实现将redt1的内容原封不动的复制到redt2中.
用CopyToClipboard和PasteFromClipboard只能粘贴一次.
比如:
for i:=0 to 10 do
begin
redt1.selectAll;
redt1.CopyToClipboard;
redt2.PasteFromClipBoard;
end;
实际只粘贴了一次.
从网上找到一个方法:
function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; 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): Longint; 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
sourceStream.Position := 0;
With editstream Do Begin
dwCookie:= Longint(sourceStream);
dwError:= 0;
pfnCallback:= EditStreamInCallBack;
end;
aRichedit.Perform( EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
End;
调用:
var
aMemStream:TMemoryStream;
I:Integer;
begin
redt1.SelectAll;
aMemStream := TMemoryStream.Create;
try
getRTFSelection (redt1, aMemStream);
for I:=0 to 10 do
putRTFSelection (redt2, aMemStream);
finally
aMemStream.Free;
end;
end;