Author: Jonas Bilinkevicius
I need to ensure that when my TRichEdit copies text to the clipboard, it is copied
in a certain font, colour and size. My problem is that my TRichEdit is defaulted to
one font and the users are not given the ability to change it. But I want it to
pasted into Word (for example) in another font.
Answer:
You can of course compose a rich text file in code and copy that into the clipboard
using the standard rich edit clipboard format, but it's a lot of work. A somewhat
simpler approach may be to take the rich text as it is in the control (stream to a
TMemoryStream, load into a String) and then modify the \fonttbl tag in the file.
1
2 procedure TForm1.Button3Click(Sender: TObject);
3 var
4 S: string;
5 ss: TStringstream;
6 ms: TMemoryStream;
7 begin
8 ms := TMemoryStream.Create;
9 try
10 richedit1.Lines.SaveToStream(ms);
11 SetString(S, Pchar(ms.Memory), ms.size);
12 finally
13 ms.free
14 end;
15 memo1.text := S; {view raw rtf in TMemo to see font table}
16 S := Stringreplace(S, 'Times New Roman', 'Verdana', []);
17 ss := TStringstream.Create(S);
18 try
19 richedit1.Lines.LoadFromStream(ss);
20 finally
21 ss.free
22 end;
23 end;
24
25 //To get the new text into the clipboard proceed as below:
26
27 uses
28 Richedit, Clipbrd;
29
30 {$R *.dfm}
31
32 procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);
33 var
34 hMem: THandle;
35 pMem: Pointer;
36 begin
37 {Rewind stream position to start}
38 S.Position := 0;
39 {Allocate a global memory block the size of the stream data}
40 hMem := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);
41 if hMem <> 0 then
42 begin
43 {Succeeded, lock the memory handle to get a pointer to the memory}
44 pMem := GlobalLock(hMem);
45 if pMem <> nil then
46 begin
47 {Succeeded, now read the stream contents into the memory the pointer points
48 at}
49 try
50 S.read(pMem^, S.Size);
51 {Rewind stream again, caller may be confused if the stream position is
52 left at the end}
53 S.Position := 0;
54 finally
55 {Unlock the memory block}
56 GlobalUnlock(hMem);
57 end;
58 {Open clipboard and put the block into it. The way the Delphi clipboard
59 object is written this will clear the clipboard first.
60 Make sure the clipboard is closed even in case of an exception. If left open
61 it would become unusable for other apps.}
62 Clipboard.Open;
63 try
64 Clipboard.SetAsHandle(fmt, hMem);
65 finally
66 Clipboard.Close;
67 end;
68 end
69 else
70 begin
71 {Could not lock the memory block, so free it again and raise an out of
72 memory exception}
73 GlobalFree(hMem);
74 OutOfMemoryError;
75 end;
76 end
77 else
78 {Failed to allocate the memory block, raise exception}
79 OutOfMemoryError;
80 end;
81
82 var
83 CF_RTF: Word = 0; {set in Initialization section}
84
85 procedure TForm1.Button3Click(Sender: TObject);
86 var
87 S: string;
88 ss: TStringstream;
89 ms: TMemoryStream;
90 begin
91 ms := TMemoryStream.Create;
92 try
93 richedit1.Lines.SaveToStream(ms);
94 SetString(S, Pchar(ms.Memory), ms.size);
95 finally
96 ms.free
97 end;
98 S := Stringreplace(S, 'Times New Roman', 'Verdana', []);
99 ss := TStringstream.Create(S);
100 try
101 // richedit1.Lines.LoadFromStream(ss);
102 CopyStreamToClipboard(CF_RTF, ss);
103 finally
104 ss.free
105 end;
106 end;
107
108 initialization
109 CF_RTF := RegisterClipboardFormat(Richedit.CF_RTF);
110 end.
|
