Nur ganze Wörter finden

[Luckie]

Ich habe hier eine Funktion die einen SubString in einem String sucht und den Index des ersten Zeichens zurückgibt:

Delphi-Quellcode:

function Find(StartPos: Integer; const Text, Word: string; WholeWordsOnly:
  Boolean = False): Integer;
var
  Index: Integer;
begin
  if WholeWordsOnly then
  begin
    Index := (PosEx(AnsiUppercase(Word), AnsiUpperCase(Text), StartPos)) - 1;
    if Text[Index + length(Word) + 1] in WordDelimiter then
      result := Index
    else
      result := -1;
  end
  else
    result := (PosEx(AnsiUppercase(Word), AnsiUpperCase(Text), StartPos)) - 1;
end;

Nun wollte ich sie so erweitern, dass man optional nur nach ganzen Wörten suchen kann. Leider ist da irgendwo noch ein Bug drinne. Er bricht einfach mitten drinne ab und findet keine Wörter mehr, obwohl noch ganze Wörter zu finden wären.

Einsetzten wollte ich das hier:

Delphi-Quellcode:

function HighlightWords(RichEdit: TRichEdit; Words: TStrings; FontStyle:
  TFontStyles;
  Color: TColor): Cardinal;
var
  i: Integer;
  LastWordPos: Integer;
  HighLightedWords: Cardinal;
begin
  LastWordPos := 0;
  HighLightedWords := 0;
  RichEdit.Lines.BeginUpdate;
  for i := 0 to Words.Count - 1 do
  begin
    while LastWordPos <> 1 do
    begin
      LastWordPos := Find(LastWordPos, RichEdit.Text, Words[i]);
      writeln(Words[i] + ': ' + IntToStr(LastWordPos));
      RichEdit.SelStart := LastWordPos;
      RichEdit.SelLength := length(Words[i]);
      RichEdit.SelAttributes.Color := Color;
      RichEdit.SelAttributes.Style := FontStyle;
      LastWordPos := LastWordPos + 2;
      Inc(HighLightedWords);
    end;
    LastWordPos := 0;
  end;
  RichEdit.SelStart := 0;
  RichEdit.Lines.EndUpdate;
  result := HighLightedWords;
end;

Jetzt weiß ich nicht, ob der Fehler in Find oder HighLightWord liegt. Wenn sich da bitte jemand erbarmen könnte und auch mal einen Blick draufwerfen könnte. Ich beschäftige mich schon mehrere Tage damit und sehe den Wald vor lauter Bäumen schon nicht mehr. :roll:

[Union]

Ich habe Deinen Source übernommen und er funktioniert. Nur das Writeln habe ich deaktiviert. Poste doch mal den Inhalt des Textes und den der Stringlist (Words).

[Luckie]

Probier es mal mit dem Text im Anhang. Bei mir markiert er 26 Wörter. Das letzet "and" findet er im 8. Vers und bei den "rhe"s findet er nur das im Titel. Ach so, in der Liste habe ich zum Testen "and" und "the".

Delphi-Quellcode:

procedure TForm1.Button3Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Add('and');
    sl.Add('the');
    ShowMessage(IntToStr(HighlightWords(RichEdit1, sl, [fsBold, fsUnderline],
      clRed)) + ' Wörter markiert');
  finally
    FreeAndNil(sl);
  end;
end;

[Union]

Zitat:

Zitat von Luckie

Probier es mal mit dem Text im Anhang. Bei mir markiert er 26 Wörter. Das letzet "and" findet er im 8. Vers und bei den "rhe"s findet er nur das im Titel. Ach so, in der Liste habe ich zum Testen "and" und "the".

Exakt gleich. Ich dachte das finden wir vielleicht im chat schneller, aber der geht bei mir nicht -> Fehler auf Seite.

[edit]
Zwischenergebnis: Debugger beim 26. Wort angehalten und siehe da: der Text ist abgeschnitten. Es hört auf mit schrecklichen Effekten, s. Screenshot vom Debugger.

[Luckie]

Was heißt exakt gleich? Findet er alle bei dir oder wie?

[Union]

Zitat:

Zitat von Luckie

Was heißt exakt gleich? Findet er alle bei dir oder wie?

Nein, siehe mein edit des letzten Postings.

[Luckie]

Ja beim 26. bricht er bei mir auch ab. Das was der Debugger anzeigt, ist nicht weiterer tragisch. Es ist ein Text im RTF Format, der Debugger zeigt eben die Steierzeichen mit an, da er nir PlainText kann.

Komisch. Ich werde das moregn noch mal mit einem anderen Text probieren. Aber warum macht er es bei diesem Text nicht? :gruebel: :evil:

[Union]

Zitat:

Zitat von Luckie

Ja beim 26. bricht er bei mir auch ab. Das was der Debugger anzeigt, ist nicht weiterer tragisch. Es ist ein Text im RTF Format, der Debugger zeigt eben die Steierzeichen mit an, da er nir PlainText kann.

