Var sPos: integer;
procedure TForm1.MFindClick(Sender: TObject);
begin
{запоминание позиции курсора}
SPos := Memo1.SelStart;
with FindDialog1 do
begin
{начальное значение текста поиска —
текст, выделенный в Memo1}
FindText := Memo1.SelText;
{позиционирование окна диалога внизу Memo1}
Position := Point(Form1.Left, Form1.Top +
Memo1.Top + Memo1.Height);
{удаление из диалога кнопок «Вверх», «Вниз»,
«Только слово целиком»}
Options := Options + [frHideUpDown, frHideWholeWord];
{выполнение}
Execute;
end;
end;
procedure TForm1.FindDialog1Find(Sender: TObject);
begin
with FindDialog1 do
begin
if frMatchCase in Options
{поиск с учетом регистра}
then Memo1.SelStart := Pos(FindText,
Copy(Memo1.Lines.Text, SPos + 1,
Length(Memo1.Lines.Text))) + Spos - 1
{поиск без учета регистра}
else Memo1.SelStart := Pos(AnsiLowerCase(FindText),
AnsiLowerCase(Copy(Memo1.Lines.Text, SPos + 1,
Length(Memo1.Lines.Text)))) + Spos - 1;
if Memo1.SelStart >= Spos
then
begin
{выделение найденного текста}
Memo1.SelLength := Length(FindText);
{изменение начальной позиции поиска}
SPos := Memo1.SelStart + Memo1.SelLength + 1;
end
else if MessageDlg(
'Текст "'+FindText+'" не найден. Продолжать диалог?',
mtConfirmation, mbYesNoCancel, 0) <> mrYes
then CloseDialog;
end;
Memo1.SetFocus;
end;
В программе вводится переменная SPos, сохраняющая позицию, начиная с которой надо проводить поиск.
Процедура MFindClick вызывает диалог, процедура FindDialog1Find обеспечивает поиск с учетом или без учета регистра в зависимости от флага frMatchCase. После нахождения очередного вхождения искомого текста этот текст выделяется в окне Memo1 и управление передается этому окну редактирования. Затем при нажатии пользователем в диалоговом окне кнопки Найти далее, поиск продолжается в оставшейся части текста. Если искомый текст не найден, делается запрос пользователю о продолжении диалога. Если пользователь не ответил на этот запрос положительно, то диалог закрывается методом CloseDialog.
В дополнение к приведенному тексту полезно в обработчики событий OnClick и OnKeyUp компонента Memo1 ввести операторы
SPos := Memo1.SelStart;
Это позволяет пользователю во время диалога изменить положение курсора в окне Memo1. Это новое положение сохранится в переменной SPos и будет использовано при продолжении поиска.
При реализации команды Заменить приведенные выше процедуры можно оставить теми же самыми, заменив в них FindDialog1 на ReplaceDialog1. Дополнительно можно написать процедуру обработки события OnReplace компонента ReplaceDialog1:
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
begin
if Memo1.SelText <> ''
then Memo1.SelText := ReplaceDialog1.ReplaceText;
if frReplaceAll in ReplaceDialog1.Options
then ReplaceDialog1Find(Self);
end;
Этот код производит замену выделенного текста и, если пользователь нажал кнопку Заменить все, то продолжается поиск вызовом уже имеющейся процедуры поиска ReplaceDialog1Find*. Если же пользователь нажал кнопку Заменить, то производится только одна замена и для продолжения поиска пользователь должен нажать кнопку Найти далее.
Предлагаемый алгоритм при нажатии на кнопку Заменить все заменяет только одно значение и находит следующее. На наш взгляд такие действия более логично было бы задать кнопке Заменить, а для Заменить все организовать цикл. Причем такой цикл проще осуществить в процедуре ReplaceDialog1Find. В приведенном ниже коде кроме того введена локальная переменная ss, так как свойству SelStart нельзя присваивать отрицательные значения.
procedure TForm1.ReplaceDialog1Find(Sender: TObject);
var ss: integer;
last: Boolean;
st: string;
begin
with ReplaceDialog1 do begin
if (frFindNext in Options) then
{изменение начальной позиции поиска}
SPos := Memo1.SelStart + Memo1.SelLength + 1;
last := not (frReplaceAll in Options);
repeat
if frMatchCase in Options
{поиск с учетом регистра}
then ss := Pos(FindText,
Copy(Memo1.Lines.Text, SPos + 1,
Length(Memo1.Lines.Text))) + Spos - 1
{поиск без учета регистра}
else ss := Pos(AnsiLowerCase(FindText),
AnsiLowerCase(Copy(Memo1.Lines.Text, SPos + 1,
Length(Memo1.Lines.Text)))) + Spos - 1;
if ss >= Spos then
begin
{выделение найденного текста}
Memo1.SelStart := ss;
Memo1.SelLength := Length(FindText);
if (frReplaceAll in Options) then begin
{замена}
Memo1.SelText := ReplaceDialog1.ReplaceText;
{изменение начальной позиции поиска}
SPos := Memo1.SelStart + Memo1.SelLength + 1;
end;
end
else
begin
if (frReplaceAll in Options) or (frReplace in Options) then
st := 'Замена "' + FindText + '" на "' + ReplaceText + '" закончена'
else st := 'Текст "' + FindText + '" не найден';
if MessageDlg(st + '. Продолжать диалог?',
mtConfirmation, mbYesNoCancel, 0) <> mrYes
then CloseDialog;
last:=true;
end;
until last;
end;
end;
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
begin
if (frReplace in ReplaceDialog1.Options) and (Memo1.SelText <> '')
then Memo1.SelText := ReplaceDialog1.ReplaceText;
ReplaceDialog1Find(Self);
end;