Wort gefunden und markiert!

[arc]

Lieber spät als nie, ich habe besagte Funktion auch entdeckt und festgestellt, daß das was da passiert sehr seltsam ist.

Typische Version im Netz:

Delphi-Quellcode:

function SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string): Boolean;
var
  StartPos, Position, Endpos: Integer;
begin
  StartPos := 0;
  with RichEdit do
  begin
    Endpos := Length(RichEdit.Text);
    Lines.BeginUpdate;
    while FindText(SearchText, StartPos, Endpos, [stMatchCase])<>-1 do
    begin
      Endpos   := Length(RichEdit.Text) - startpos;
      Position := FindText(SearchText, StartPos, Endpos, [stMatchCase]);
      Inc(StartPos, Length(SearchText));
      SetFocus;
      SelStart  := Position;
      SelLength := Length(SearchText);
    end;
    Lines.EndUpdate;
  end;
end;

Da ist einiges daneben.
- FindText wird stets doppelt ausgeführt
- Endpos ist keine absolute Position sondern eine relative Textlänge!
- die Funktion gibts nichts zurück
- Inc(StartPos, Length(SearchText)); ist selten dämlich, da FindText die Position des gefundenen Strings zurückliefert, ab da einfach weitersuchen

Das Resultat: Der Code funktioniert zwar, braucht aber EWIG. Meine Variante:

Delphi-Quellcode:

procedure RE_SearchForText_AndSelect(RichEdit: TRichEdit; SearchText: string);
var StartPos, Position, RemainingLength, WordCount, TextSize, SearchSize: Integer;
begin
  if SearchText = '' then Exit;
  
  with RichEdit do
  begin
    Lines.BeginUpdate;

    // reset colors...
    SelStart:=0;
    SelLength:=Length(RichEdit.Text) - 1;
    SelAttributes.Color:=$000000;

    WordCount:=0;
    StartPos:=0;
    TextSize:=Length(RichEdit.Text);
    SearchSize:=Length(SearchText);
    RemainingLength:=TextSize;
    Position:=FindText(SearchText, StartPos, RemainingLength, []);

    if Position <> -1 then
    repeat
      // selects the word and changes color
      SelStart:=Position;
      SelLength:=SearchSize;
      SelAttributes.Color:=$0000FF;
      inc(WordCount);

      // changes startpos to after the current word
      StartPos:=Position + SearchSize;
      // Remaining Text to search for
      RemainingLength:=TextSize - StartPos;
      // find again...
      Position:=FindText(SearchText, StartPos, RemainingLength, []);
    until Position = -1;

    SelLength:=0; // reset selection...
    Lines.EndUpdate;
  end;
  ShowMessage(SearchText + ' found ' + IntToStr(WordCount) + ' times.');
end;

Diese Prozedur ändert die Farbe aller gefundenen Wörter rot und zählt die Anzahl der Fundstellen mit. Ich habe versucht soweit es geht auf Laufzeit zu optimieren. stMatchCase brauche ich nicht. Die Funktion ist bereits recht speziell, aber läßt sich mit wenigen Handgriffen wieder verallgemeinern.

Aufruf z.B. so

Delphi-Quellcode:

  RE_SearchForText_AndSelect(
    RichEdit1,
    InputBox('Find', 'Find What:', '')
  );

Hauptunterschied ist StartPos:=Position + Length(SearchText); statt Inc(StartPos, Length(SearchText)); der Rest ist Geschmacksache. Ich hoffe es hilft dem einen oder anderen.

Viel Spaß!