...einen Text im Memofeld finden?

Autor: Adrian Zinke
Homepage: http://www.adrian-zinke.de

Kategorie: Strings

{++++++++++++++++++++++ German +++++++++++++++++++++++++++++++++++++++
Hinweis: Die Checkbox1 ist dazu da, die Groß bzw. Kleinschreibung zu
beachten bzw. nicht beachten.
Der Suchenbutton markiert im Memofeld immer nur das erste Wort.
Der Weitersuchenbutton markiert alle Wörter nacheinander. Bevor man
auf Weitersuchen klickt, muss man auf Suchen klicken.
+++++++++++++++++++++++ english+++++++++++++++++++++++++++++++++++++++
The CheckBox controls the case.
The Find button always look for the 1st occurence.
The FindNext will highlight all the words one after another
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  
TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    
{ Private-Deklarationen }
  
public
    
{ Public-Deklarationen }
  
end;

var
  
Form1: TForm1;
  x: Integer;
  find: Boolean = False;

implementation

{$R *.dfm}

//Suchenbutton:

procedure TForm1.Button1Click(Sender: TObject);
var
  
i: Integer;
  a: string;
begin
  
Memo1.Lines.Add('');
  Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
  for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
  begin
    
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
    if CheckBox1.Checked = True then
    begin
      if 
a = edit1.Text then
      begin
        
find := True;
        x    := 2;
        Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        Memo1.SetFocus;
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        break;
      end;
    end
    else
    begin
      if 
lowercase(a) = lowercase(edit1.Text) then
      begin
        
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        find := True;
        x    := 2;
        Memo1.SetFocus;
        Memo1.SelStart  := i - 2;
        Memo1.SelLength := Length(edit1.Text);
        break;
      end;
    end;
  end;
  if find = False then ShowMessage('SuchString nicht gefunden') 
  else 
    
find := False;
end;

//Weitersuchenbutton:

procedure TForm1.Button2Click(Sender: TObject);
var
  
i: Integer;
  a: string;
  d: Integer;
begin
  
d := 0;
  for i := 0 to Length(Memo1.Lines.Text) - Length(edit1.Text) do
  begin
    
a := Copy(Memo1.Lines.Text, i, Length(edit1.Text));
    if CheckBox1.Checked = True then
    begin
      if 
a = edit1.Text then
      begin
        
d := d + 1;
        if d = x then
        begin
          
find := True;
          x    := x + 1;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
          Memo1.SetFocus;
          Memo1.SelStart  := i - 1;
          Memo1.SelLength := Length(edit1.Text);
          break;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        end;
      end;
    end
    else
    begin
      if 
lowercase(a) = lowercase(edit1.Text) then
      begin
        
d := d + 1;
        if d = x then
        begin
          
find := True;
          x    := x + 1;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
          Memo1.SetFocus;
          Memo1.SelStart  := i - 1;
          Memo1.SelLength := Length(edit1.Text);
          break;
          Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
        end;
      end;
    end;
  end;
  if find = False then ShowMessage('SuchString nicht gefunden') 
  else 
    
find := False;
end;

 

printed from
www.swissdelphicenter.ch
developers knowledge base