Author: Jonas Bilinkevicius
How to append formatted text to an existing formatted text in a TRichEdit component
Answer:
Project needs 3 TButtons, 1 TMemo, 1 TRichEdit, 1 TColorDialog, 1 TFontDialog, Uses
RichEdit.
1
2 type
3 TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint;
4 var pcb: Longint): DWORD; stdcall;
5 TEditStream = record
6 dwCookie: Longint;
7 dwError: Longint;
8 pfnCallback: TEditStreamCallBack;
9 end;
10
11 function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint;
12 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: Longint;
38 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 TForm1.Button2Click(Sender: TObject);
78 var
79 aMemStream: TMemoryStream;
80 begin
81 aMemStream := TMemoryStream.Create;
82 try
83 GetRTFSelection(richedit1, aMemStream);
84 aMemStream.Position := 0;
85 memo1.Lines.LoadFromStream(aMemStream);
86 finally
87 aMemStream.Free;
88 end;
89 end;
90
91 procedure TForm1.Button3Click(Sender: TObject);
92 var
93 aMemStream: TMemoryStream;
94 begin
95 aMemStream := TMemoryStream.Create;
96 try
97 memo1.Lines.SaveToStream(aMemStream);
98 aMemStream.Position := 0;
99 PutRTFSelection(richedit1, aMemStream);
100 finally
101 aMemStream.Free;
102 end;
103 end;
104
105 procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word; Shift:
106 TShiftState);
107 begin
108 if [ssCtrl] = Shift then
109 case Key of
110 Ord('B'): with (Sender as TRichEdit).SelAttributes do
111 if fsBold in Style then
112 Style := Style - [fsBold]
113 else
114 Style := Style + [fsBold];
115 Ord('U'): with (Sender as TRichEdit).SelAttributes do
116 if fsUnderline in Style then
117 Style := Style - [fsUnderline]
118 else
119 Style := Style + [fsUnderline];
120 Ord('I'): with (Sender as TRichEdit).SelAttributes do
121 if fsItalic in Style then
122 Style := Style - [fsItalic]
123 else
124 Style := Style + [fsItalic];
125 Ord('T'): if ColorDialog1.Execute then
126 (Sender as TRichEdit).SelAttributes.Color := ColorDialog1.Color;
127 Ord('F'): if FontDialog1.Execute then
128 (Sender as TRichEdit).SelAttributes.Assign(FontDialog1.Font);
129 end;
130 end;
131
132 procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
133 begin
134 {Ctrl-I yields a #9 character, a Tab. We have to swallow that.}
135 if (Key = #9) and (GetKeyState(VK_CONTROL) < 0) then
136 Key := #0;
137 end;
You now have a simple rich text editor and can type some formatted text into the rich edit. Select some of it and click button2. The selection is fetched and copied as RTF text into the memo. Put the caret somewhere in the rich edit and click button3. The RTF text from the memo is inserted at the selection into the rich edit. To combine several snippets of RTF text into one block one would have to remove the trailing } from block 1, the leading {\rtf1 from block 2 and copy both together into a new block. You can test that with a little cut and paste on the memo before you hit button3.
|
