Author: Jonas Bilinkevicius

How to copy one TRichEdit to another

Answer:

1   type
2     TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte;
3       cb: Longint; var pcb: Longint): DWORD; stdcall;
4   
5     TEditStream = record
6       dwCookie: Longint;
7       dwError: Longint;
8       pfnCallback: TEditStreamCallBack;
9     end;
10  
11  function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
12    cb: Longint; var pcb: Longint): DWORD; stdcall;
13  var
14    theStream: TStream;
15    dataAvail: LongInt;
16  begin
17    theStream := TStream(dwCookie);
18    with theStream do
19    begin
20      dataAvail := Size - Position;
21      Result := 0; {assume everything is ok}
22      if dataAvail <= cb then
23      begin
24        pcb := read(pbBuff^, dataAvail);
25        if pcb <> dataAvail then {couldn't read req. amount of bytes}
26          result := E_FAIL;
27      end
28      else
29      begin
30        pcb := read(pbBuff^, cb);
31        if pcb <> cb then
32          result := E_FAIL;
33      end;
34    end;
35  end;
36  
37  function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb:
38    Longint; var pcb: Longint): DWORD; stdcall;
39  var
40    theStream: TStream;
41  begin
42    theStream := TStream(dwCookie);
43    with theStream do
44    begin
45      if cb > 0 then
46        pcb := write(pbBuff^, cb);
47      Result := 0;
48    end;
49  end;
50  
51  procedure GetRTFSelection(aRichEdit: TRichEdit; intoStream: TStream);
52  var
53    editstream: TEditStream;
54  begin
55    with editstream do
56    begin
57      dwCookie := Longint(intoStream);
58      dwError := 0;
59      pfnCallback := EditStreamOutCallBack;
60    end;
61    aRichedit.Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream));
62  end;
63  
64  procedure PutRTFSelection(aRichEdit: TRichEdit; sourceStream: TStream);
65  var
66    editstream: TEditStream;
67  begin
68    with editstream do
69    begin
70      dwCookie := Longint(sourceStream);
71      dwError := 0;
72      pfnCallback := EditStreamInCallBack;
73    end;
74    aRichedit.Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));
75  end;
76  
77  procedure InsertRTF(aRichEdit: TRichEdit; s: string);
78  var
79    aMemStream: TMemoryStream;
80  begin
81    if Length(s) > 0 then
82    begin
83      aMemStream := TMemoryStream.Create;
84      try
85        aMemStream.write(s[1], length(s));
86        aMemStream.Position := 0;
87        PutRTFSelection(aRichEdit, aMemStream);
88      finally
89        aMemStream.Free;
90      end;
91    end;
92  end;
93  
94  procedure CopyRTF(aSource, aDest: TRichEdit);
95  var
96    aMemStream: TMemoryStream;
97  begin
98    aMemStream := TMemoryStream.Create;
99    try
100     GetRTFSelection(aSource, aMemStream);
101     aMemStream.Position := 0;
102     PutRTFSelection(aDest, aMemStream);
103   finally
104     aMemStream.Free;
105   end;
106 end;