uses RichEdit;
function TextToRtf( // 将文本处理为RTF格式
mText: WideString // 输入文本
): WideString; // 返回处理后的RTF文本
var
I: Integer;
begin
Result := StringReplace(mText, ##, #, [rfReplaceAll]);
for I := Length(mText) downto do
begin
case mText[I] of
'\':
begin
Delete(Result, I, );
Insert('\\', Result, I);
end;
'{':
begin
Delete(Result, I, );
Insert('\{', Result, I);
end;
'}':
begin
Delete(Result, I, );
Insert('\}', Result, I);
end;
else
if mText[I] > # then
begin
Delete(Result, I, );
if mText[I] <= # then
Insert('\''' + LowerCase(IntToHex(Ord(mText[I]), )), Result, I)
else Insert('\u' + IntToStr(Ord(mText[I])) + '?', Result, I);
end;
end;
end;
end;
function InsertColorRtf( // 插入带颜色的RTF文本
mText: string; // 原文本
mRichEdit: TRichEdit; // Rich编辑框
mForegroundColor: TColor; // 前景颜色
mBackgroundColor: TColor; // 背景颜色
mAppendReturn: Boolean = False // 是否追加换行
): Boolean; // 返回插入是否成功
const
cRtfFormat =
'{\rtf1'## +
'{\colortbl ;\red%d\green%d\blue%d;\red%d\green%d\blue%d;}'## +
'\cf1\highlight2 %s%s'## +
'}'##;
begin
Result := False;
if mText = '' then Exit;
if not Assigned(mRichEdit) then Exit;
mForegroundColor := ColorToRGB(mForegroundColor);
mBackgroundColor := ColorToRGB(mBackgroundColor);
SendMessage(mRichEdit.Handle, EM_REPLACESEL, ,
Longint(PChar(Format(cRtfFormat, [
GetRValue(mForegroundColor),
GetGValue(mForegroundColor),
GetBValue(mForegroundColor),
GetRValue(mBackgroundColor),
GetGValue(mBackgroundColor),
GetBValue(mBackgroundColor),
TextToRtf(mText),
Copy('\par', , Ord(mAppendReturn) * )
]))));
Result := True;
end; { InsertColorRtf }
procedure TForm1.Button1Click(Sender: TObject);
var
vForegroundColor: TColor;
vBackgroundColor: TColor;
begin
vForegroundColor := Random($FFFFFF);
vBackgroundColor := Random($FFFFFF);
RichEdit1.SelStart := MaxInt;
RichEdit1.SelLength := ;
InsertColorRtf(Format('%s底%s字', [
ColorToString(vBackgroundColor), ColorToString(vForegroundColor)]),
RichEdit1, vForegroundColor, vBackgroundColor, True);
end;
参考：http://www.cnblogs.com/key-ok/p/3359681.html