mark all the instances of a word (Delphi, RichText)

Question

OK, this is a problem that's been nagging and I can't see to find a definitive answer. How do you find and mark all instances of a word?

What I mean is, I search for a word (say: Person). If the word exists the I mark (using red or whatever color) all instances of that word in the richedit. If I press Esc then it gets deselected.

Any ideas?

code is appreciated.

Answer 1

wonderer, I wrote this code, I hope it will be useful :

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

Bye.

Answer 2

The following code will search all occurrences of the given word (case sensitive) in the rich edit control, change the font colour to red, and finally restore the original selection of the control (all with as little flicker as possible I hope):

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;

Now you only need to save the matches together with the original text attributes to a list, and use the information in this list to revert all the changes on the press of Esc. This can however get quite tricky to do correctly, if you assume that the matches may contain different font styles, colours and such. I have therefore not provided any code to save the formatting, it depends on your requirements.

Oh, make sure that the highlighted matches are removed before the text can be changed again, otherwise you will not correctly restore the original text formatting.