Komisch. Ich werde das moregn noch mal mit einem anderen Text probieren. Aber warum macht er es bei diesem Text nicht? :gruebel: :evil:

Wegen der Steuerzeichen. Vergiss erst mal Deine Funktion für ne Weile, denn so gehts (97 Wörter Markiert):

Delphi-Quellcode:

 LastWordPos := RichEdit.FindText(Words[i],LastWordPos,Length(Richedit.Text) - LastWordPos, [stWholeWord]);

In der Hilfe steht extra, daß man nicht so vorgehen soll wie Dein Ansatz, wegen der Steuerzeichen.

[Dani]

Edit: Kommando zurück, wenn man so nach ganzen Wörtern sucht klappts nicht... :oops:

[S2B]

Die Funktion ist in der Unit StrUtils! :wink:

[Luckie]

Mit FindText gehte s prima.

Was ist in der Unit StrUtils?

[S2B]

Da findet man die Funktion PosEx! Das stand in einem Beitrag hier, der wurde aber editiert...

[Luckie]

So, hier mal die ganze Klasse:

Delphi-Quellcode:

{************************************************************}
{                                                            }
{             RichEditHelperCls Unit - Version 1.1           }
{                                                            }
{               Copyright (c) 2004 Michael Puff              }
{                                                            }
{  When I die I want 'Hello, world' carved on my headstone.  }
{                                                            }
{************************************************************}

unit RichEditHelperCls;

interface

uses
  ComCtrls, Classes, Graphics;

type
  TWordDelimiter = set of Char;

var
  WordDelimiter: TWordDelimiter = [#1..#64, #91..#96, #123..#127];

type
  TRichEditHelper = class(TObject)
  private
    FRichEdit: TRichEdit;
    function GetWords: Integer;
  public
    constructor Create(RichEdit: TRichEdit);
    property CountWords: Integer read GetWords;
    function Find(StartPos: Integer; const SubStr: string; WholeWord: Boolean):
      Integer;
    function HighLightWords(Words: TStrings; FontStyle: TFontStyles; Color:
      TColor): Cardinal;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////
//
//  TRichEditHelper.Create
//
//    Author : Michael Puff
//    Date   : 2004-08-09
//    Purpose: Constructor
//

constructor TRichEditHelper.Create(RichEdit: TRichEdit);
begin
  inherited Create;
  FRichEdit := RichEdit;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TRichEditHelper.CountWords
//
//    Author : Michael Puff
//    Date   : 2004-08-08
//    Purpose: Ermittelt die Anzahl der Wörter im RichEdit
//

function TRichEditHelper.GetWords: Integer;
var
  p: PChar;
  CntWords: Cardinal;
begin
  CntWords := 0;
  p := PChar(FRichEdit.Text);
  while p^ <> #0 do
  begin
    if p^ in WordDelimiter then
      Inc(p)
    else
    begin
      while not (p^ in WordDelimiter) do
        Inc(p);
      Inc(CntWords);
    end;
  end;
  result := CntWords;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TRichEditHelper.Find
//
//    Author : Michael Puff
//    Date   : 2004-08-08
//    Purpose: Findet eine Zeichenfolge im Text des RichEdit
//

function TRichEditHelper.Find(StartPos: Integer; const SubStr: string;
  WholeWord:
  Boolean): Integer;
begin
  if WholeWord then
    Result := FRichEdit.FindText(SubStr, StartPos, Length(FRichedit.Text) -
      StartPos, [stWholeWord])
  else
    Result := FRichEdit.FindText(SubStr, StartPos, Length(FRichedit.Text) -
      StartPos, []);
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TRichEditHelper.HighlightWords
//
//    Author : Michael Puff
//    Date   : 2004-08-08
//    Purpose: Hebt Wörter aus einer List in einem RichEdit hervor
//

function TRichEditHelper.HighlightWords(Words: TStrings; FontStyle:
  TFontStyles;
  Color: TColor): Cardinal;
var
  i: Integer;
  LastWordPos: Integer;
  HighLightedWords: Cardinal;
begin
  LastWordPos := 0;
  HighLightedWords := 0;
  FRichEdit.Lines.BeginUpdate;
  for i := 0 to Words.Count - 1 do
  begin
    while LastWordPos <> 1 do
    begin
      LastWordPos := Find(LastWordPos, Words[i], True);
      FRichEdit.SelStart := LastWordPos;
      FRichEdit.SelLength := length(Words[i]);
      FRichEdit.SelAttributes.Color := Color;
      FRichEdit.SelAttributes.Style := FontStyle;
      LastWordPos := LastWordPos + 2;
      Inc(HighLightedWords);
    end;
    LastWordPos := 0;
  end;
  FRichEdit.Lines.EndUpdate;
  result := HighLightedWords;
end;

end.

Eventuell fallen euch ja noch ein paar nützliche sachen ein, die mit dem RichEdit zutun haben und da rein können. Aber mehr brauche ich im Moment selber nicht.