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

{ПРИМЕР :

[...]

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.
 
« Предыдущая статья   Следующая статья »