Search单元 SearchMemo
///////////////////////////////////////////////////////////////////////////////////////////
//Search单元 SearchMemo
///////////////////////////////////////////////////////////////////////////////////////////
unit Search;
interface
uses
SysUtils, StdCtrls, Dialogs, StrUtils;
function SearchMemo(Memo: TCustomEdit; const SearchString: string; Options: TFindOptions): Boolean;
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 := SysUtils.StrAlloc(Size + 1);
try
Memo.GetTextBuf(Buffer, Size + 1);
if frDown in Options then
P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength,SearchString, [soDown])
else
P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength,SearchString, []);
if (frMatchCase in Options) then
P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString,[soMatchCase]);
if (frWholeWord in Options) then
P := SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString,[soWholeWord]);
if P <> nil then
begin
Memo.SelStart := P - Buffer;
Memo.SelLength := Length(SearchString);
Result := True;
end;
finally
SysUtils.StrDispose(Buffer);
end;
end;
end.
///////////////////////////////////////////////////////////////////////////////////////////
Unit1单元代码
///////////////////////////////////////////////////////////////////////////////////////////
//Unit1单元
///////////////////////////////////////////////////////////////////////////////////////////
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
FindDialog1: TFindDialog;
ReplaceDialog1: TReplaceDialog;
MainMenu1: TMainMenu;
Edit1: TMenuItem;
Find1: TMenuItem;
Replace1: TMenuItem;
FindNext1: TMenuItem;
N1: TMenuItem;
Memo1: TMemo;
procedure FindDialog1Find(Sender: TObject);
procedure ReplaceDialog1Replace(Sender: TObject);
procedure ReplaceDialog1Find(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FindNext1Click(Sender: TObject);
procedure Find1Click(Sender: TObject);
procedure Replace1Click(Sender: TObject);
procedure Edit1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FindStr: string;
implementation
uses Search;
{$R *.dfm}
{ FindDialog Find }
procedure TForm1.FindDialog1Find(Sender: TObject);
begin
with Sender as TFindDialog do
begin
FindStr := FindText;
if not SearchMemo(Memo1, FindText, Options) then
MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
MB_ICONINFORMATION);
end;
end;
{ ReplaceDialog Replace }
procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
var
Found: Boolean;
begin
with ReplaceDialog1 do
begin
{ Replace }
if (frReplace in Options) and (Memo1.SelText = FindText) then
Memo1.SelText := ReplaceText;
Found := SearchMemo(Memo1, FindText, Options);
{ Replace All }
if (frReplaceAll in Options) then
begin
Memo1.SelStart := 0;
while Found do
begin
if (Memo1.SelText = FindText) then
Memo1.SelText := ReplaceText;
Found := SearchMemo(Memo1, FindText, Options);
end;
if not found then
SendMessage(form1.Memo1.Handle,WM_VSCROLL,SB_TOP,0);
end;
if (not Found) and (frReplace in Options) then
MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
MB_ICONINFORMATION);
end;
end;
{ ReplaceDialog Find }
procedure TForm1.ReplaceDialog1Find(Sender: TObject);
begin
with Sender as TReplaceDialog do
if not SearchMemo(Memo1, FindText, Options) then
MessageBox(Handle, PWideChar(Concat('找不到"', FindText, '"')), '记事本',
MB_ICONINFORMATION);
end;
{ Find Next }
procedure TForm1.FindNext1Click(Sender: TObject);
begin
if not SearchMemo(Memo1, FindStr, FindDialog1.Options) then
MessageBox(Handle, PWideChar(Concat('找不到"', FindStr, '"')), '记事本',
MB_ICONINFORMATION);
end;
{ FindDialog1.Execute }
procedure TForm1.Find1Click(Sender: TObject);
begin
with FindDialog1 do
begin
Left := Self.Left + 100;
Top := Self.Top + 150;
FindText := Memo1.SelText;
Execute;
end;
end;
{ ReplaceDialog1.Execute }
procedure TForm1.Replace1Click(Sender: TObject);
begin
with ReplaceDialog1 do
begin
Left := Self.Left + 100;
Top := Self.Top + 150;
FindText := Memo1.SelText;
Execute;
end;
end;
{ MainMenu Enable }
procedure TForm1.Edit1Click(Sender: TObject);
begin
Find1.Enabled := (Memo1.Text <> '');
FindNext1.Enabled := (Memo1.Text <> '') or (FindStr <> '');
Replace1.Enabled := (Memo1.Text <> '');
end;
{ Initial }
procedure TForm1.FormCreate(Sender: TObject);
begin
Position := poDesktopCenter;
// FindDialog1.Options := [frDown, frHideWholeWord];
// ReplaceDialog1.Options := [frDown, frHideWholeWord];
with Memo1 do
begin
HideSelection := False;
ScrollBars := ssVertical;
Align := alClient;
end;
end;
end.
///////////////////////////////////////////////////////////////////////////////////////////
PS:
SearchMemo这个函数在我看Delphi TipSender中有本书 《Delphi 2.0 高级程序设计指南》里面找到的，不过我对它进行删减，保留了最重要的部分，并增强了它。
用Delphi的ActionList可以完全的实现FindDialog和ReplaceDialog的全部功能并且不用一句代码
但如果你要用它写一个记事本的话那个 F3查找下一个 并不能实现
