[shaman]

Мне необходимо выполнить поиск текста в memo. Искомый текст вводится в Edit и необходимо полностью задействовать компонент FindDialog.

[Winny]

http://delphiworld.narod.ru/base/memo_str_search.html
http://www.beluch.ru/progr/100comp/8_7.htm
Учись пользоваться Яндексом.

[shaman]

Спасибо конечно за поиск. Но я смотрел эти примеры, но они у меня не работают. Можете написать мне пример (Искомый текст вводится в Edit или можно задействовать компонент FindDialog, но лучше я думаю через FindDialog) и дать исходник. Заранее спасибо.

[moo2k]

Код:

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;

[shaman]

Можете выложить этот материал в виде готового работающего исходника?

[PashaXP]

Подскажите, плиз, если в свойстве Memo ScrollBars выбрано ssNone, это значит автоперенос слов работает?

[Stranger333]

Как мне сделать что бы компонент FindDialog, создовал поиск текста в Memo. Мне надо ето сделать при нажатии кнопки. Помогите плиз!!!

[Страдалецъ]

Собственно там особо и делать нечего если нужно искать только первое вхождение:

Код:

procedure TForm24.FindDialog1Find(Sender: TObject);
begin
 Memo1.SelStart := Pos(FindDialog1.FindText,Memo1.Text)-1;
 Memo1.SelLength := Length(FindDialog1.FindText);
 Memo1.SetFocus;
end;

А вот если надо реализовывать продолжение поиска, тогда уже чуток посложнее.

[Stranger333]

Сообщение от Страдалецъ

Собственно там особо и делать нечего если нужно искать только первое вхождение:

Код:

procedure TForm24.FindDialog1Find(Sender: TObject);
begin
 Memo1.SelStart := Pos(FindDialog1.FindText,Memo1.Text)-1;
 Memo1.SelLength := Length(FindDialog1.FindText);
 Memo1.SetFocus;
end;

А вот если надо реализовывать продолжение поиска, тогда уже чуток посложнее.

помоги мне нцжно ищё продолжения поиска, я пробувал чё то у меня не выходит!

[Stranger333]

СПС! тут ище такое надо както сделать что бы принимался к вниманию параметры окна поиска - с учетом регистра, слово целиком, поис: верх, вниз. (у меня сегодня башка не работаетhttp://www.delphisources.ru/forum/im...lies/smile.gif)

[Stranger333]

[quote=Stranger333]СПС! тут ище такое надо както сделать что бы принимался к вниманию параметры окна поиска - с учетом регистра, слово целиком, поис: верх, вниз. (у меня сегодня башка не работает)