How to find and select every occurences of specific word in Memo?

Question

I am making application which replaces different words of two very similar speaking languages. Number of words by time will probably reach at least 10.000+. There is no big differences in words, it is almost same languages, but however differences exists.

So, I managed to replace words in Memo fast enough, but what I dont know is how to select all replaced words in Memo so it can be seen which words are replaced. Is this possible?

This is how words are replaced:

procedure TForm1.TranslateExecute(Sender: TObject);
var i: integer;
    S, OldPattern, NewPattern: string;
begin
  S:= Memo1.Lines.Text;

  for i := 0 to (StrListV.Count - 1) do  {StrListV is created earlier, contains words that should be replaced}
  begin        
    OldPattern:= StrListV.Strings[i];
    NewPattern:= StrListV1.Strings[i]; {StrListV1 contains new words}
    S:= FastStringReplace(S, OldPattern, NewPattern,[rfReplaceAll]);
  end;

  Memo1.BeginUpdate;
  Memo1.Clear;
  Memo1.Lines.Text:= S;
  Memo1.EndUpdate;
end;

Edit controls can have only one selection. I guess you are looking for a way to highlight the text, not select. If so, you can use rich edit control for that. — TLama, May 19 '15 at 12:04
For instance common rich edit control (`TRichEdit`) can do that, but you will need to locate where each word to be highlighted is in the control's content to highlight it (naturally, a simple content string replace is not enough for your overall task). — TLama, May 19 '15 at 12:30

score 3 · Accepted Answer · edited May 20 '15 at 16:59

Neither TMemo or TRichEdit support multiple selections, so you cannot actually highlight the words that have been replaced. But with TRichEdit, what you CAN do is change the foreground/background colors of the words you replace.

TRichEdit has a FindText() method (which wraps the EM_FINDTEXT message) that returns the index of a search string. Call it in a loop, and or each found word you can select it, set its coloring, and replace it with the new text. Repeat until FindText() does not find any more matches.

Try something like this:

uses
  RichEdit, CommDlg;

procedure TForm1.TranslateExecute(Sender: TObject);
var
  I, Pos: Integer;
  EventMask: LRESULT;
  OldPattern, NewPattern: string;
  Find: RichEdit.FINDTEXT;
  Rng: RichEdit.CHARRANGE;
  Fmt: RichEdit.CHARFORMAT2;
begin
  EventMask := SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, 0);
  RichEdit1.Lines.BeginUpdate;
  try
    for I := 0 to StrListV.Count - 1 do
    begin        
      OldPattern := StrListV.Strings[I];
      NewPattern := StrListV1.Strings[I];
      Pos := 0;
      repeat
        Find.chrg.cpMin := Pos;
        Find.chrg.cpMax := -1;
        Find.lpstrText := PChar(OldPattern);
        Pos := SendMessage(RichEdit1.Handle, EM_FINDTEXT, FR_DOWN or FR_WHOLEWORD, LPARAM(@Find));
        if Pos = -1 then Break;

        Rng.cpMin := Pos;
        Rng.cpMax := Pos + Length(OldPattern);

        ZeroMemory(@Fmt, SizeOf(Fmt));
        Fmt.cbSize := SizeOf(Fmt);
        Fmt.dwMask := CFM_COLOR or CFM_BACKCOLOR;
        Fmt.crTextColor := ColorToRGB(clHighlightText);
        Fmt.crBackColor := ColorToRGB(clHighlight);

        SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, LPARAM(@Rng));
        SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
        SendMessage(RichEdit1.Handle, EM_REPLACESEL, 0, LPARAM(PChar(NewPattern)));

        Inc(Pos, Length(NewPattern));
      until False;
    end;
  finally
    RichEdit1.Lines.EndUpdate;
    SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, EventMask);
  end;
end;

How to find and select every occurences of specific word in Memo?

1 Answers1