Советы по Delphi
Поиск строки текста в наследниках TCustmoEdit
Пришло мне письмо. От 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) thenExit;Size := Memo.GetTextLen;if Size = 0 thenExit;Buffer := StrAlloc(Size + 1);tryMemo.GetTextBuf(Buffer, Size + 1);P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString, Options);if P <> nil thenbeginMemo.SelStart := P - Buffer;Memo.SelLength := Length(SearchString);Result := True;end;finallyStrDispose(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)) dobeginInc(BufPtr, Direction);Dec(SearchCount);end; while (SearchCount > 0) and((Direction = -1) xor(BufPtr^ in WordDelimiters)) dobeginInc(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 thenExit; 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 thenExit; if Longint(SelStart) + SearchCount > BufLen thenExit; end {if frDown...}elsebegin {else}Direction := -1;Dec(SelStart, Length(SearchString));SearchCount := SelStart;end; {else} if (SelStart < 0) or (SelStart > BufLen) thenExit; Result := @Buf[SelStart];{ Using a Char map array is faster than calling AnsiUpper on every character } for C := Low(CharMap) to High(CharMap) doCharMap[C] := C; if not (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 thenbeginif not FindNextWordStart(Result) thenBreak;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) thenExit;Break;end; {if I >=...}end; {while (CharMap...} Inc(Result, Direction);Dec(SearchCount);end; {while SearchCount} Result := nil;end; end. |
