TMemo

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Поиск строки в редакторе Memo

Зависимости: Windows, Classes, StdCtrls

Автор:       Fenik, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Новоуральск

Copyright:   Автор: Федоровских Николай

***************************************************** }

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;