// Ein TMemo wird entweder Stück für Stück nach einem Begriff durchsucht,
// oder das Vorhandensein dieses Begriffes wird gezählt. Das wird mit der
// Variablen "DurchZaehlen" gesteuert. Dabei wird durch "VonAnfang" bestimmt,
// ob am Kursor oder am Anfang des Textes mit der Suche begonnen wird;
// das Zählen beginnt jedoch immer am Anfang. Man kann den Suchvorgang von
// Hand mit Button2 unterbrechen, oder mittels "AutoEnd" bei Veränderungen
// des Memos (z.B. Anklicken oder Tastendruck) automatisch abbrechen lassen.
// Mit "PositionAnzeigen" wird bestimmt, ob die jeweilige Fundstelle in einem
// TLabel angezeigt werden soll.


// Getestet mit RS 10.4 unter Win11

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    Memo1: TMemo; 
    Button2: TButton; 
    Label1: TLabel; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    procedure Memo1Click(Sender: TObject); 
    procedure Memo1Change(Sender: TObject); 
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
  private 
    { Private-Deklarationen } 
  public 
    function Suche(SubStr: String; TextBox: TCustomEdit; 
      WholeWord, MatchCase: Boolean; out Posi: Integer): Boolean; 
    procedure Nomore; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  Weiter, Stop: Boolean; 
  Zahl: Integer; 
  Lauf: Boolean = False; 
  Anzeige: TLabel; 
 
  // --- z.B. ----- 
  SuchText: String = 'Eier'; 
  GanzesWort: Boolean = True; 
  GrossKlein: Boolean = False; 
  VonAnfang: Boolean = True; 
  AutoEnd: Boolean = True; 
  DurchZaehlen: Boolean = False; 
  PositionAnzeigen: Boolean = True; 
  // ---------------- 
 
const 
  Seperatoren: set of AnsiChar = [#132, #147, #148, 'a' .. 'z', 'ä', 'ö', 'ü', 
    'ß', 'A' .. 'Z', 'Ä', 'Ö', 'Ü', '´', '`', '0' .. '9']; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Anzeige := Label1; // z.B. 
  Anzeige.Caption := ''; 
  Memo1.MaxLength := Maxint; 
  Memo1.HideSelection := False; 
  Memo1.WordWrap := True; 
  Memo1.ScrollBars := ssVertical; 
  Memo1.Lines.LoadFromFile('Test.txt'); 
end; 
 
procedure TForm1.Nomore; 
begin 
  if AutoEnd then 
  begin 
    Stop := True; 
    Anzeige.Caption := ''; 
  end; 
end; 
 
procedure TForm1.Memo1Change(Sender: TObject); 
begin 
  Nomore; 
end; 
 
procedure TForm1.Memo1Click(Sender: TObject); 
begin 
  Nomore; 
end; 
 
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 
begin 
  Nomore; 
end; 
 
function TForm1.Suche(SubStr: String; TextBox: TCustomEdit; 
  WholeWord, MatchCase: Boolean; out Posi: Integer): Boolean; 
var 
  hlp: String; 
  ps, count: Integer; 
  lft, rgt, trff: Boolean; 
 
  procedure ausgabe; 
  var 
    z: String; 
  begin 
    if Zahl = 1 then 
      z := '' 
    else 
      z := 'n'; 
    TextBox.SelLength := 0; 
    showmessage('Bis zum Ende durchsucht.' + #13 + IntToStr(Zahl) + 
      ' Fundstelle' + z + '.'); 
    Result := False; 
  end; 
 
  procedure nxt; 
  begin 
    TextBox.SelLength := Length(SubStr); 
    inc(Zahl); 
    Posi := succ(TextBox.SelStart); 
  end; 
 
begin 
  Result := True; 
  if MatchCase then 
    hlp := Copy(TextBox.Text, TextBox.SelStart + TextBox.SelLength + 1, Maxint) 
  else 
  begin 
    SubStr := AnsiUpperCase(SubStr); 
    hlp := AnsiUpperCase(Copy(TextBox.Text, TextBox.SelStart + TextBox.SelLength 
      + 1, Maxint)) 
  end; 
  ps := AnsiPos(SubStr, hlp); 
  if ps > 0 then 
  begin 
    if WholeWord then 
    begin 
      count := 0; 
      ps := AnsiPos(SubStr, hlp); 
      trff := False; 
      while (ps > 0) and not trff do 
      begin 
        lft := (ps = 1) or (not(charinset(hlp[ps - 1], Seperatoren))); 
        rgt := (ps + Length(SubStr) >= Length(hlp)) or 
          (not charinset(hlp[ps + Length(SubStr)], Seperatoren)); 
        trff := lft and rgt; 
        inc(count, ps); 
        Delete(hlp, 1, ps); 
        ps := Pos(SubStr, hlp); 
      end; 
      if trff then 
      begin 
        TextBox.SelStart := TextBox.SelStart + TextBox.SelLength + count - 1; 
        nxt; 
      end 
      else 
      begin 
        ausgabe; 
      end; 
    end 
    else 
    begin 
      TextBox.SelStart := TextBox.SelStart + TextBox.SelLength + ps - 1; 
      nxt; 
    end; 
  end 
  else 
  begin 
    ausgabe; 
  end; 
  TextBox.SetFocus; 
end; 

// Suche Starten / Weiterführen 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  Stelle: Integer; 
begin 
  if Lauf then 
  begin 
    Weiter := True; 
  end 
  else 
  begin 
    Anzeige.Caption := ''; 
    if DurchZaehlen then 
      Memo1.Lines.BeginUpdate; 
    Lauf := True; 
    Weiter := DurchZaehlen; 
    Stop := False; 
    Zahl := 0; 
    if VonAnfang or DurchZaehlen then 
      Memo1.SelStart := 0; 
    Memo1.SelLength := 0; 
    repeat 
      Lauf := Suche(SuchText, Memo1, GanzesWort, GrossKlein, Stelle); 
      if not Lauf then 
      begin 
        Anzeige.Caption := ''; 
        Break; 
      end 
      else if PositionAnzeigen and not DurchZaehlen then 
        Anzeige.Caption := FormatFloat('#,##0', Stelle); 
      repeat 
        Application.ProcessMessages; 
      until Weiter or Application.Terminated or Stop; 
      Weiter := DurchZaehlen; 
    until Application.Terminated or Stop; 
  end; 
  Lauf := False; 
  if DurchZaehlen then 
    Memo1.Lines.EndUpdate; 
end; 
 
// Suche abbrechen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if Lauf then 
  begin 
    Stop := True; 
    Memo1.SelLength := 0; 
    Anzeige.Caption := ''; 
    Memo1.SelStart := Memo1.SelStart + Length(SuchText); 
    showmessage('Suche abgebrochen'); 
    Memo1.SetFocus; 
  end; 
end;

Zugriffe seit 6.9.2001 auf Delphi-Ecke