uses RichEdit;
function TextToRtf( // 将文本处理为RTF格式
mText: WideString // 输入文本
): WideString; // 返回处理后的RTF文本
var
I: Integer;
begin
Result := StringReplace(mText, #13#10, #10, [rfReplaceAll]);
for I := Length(mText) downto 1 do
begin
case mText[I] of
'\':
begin
Delete(Result, I, 1);
Insert('\\', Result, I);
end;
'{':
begin
Delete(Result, I, 1);
Insert('\{', Result, I);
end;
'}':
begin
Delete(Result, I, 1);
Insert('\}', Result, I);
end;
else
if mText[I] > #127 then
begin
Delete(Result, I, 1);
if mText[I] <= #255 then
Insert('\''' + LowerCase(IntToHex(Ord(mText[I]), 2)), 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'#13#10 +
'{\colortbl ;\red%d\green%d\blue%d;\red%d\green%d\blue%d;}'#13#10 +
'\cf1\highlight2 %s%s'#13#10 +
'}'#13#10;
begin
Result := False;
if mText = '' then Exit;
if not Assigned(mRichEdit) then Exit;
mForegroundColor := ColorToRGB(mForegroundColor);
mBackgroundColor := ColorToRGB(mBackgroundColor);
SendMessage(mRichEdit.Handle, EM_REPLACESEL, 0,
Longint(PChar(Format(cRtfFormat, [
GetRValue(mForegroundColor),
GetGValue(mForegroundColor),
GetBValue(mForegroundColor),
GetRValue(mBackgroundColor),
GetGValue(mBackgroundColor),
GetBValue(mBackgroundColor),
TextToRtf(mText),
Copy('\par', 1, Ord(mAppendReturn) * 4)
]))));
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 := 0;
InsertColorRtf(Format('%s底%s字', [
ColorToString(vBackgroundColor), ColorToString(vForegroundColor)]),
RichEdit1, vForegroundColor, vBackgroundColor, True);
end;
