2011計(jì)算機(jī)等級(jí)考試Delphi講義：字符串列表應(yīng)用

　　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 替換對(duì)話框部件

　　替換對(duì)話框部件為應(yīng)用程序提供替換對(duì)話框。如圖4.9。它包括查找對(duì)話框的所有功能，此外還允許使用者更換被選中的字符串。FindText 屬性是應(yīng)用程序需查找的字符串。ReplaceText屬性是被選中字符的替換字符串。Options 屬性決定對(duì)話框的顯示方式。其值如表4.3所示。

　　與查找對(duì)話框一樣，替換對(duì)話框亦有OnFind 事件。用戶輸入查找字符串并按FindNext按鈕時(shí)，發(fā)生OnFind 事件。用戶選擇Replace 或ReplacAll 時(shí)， 對(duì)話框發(fā)生OnRelpace事件，要替換的字符串存入ReplaceText屬性中，要編寫相應(yīng)的代碼以支持替換功能。

　　表4.3 替換對(duì)話框的Options屬性的取值及含義

　　例程中TEditForm.Replace方法響應(yīng)OnReplace事件，Replace方法首先判斷控制中被

　　選中字符串是否與替換字符串相等，如果不等則進(jìn)行替換。而后根據(jù)Options中的方式循

　　環(huán)進(jìn)行查找替換。直至無匹配字符串為止。其代碼如下：

　　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;