Mega Code Archive
Find a text in a memo
<![CDATA[
{++++++++++++++++++++++ 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;
]]>