Пришло мне письмо от Алексея. На этот раз он прислал
(цитирую): "юнит для поиска строки(текста) в TEdit, TMemo, или других
компонентах (дочерних TCustomEdit'у)." Так как тескт "авторский" (более того,
здесь также присутствует наследование), помещаю его здесь в том виде, в котором
он был прислан, т.е. без перевода. В случае каких-либо вопросов и недоразумений
обращайтесь по вышеуказанносу адресу электронной почты.
{ПРИМЕР :
[...]
implementation
uses Search;}{$R *.DFM}{procedure TForm1.Button1Click(Sender: TObject);
begin
SearchMemo(RichEdit1, 'Найди меня', [frDown]);
end;
В опции поиска можно подключать, отключать, комбинировать следующие
параметры:
frDown - указывает на то, что происходит поиск вниз по тексту от курсора(при
отключенном frDown'е будет происходит поиск вверх по тексту).
frMatchCase - указывает на то, что следует проводить поиск с учетом
регистра.
frWholeWord - указывает на то, что следует искать только слово целиком.
[...]
Авторские права на этот юнит пренадлежат неизвесно кому.
В каком виде этот юнит попал мне, практически в этом же
виде я отдаю его вам. Пользуйтесь и благодарите неизвесного
героя.}unit Search;
interfaceuses
WinProcs, SysUtils, StdCtrls, Dialogs;
const{****************************************************************************
* Default word delimiters are any character except the core alphanumerics. *
****************************************************************************}
WordDelimiters: setof 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;
implementationfunction 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 <> nilthenbegin
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)) dobegin
Inc(BufPtr, Direction);
Dec(SearchCount);
end;
while (SearchCount > 0) and
((Direction = -1) xor
(BufPtr^ in WordDelimiters)) dobegin
Inc(BufPtr, Direction);
Dec(SearchCount);
end;
Result := SearchCount > 0;
if Direction = -1 thenbegin{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 thenbegin{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...}elsebegin{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;
ifnot (frMatchCase in Options) thenbegin{if not (frMatchCase}
AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));
AnsiUpperBuff(@SearchString[1], Length(SearchString));
end; {if not (frMatchCase}while SearchCount > 0 dobegin{while SearchCount}if frWholeWord in Options thenbeginifnot FindNextWordStart(Result) then
Break;
end;
I := 0;
while (CharMap[Result[I]] = SearchString[I + 1]) dobegin{while (CharMap...}
Inc(I);
if I >= Length(SearchString) thenbegin{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.
Это модуль для поиска текста в компонентах TEdit, TMemo и других компонентах, наследуемых от TCustomEdit.
Функция SearchMemo сканирует текст компонента TEdit или TMemo для заданного поискового строки. Она начинает поиск с текущей позиции курсора в контроле и использует указанные параметры для определения направления поиска (вперед или назад), чувствительности к регистру и соответствия целым словами.
Функция SearchBuf - это более низкоуровневая функция поиска, которая может использоваться с произвольными буферами текста. Она работает аналогично SearchMemo, но позволяет больше гибкости в выборе буфера для поиска и параметрах поиска.
Модуль также включает в себя два константы: WordDelimiters, которая определяет набор символов, которые считаются разделителями слов, а также frDown, frMatchCase и frWholeWord, которые используются для указания параметров поиска. Эти константы можно комбинировать с помощью операторов побитового сложения для создания различных сценариев поиска.
В имплементации есть несколько функций:
SearchMemo: эта функция отвечает за поиск текста компонента TEdit или TMemo для заданного поискового строки.
SearchBuf: эта функция отвечает за поиск произвольного буфера текста для заданного поискового строки.
FindNextWordStart: эта функция используется SearchBuf для нахождения начала следующего слова в буфере.
В имплементации также есть несколько переменных:
Buffer: указатель на буфер, который хранит текст, который ищется.
Size: размер буфера, который ищется.
SelStart, SelLength: эти переменные используются для указания диапазона выделения для поиска.
SearchCount, I: эти переменные используются для перебора символов в буфере во время поиска.
В имплементации также есть комментарии, которые объясняют, как функции работают и что различные переменные используются для.
Поиск строки текста в наследниках TCustomEdit: реализация юнита для поиска строки текста в компонентах на языке Delphi.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.