Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Поиск строки в редакторе Memo

Зависимости: Windows, Classes, StdCtrls
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Автор: Федоровских Николай
Дата:        26 июня 2002 г.
***************************************************** }

function FindInMemo(Memo: TMemo; const FindText: string;
  FindDown, MatchCase: Boolean): Boolean;

{Если строка найдена, то результат True, иначе - False;

 FindText : искомая строка;
 FindDown : True - поиск вниз от курсора ввода;
             False - поиск вверх от курсора ввода;
 MatchCase : True - с учетом регистра букв,
             False - не учитывая регистр бук.

 Если у Memo стоит автоперенос слов, то могут
 возникнуть проблемы - текст будет найден,
 но выделен не там где надо. Так что, для нормального поиска
 свойство ScrollBars у Memo ставить в ssBoth (ну или ssHorizontal)}

  function PosR2L(const FindStr, SrcStr: string): Integer;
    {Поиск последнего вхождения подстроки FindStr в строку SrcStr}
  var
    ps, L: Integer;

    function InvertSt(const S: string): string;
      {Инверсия строки S}
    var
      i: Integer;
    begin
      L := Length(S);
      SetLength(Result, L);
      for i := 1 to L do
        Result[i] := S[L - i + 1];
    end;

  begin
    ps := Pos(InvertSt(FindStr), InvertSt(SrcStr));
    if ps <> 0 then
      Result := Length(SrcStr) - Length(FindStr) - ps + 2
    else
      Result := 0;
  end;

  function MCase(const s: string): string;
    {Перевод заглавных букв в строчные;
     Функция вызывается если регистр не учитывается}
  var
    i: Integer;
  begin
    Result := s;
    for i := 1 to Length(s) do
    begin
      case s[i] of
        'A'..'Z',
          'А'..'Я': Result[i] := Chr(Ord(s[i]) + 32);
        'Ё': Result[i] := 'ё';
        'Ѓ': Result[i] := 'ѓ';
        'Ґ': Result[i] := 'ґ';
        'Є': Result[i] := 'є';
        'Ї': Result[i] := 'ї';
        'І': Result[i] := 'і';
        'Ѕ': Result[i] := 'ѕ';
      end;
    end;
  end;

var
  Y, X, SkipChars: Integer;
  FindS, SrcS: string;
  P: TPoint;
begin
  Result := False;

  if MatchCase then
    FindS := FindText
  else
    FindS := MCase(FindText);

  P := Memo.CaretPos;

  if FindDown then
    {Поиск вправо и вниз от курсора ввода}
    for Y := P.y to Memo.Lines.Count do
    begin

      if Y <> P.y then
        {Если это не строка, в которой курсор вода,
         то ищем во всей строке}
        SrcS := Memo.Lines[Y]
      else
        {иначе обрезаем строку от курсора до конца}
        SrcS := Copy(Memo.Lines[Y], P.x + 1,
          Length(Memo.Lines[Y]) - P.x + 1);

      if not MatchCase then
        SrcS := MCase(SrcS);
      X := Pos(FindS, SrcS);
      if X <> 0 then
      begin
        if Y = P.y then
          Inc(X, P.x);
        P := Point(X, Y);
        Result := True;
        Break; {Выход из цикла}
      end
    end
  else
    {Поиск влево и вверх от курсора ввода}
    for Y := P.y downto 0 do
    begin

      if Y <> P.y then
        {Если это не строка, в которой курсор вода,
         то ищем во всей строке}
        SrcS := Memo.Lines[Y]
      else
        {иначе обрезаем строку от начала до курсора
         минус выделенный текст}
        SrcS := Copy(Memo.Lines[Y], 1, P.x - Memo.SelLength);

      if not MatchCase then
        SrcS := MCase(SrcS);
      X := PosR2L(FindS, SrcS);
      if X <> 0 then
      begin
        P := Point(X, Y);
        Result := True;
        Break; {Выход из цикла}
      end
    end;

  if Result then
  begin
    {Если текст найден - выделяем его}
    SkipChars := 0;
    for y := 0 to P.Y - 1 do
      Inc(SkipChars, Length(Memo.Lines[y]));
    Memo.SelStart := SkipChars + (P.Y * 2) + P.X - 1;
    Memo.SelLength := Length(FindText);
  end;
end;

Пример использования:

procedure TForm1.FindDialog1Find(Sender: TObject);
begin
  if not FindInMemo(Memo1,
    FindDialog1.FindText,
    frDown in FindDialog1.Options,
    frMatchCase in FindDialog1.Options) then
    Application.MessageBox('Поиск результатов не дал.',
      PChar(Application.Title),
      MB_OK or MB_ICONINFORMATION);
end;