标记单词的所有实例（Delphi、RichText）

Question

好吧，这是一个一直困扰我的问题，我找不到明确的答案。 如何查找并标记某个单词的所有实例？

我的意思是，我搜索一个词（例如：人）。如果该单词存在，则 I 标记（使用红色或任何颜色）该单词在 richedit 中的所有实例。如果我按 Esc 键，它就会被取消选择。

有什么想法吗？

代码表示赞赏。

Answer 1

好奇者，我写了这段代码，我希望它有用：

Procedure MarkString(RichEdit:TRichEdit;strtomark : string);
Var
FoundAt : integer;
begin
    FoundAt:=RichEdit.FindText(strtomark,0,maxInt,[stWholeWord]);
    while FoundAt <> -1 do
    begin
             RichEdit.SelStart := FoundAt;
             RichEdit.SelLength := Length(strtomark);
             RichEdit.SelAttributes.Style := [fsBold];
             RichEdit.SelAttributes.Color := clRed;
             RichEdit.SelText :=strtomark;
             FoundAt:=RichEdit.FindText(strtomark,FoundAt + length(strtomark),maxInt,[stWholeWord]);
    end;
end;


Procedure UnMarkString(RichEdit:TRichEdit;strtomark : string);
Var
FoundAt : integer;
begin
    FoundAt:=RichEdit.FindText(strtomark,0,maxInt,[stWholeWord]);
    while FoundAt <> -1 do
    begin
             RichEdit.SelStart := FoundAt;
             RichEdit.SelLength := Length(strtomark);
             RichEdit.SelAttributes.Style := [];
             RichEdit.SelAttributes.Color := clBlack;
             RichEdit.SelText :=strtomark;
             FoundAt:=RichEdit.FindText(strtomark,FoundAt + length(strtomark),maxInt,[stWholeWord]);
    end;
end;


MarkString(RichEdit1,'delphi'); //To Mark a string

UnMarkString(RichEdit1,'delphi'); //To UnMark a string

再见。

Answer 2

以下代码将搜索 Rich Edit 控件中所有出现的给定单词（区分大小写），将字体颜色更改为红色，最后恢复控件的原始选择（我希望所有闪烁都尽可能少）：

procedure TForm1.FindWord(const AWord: string; AOptions: TSearchTypes);
var
  OrigSelStart, OrigSelLen: integer;
  Start, Found: integer;
begin
  if AWord = '' then
    exit;

  OrigSelStart := RichEdit1.SelStart;
  OrigSelLen := RichEdit1.SelLength;

  RichEdit1.Perform(WM_SETREDRAW, 0, 0);
  try
    Start := 0;
    Found := RichEdit1.FindText(AWord, Start, MaxInt, AOptions);
    while Found <> -1 do begin
      RichEdit1.SelStart := Found;
      RichEdit1.SelLength := Length(AWord);
      // TODO: save start of search match and original font colour
      RichEdit1.SelAttributes.Color := clRed;
      Start := Found + Length(AWord);
      Found := RichEdit1.FindText(AWord, Start, MaxInt, AOptions);
    end;
  finally
    RichEdit1.SelStart := OrigSelStart;
    RichEdit1.SelLength := OrigSelLen;
    RichEdit1.Perform(WM_SETREDRAW, 1, 0);
    RichEdit1.Repaint;
  end;
end;

现在您只需将匹配项与原始文本属性一起保存到一个列表中，并使用该列表中的信息在按 Esc 时恢复所有更改。然而，如果您假设匹配项可能包含不同的字体样式、颜色等，那么正确执行此操作可能会非常棘手。因此，我没有提供任何代码来保存格式，这取决于您的要求。

哦，请确保在再次更改文本之前删除突出显示的匹配项，否则您将无法正确恢复原始文本格式。