SearchMemo代码如下
unit Search;
interface
uses WinProcs SysUtils StdCtrls Dialogs;
const
WordDelimiters: set of Char = [##] [azAZ];
function SearchMemo（Memo: TCustomEdit;
const SearchString: String;
Options: TFindOptions） Boolean;
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） = ） then Exit;
Size := MemoGetTextLen;
if （Size = ） then Exit;
Buffer := StrAlloc（Size + ）
try
MemoGetTextBuf（Buffer Size + ）
P := SearchBuf（Buffer Size MemoSelStart
MemoSelLengthSearchString Options）
if P <> nil then
begin
MemoSelStart := P Buffer;
MemoSelLength := 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 （） skip non
delimiters then skip delimiters }
{ When Direction is backward （） skip delims then
skip non delims }
while （SearchCount > ） and
（（Direction = ） xor （BufPtr^ in
WordDelimiters）） do
begin
Inc（BufPtr Direction）
Dec（SearchCount）
end;
while （SearchCount > ） and
（（Direction = ） xor （BufPtr^ in
WordDelimiters）） do
begin
Inc（BufPtr Direction）
Dec（SearchCount）
end;
Result := SearchCount > ;
if Direction = 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 <= then Exit;
if frDown in Options then
begin
Direction := ;
Inc（SelStart SelLength） { start search past end of
selection }
SearchCount := BufLen SelStart Length（SearchString）
if SearchCount < then Exit;
if Longint（SelStart） + SearchCount > BufLen then
Exit;
end
else
begin
Direction := ;
Dec（SelStart Length（SearchString））
SearchCount := SelStart;
end;
if （SelStart < ） 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
AnsiUpperBuff（PChar（@CharMap） sizeof（CharMap））
AnsiUpperBuff（@SearchString[]
Length（SearchString））
end;
while SearchCount > do
begin
if frWholeWord in Options then
if not FindNextWordStart（Result） then Break;
I := ;
while （CharMap[Result[I]] = SearchString[I+]） do
begin
Inc（I）
if I >= Length（SearchString） then
begin
if （not （frWholeWord in Options）） or
（SearchCount = ） or
（Result[I] in WordDelimiters） then
Exit;
Break;
end;
end;
Inc（Result Direction）
Dec（SearchCount）
end;
Result := nil;
end;
end
[] [] [] []
![DELPHI基础教程：文本编辑器的设计（二）[2]](/UploadFiles/1.jpg)