Search code examples
delphitextreplacetmemo

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


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;

Solution

  • 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;