2011计算机等级考试Delphi讲义：字符串列表应用

　　SearchMemo代码如下：

　　unit Search;

　　interface

　　uses WinProcs, SysUtils, StdCtrls, Dialogs;

　　const

　　WordDelimiters: set of Char = [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0'];

　　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) = 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

　　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

　　else

　　begin

　　Direction := -1;

　　Dec(SelStart, Length(SearchString));

　　SearchCount := SelStart;

　　end;

　　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

　　AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap));

　　AnsiUpperBuff(@SearchString[1],

　　Length(SearchString));

　　end;

　　while SearchCount > 0 do

　　begin

　　if frWholeWord in Options then

　　if not FindNextWordStart(Result) then Break;

　　I := 0;

　　while (CharMap[Result[I]] = SearchString[I+1]) do

　　begin

　　Inc(I);

　　if I >= Length(SearchString) then

　　begin

　　if (not (frWholeWord in Options)) or

　　(SearchCount = 0) or

　　(Result[I] in WordDelimiters) then

　　Exit;

　　Break;

　　end;

　　end;

　　Inc(Result, Direction);

　　Dec(SearchCount);

　　end;

　　Result := nil;

　　end;

　　end.

　　4.4.3 替换对话框部件

　　替换对话框部件为应用程序提供替换对话框。如图4.9。它包括查找对话框的所有功能，此外还允许使用者更换被选中的字符串。FindText 属性是应用程序需查找的字符串。ReplaceText属性是被选中字符的替换字符串。Options 属性决定对话框的显示方式。其值如表4.3所示。

　　与查找对话框一样，替换对话框亦有OnFind 事件。用户输入查找字符串并按FindNext按钮时，发生OnFind 事件。用户选择Replace 或ReplacAll 时， 对话框发生OnRelpace事件，要替换的字符串存入ReplaceText属性中，要编写相应的代码以支持替换功能。

　　表4.3 替换对话框的Options属性的取值及含义

　　例程中TEditForm.Replace方法响应OnReplace事件，Replace方法首先判断控制中被

　　选中字符串是否与替换字符串相等，如果不等则进行替换。而后根据Options中的方式循

　　环进行查找替换。直至无匹配字符串为止。其代码如下：

　　procedure TEditForm.Replace(Sender: TObject);

　　var

　　Found: Boolean;

　　begin

　　with ReplaceDialog1 do

　　begin

　　if AnsiCompareText(Memo1.SelText, FindText) = 0 then

　　Memo1.SelText := ReplaceText;

　　Found := SearchMemo(Memo1, FindText, Options);

　　while Found and (frReplaceAll in Options) do

　　begin

　　Memo1.SelText := ReplaceText;

　　Found := SearchMemo(Memo1, FindText, Options);

　　end;

　　if (not Found) and (frReplace in Options) then

　　ShowMessage('Cannot find "' + FindText + '".');

　　end;

　　end;