大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

RichEdit中插入带背景色文本的一种思路

Posted on 2013-10-09 17:39  大悟还俗_2  阅读(874)  评论(0编辑  收藏  举报
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;
View Code