Советы по 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. |
