Архив исходников программ, модулей и компонентов на Delphi


Начальная страница

Поиск по базе



Операционная система
Настройка приложения
Взаимодействия приложений
Файлы и директории
Строки и символы
Математика
Базы данных
Интернет и сеть
Мультимедиа
Аппаратная часть
VCL
Другие разделы [0]
 

Количество записей в базе - 537
Сегодня добавлено – 0

Сервис для компонентов



Вернуться к списку функций
 Поиск строки в редакторе Memo

 Прислал: Fenik (Новоуральск) ( 26 июня 2002 г. )
©  Автор: Федоровских Николай
 Зависимости:
Windows, Classes, StdCtrls

 Ограничения:
Проверено в Delphi 5, Win Me

 Исходный текст:
{ **** UBPFD *********** by http://kladovka.net.ru/delphibase/ ****
>> Поиск строки в редакторе 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;


Вернуться к списку функций

Наверх ▲