Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Поиск строки текста в наследниках TCustomEdit

Автор: Aleksey

Пришло мне письмо от Алексея. На этот раз он прислал (цитирую): "юнит для поиска строки(текста) в TEdit, TMemo, или других компонентах (дочерних TCustomEdit'у)." Так как тескт "авторский" (более того, здесь также присутствует наследование), помещаю его здесь в том виде, в котором он был прислан, т.е. без перевода. В случае каких-либо вопросов и недоразумений обращайтесь по вышеуказанносу адресу электронной почты.


{ПРИМЕР :

[...]

implementation

uses Search;}
{$R *.DFM}

{procedure TForm1.Button1Click(Sender: TObject);
begin

SearchMemo(RichEdit1, 'Найди меня', [frDown]);
end;

В опции поиска можно подключать, отключать, комбинировать следующие
параметры:
frDown - указывает на то, что происходит поиск вниз по тексту от курсора(при
отключенном frDown'е будет происходит поиск вверх по тексту).
frMatchCase - указывает на то, что следует проводить поиск с учетом
регистра.
frWholeWord - указывает на то, что следует искать только слово целиком.

[...]

Авторские права на этот юнит пренадлежат неизвесно кому.

В каком виде этот юнит попал мне, практически в этом же
виде я отдаю его вам. Пользуйтесь и благодарите неизвесного
героя.}

unit Search;

interface

uses

  WinProcs, SysUtils, StdCtrls, Dialogs;

const
  {****************************************************************************

  * Default word delimiters are any character except the core alphanumerics. *
  ****************************************************************************}
  WordDelimiters: set of Char = [#0..#255] - ['a'..'z', 'A'..'Z', '1'..'9',
    '0'];
  {******************************************************************************

  * SearchMemo scans the text of a TEdit, TMemo, or other TCustomEdit-derived  *
  * component for a given search string. The search starts at the current      *
  * caret position in the control.  The Options parameter determines whether   *
  * the search runs forward (frDown) or backward from the caret position,      *
  * whether or not the text comparison is case sensitive, and whether the      *
  * matching string must be a whole word.  If text is already selected in the  *
  * control, the search starts at the 'far end' of the selection (SelStart if  *
  * searching backwards, SelEnd if searching forwards).  If a match is found,  *
  * the control's text selection is changed to select the found text and the   *
  * function returns True.  If no match is found, the function returns False.  *
  ******************************************************************************}
function SearchMemo(Memo: TCustomEdit;

  const SearchString: string;
  Options: TFindOptions): Boolean;
{******************************************************************************

* SearchBuf is a lower-level search routine for arbitrary text buffers.      *
* Same rules as SearchMemo above. If a match is found, the function returns  *
* a pointer to the start of the matching string in the buffer. If no match,  *
* the function returns nil.                                                  *
******************************************************************************}
function SearchBuf(Buf: PChar; BufLen: Integer;

  SelStart, SelLength: Integer;
  SearchString: string;
  Options: TFindOptions): PChar;

implementation

function SearchMemo(Memo: TCustomEdit;

  const SearchString: string;
  Options: TFindOptions): Boolean;
var

  Buffer, P: PChar;
  Size: Word;
begin

  Result := False;
  if (Length(SearchString) = 0) then
    Exit;
  Size := Memo.GetTextLen;
  if Size = 0 then
    Exit;
  Buffer := StrAlloc(Size + 1);
  try
    Memo.GetTextBuf(Buffer, Size + 1);
    P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString,
      Options);
    if P <> nil then
    begin
      Memo.SelStart := P - Buffer;
      Memo.SelLength := Length(SearchString);
      Result := True;
    end;
  finally
    StrDispose(Buffer);
  end;
end;

function SearchBuf(Buf: PChar; BufLen: Integer;

  SelStart, SelLength: Integer;
  SearchString: string;
  Options: TFindOptions): PChar;
var

  SearchCount, I: Integer;
  C: Char;
  Direction: Shortint;
  CharMap: array[Char] of Char;

  function FindNextWordStart(var BufPtr: PChar): Boolean;
  begin { (True XOR N) is equivalent to (not N) }
    //    Result := False;      { (False XOR N) is equivalent to (N)    }

    { When Direction is forward (1), skip non delimiters, then skip delimiters. }
    { When Direction is backward (-1), skip delims, then skip non delims }

    while (SearchCount > 0) and
      ((Direction = 1) xor
      (BufPtr^ in WordDelimiters)) do
    begin
      Inc(BufPtr, Direction);
      Dec(SearchCount);
    end;

    while (SearchCount > 0) and
      ((Direction = -1) xor
      (BufPtr^ in WordDelimiters)) do
    begin
      Inc(BufPtr, Direction);
      Dec(SearchCount);
    end;

    Result := SearchCount > 0;
    if Direction = -1 then
    begin {back up one char, to leave ptr on first non delim}
      Dec(BufPtr, Direction);
      Inc(SearchCount);
    end;
  end;

begin

  Result := nil;

  if BufLen <= 0 then
    Exit;

  if frDown in Options then
  begin {if frDown...}
    Direction := 1;
    Inc(SelStart, SelLength); { start search past end of selection }
    SearchCount := BufLen - SelStart - Length(SearchString);

    if SearchCount < 0 then
      Exit;

    if Longint(SelStart) + SearchCount > BufLen then
      Exit;

  end {if frDown...}
  else
  begin {else}
    Direction := -1;
    Dec(SelStart, Length(SearchString));
    SearchCount := SelStart;
  end; {else}

  if (SelStart < 0) or (SelStart > BufLen) then
    Exit;

  Result := @Buf[SelStart];
  { Using a Char map array is faster than calling AnsiUpper on every character }

  for C := Low(CharMap) to High(CharMap) do
    CharMap[C] := C;

  if not (frMatchCase in Options) then
  begin {if not (frMatchCase}
    AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));
    AnsiUpperBuff(@SearchString[1], Length(SearchString));
  end; {if not (frMatchCase}

  while SearchCount > 0 do
  begin {while SearchCount}
    if frWholeWord in Options then
    begin
      if not FindNextWordStart(Result) then
        Break;
    end;
    I := 0;

    while (CharMap[Result[I]] = SearchString[I + 1]) do
    begin {while (CharMap...}
      Inc(I);
      if I >= Length(SearchString) then
      begin {if I >=...}
        if (not (frWholeWord in Options)) or
          (SearchCount = 0) or
          (Result[I] in WordDelimiters) then
          Exit;
        Break;
      end; {if I >=...}
    end; {while (CharMap...}

    Inc(Result, Direction);
    Dec(SearchCount);
  end; {while SearchCount}

  Result := nil;
end;

end.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.