计算机等级考试二级Delphi辅导知识：文本编辑器的设计_第3页

　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属性的取值及含义
　　━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
　　取值　含义
　　────────────────────────────────────────
　　frRelpace 如果是真值， 应用程序将ReplaceText 属性中的字符串替换
　　FindText属性中的字符串。
　　frReplacAll 如果是真值，应用程序将ReplaceText属性中的字符串替换，
　　查找到的所有FindText属性中的字符串。
　　━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━　
　　例程中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;