richedit如何实现对全文的查找并改变找到的字符的颜色！！！

Question

弄了半天也没有弄出来，帮助上的例子也不好时，查不到字符。求助！

Answer 1

全文是什么的全文？是查找richedit里的文字？

Answer 2

用FindText，帮助写得很明确。

Answer 3

找到字符我是会的了，就是不知道怎么改变颜色啊，呵呵
var i:integer;
begin
 for i:=1 to richedit1.lines.count begin
    if pos('字符',richedit1.lines[i])>1 then begin
        showmessage('字符已经找到');
        inc(pos('字符',richeedit1.lines[i]));
        end
    else
         showmessage('没有找到您要的字符');
end;
end;
我搞了很久就是弄不出改变字符颜色这个东东 ，希望谁能来帮帮忙，谢过了

Answer 4

procedure TfrmMain.RepCodeFind(Sender: TObject);
Var
  intPos,intPAt:integer;
begin
  //intCurLine:=memoCode.Perform(EM_LINEFROMCHAR, -1, 0);  With memoCode do
  Begin
     intPAt:=SelStart+SelLength;
    intPos:=Position(RepCode.FindText,Copy(Text,SelStart+SelLength,Length(Text)),1);
    intPos:=intPAt+intPos;
    if intPos>0 then
    Begin
      SelStart:=intPos-2;
      SelLength:=Length(RepCode.FindText);
      //滚动 RichText 以显示找到的文字
      Perform(EM_SCROLLCARET, 0 , 0);
    End
    Else
    Begin
      Application.MessageBox(Pchar('搜索完毕！'),Pchar('搜索'),MB_OK+MB_ICONINFORMATION);
      SelStart:=0;
    End;
    //SetFocus;
  End;
end;Position 是自定义函数
function TfrmMain.Position(SubStr, SourceStr: string;
  intOccur: integer): integer;
var
  //intProvPos:integer;
  //intLastPos:integer;
  intSubLength:integer;
  intSourceLength:integer;
  intOccurNo:integer;
  intI:integer;
  strFind:String;
begin
  if intOccur<1 then
  begin
    MessageBox(0,Pchar('参数错误，参数intOccur应大于0'),Pchar('参数'),MB_OK+MB_ICONWARNING+MB_TASKMODAL);
    Result:=0;
    exit;
  end;
  intSubLength:=Length(SubStr);
  intSourceLength:=Length(SourceStr);
  intOccurNo:=0;
  for intI := 1 to intSourceLength  do
  Begin
    strFind:=Copy(SourceStr,intI,intSubLength);
    if strFind=SubStr then
    begin
      intOccurNO:=intOccurNO+1;
      if intOccurNO=intOccur then
      begin
        Position:=intI;
        exit;
      end;
    end;
  end;
  Position:=0;
End;

Answer 5

再来一个；var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  str:string;
with RichEdit do begin
    str：＝'查找的中文字串';
    FoundAt := FindText(str, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(str);
      SelAttributes.color:=clred;
    end;
end;

Answer 6

killer1(killer1) ：
按你的方法，如果每一行有两个要查找的字符能检测出来吗？
改变颜色用以下方法：
        SelStart :=选中的地方 
        SelLength :=长度
        SelAttributes.Color := clRed;//变色

Answer 7

这和支不支持中文没关系,只不过上面的程序可能是随手写的,错的一塌糊涂for i:=0 to richedit1.lines.count-1 begin//当然不是1到richedit1.lines.countpos('字符',RichEdit1.lines[i])>0//是0不是1inc(pos('字符',richeedit1.lines[i]));//这句本来就错,放这不知道什么意思

Answer 8

var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  sSr:string;
begin
with RichEdit1 do begin
    Str:='1';
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(str, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SelStart := FoundAt;
      SelLength := Length(str);
      SelAttributes.color:=clred;
    end;
end;上面的代码改为这样要明白如何实现文字的颜色,样式改变,还得知道个记录  TCharFormatA = record
    cbSize: UINT;
    dwMask: Longint;
    dwEffects: Longint;
    yHeight: Longint;
    yOffset: Longint;
    crTextColor: TColorRef;
    bCharSet: Byte;
    bPitchAndFamily: Byte;
    szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
  end;还有消息EM_SETCHARFORMAT试试下面的代码:var
  CF:TCharFormat;begin
  FillChar(CF, SizeOf(CF), 0);
  CF.cbSize := SizeOf(CF);
  CF.dwMask := CFM_LINK;
  CF.dwEffects := CFE_LINK;
  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT,SCF_ALL,Integer(addr(CF)));
end;改成
   CF.dwMask := CFM_COLOR;
   CF.crTextColor := clRed;还有其它的自己琢磨,呵呵
end;

Answer 9

ehom(？！：
老大，都要过年了，直接给个功能模块吧。
cg1120(代码最优化－§新年祝福你，好运伴着你§) 给的代码，在我这里运行错误，没有成功。

Answer 10

改变所在字符的颜色..可以加一个与背景色合成为红色的RMB值..
只要从一开始的那个字符起取长度为查找字符长度就OK..

Answer 11

自己解决了不是更有意思?var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  Str:string;
begin
with RichEdit1 do begin
    Str:='Test';
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    While FoundAt <> -1 do
    begin
      FoundAt := FindText(Str, StartPos, ToEnd, [stMatchCase]);
      if FoundAt <> -1 then
      begin
        SelStart := FoundAt;
        SelLength := Length(str);
        SelAttributes.color:=clred;
      end;
      StartPos := FoundAt+1;
      ToEnd := Length(Text) - StartPos;
    end;
end;
end;//没有我后面说的方法,这个比较好理解!