Советы по Delphi


Поиск строки текста в наследниках TCustmoEdit


Пришло мне письмо. От Aleksey (msalex@tomcat.ru). На этот раз он прислал (цитирую): "юнит для поиска строки(текста) в 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.
[000109]




Начало    



Книжный магазин