DELPHI基础教程
第四章 文本编辑器的设计（二）
4.4.2查找对话框部件
查找对话框部件为应用程序提供查找对话框， 用户可使用查找对话框在文本文件中查找字符串。
可用Execult方法显示查找对话框，如图4.8。应用程序要查找的字符放到FindText属性中。Options 属性可决定查找对话框中有哪些选项。例如， 用户可选择是否显示匹配检查框。Options的常用选项如表4.2所示。
如果用户在对话框中输入字符并选择FindNext按钮，对话框将发生OnFind事件。
表4.2 查找对话框的Options属性的取值及含义
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
取值 含义
───────────────────────────────────────
frDown 如果是真值，对话框中出现Down按钮，查找方向向下。如果是假
值，Up按钮将被选中，查找方向向上，frDown 值可在设计或运行
时设置。
frDisableUpDown 如果是真值，Up和Down按钮将变灰，用户不能进行选取；如果是
假值，用户可以选择其中之一。
frFindNext 如果是真值，应用程序查找在FindNext属性中的字符串。
frMatchCase 如果是真值，匹配检查框被选中。设计、运行时均可设置。
frWholeWord 如果是真值，整字匹配检查框被选中，设计、运行时均可设置。
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
在OnFind事件中可使用Options属性来决定以何种方式查找。Find方法响应查找对话框的OnFind事件。
procedure TEditform.Find(Sender: TObject);
begin
with Sender as TFindDialog do
if not SearchMemo(Memo1, FindText, Options) then
ShowMessage('Cannot find "' + FindText + '".');
end;
其中SearchMemo函数是Search单元中定义的，SearchMemo可在TEdit,TMemo，以及其它TCustomEdit派生类中查找指定的字符串。查找从控件的脱字号(^)开始， 查找方式由Options决定。如果向后查找从控件的StlStart处开始，如果向前查找则从控件的SelEnd处查找。
如果在控件中找到相匹配的字符串，则字符串被选中，函数返回真值。如无匹配的字符串，函数返回假值。
特别注意的是TEdit,TMemo中有一个HideSeletion属性，它决定当焦点从该控制转移至其它控制时，被选中的字符是否保持被选中的状态。如果是真值，则只有获得焦点才能保持被选中状态。查找时，焦点在查找对话框上，因此要想了解查找情况，必须将HideSeletion设成假值。控制的缺省值为真值。
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;
4.4.4 打开对话框部件
打开对话框部件为应用程序显示打开对话框。使用Execute方法可显示打开对话框用户通过选择文件类型下拉框中的文件类型，可以确定显示在文件列表中的文件。 例如，如果用户选择*.txt文件类型，那么只有在当前目录下的文本文件才会显示在文件列表中。文件扩展名通常也称为过滤器。
打开对话框包含一个Filters(过滤器)的属性，它可确定文件类型和在文件类型下拉框中的顺序。应用程序可以为打开对话框定义多个过滤器，对话框的FilterIndex 属性可以决定哪个过滤器是文件类型下拉框中的缺省过滤器。如FilterIndex等于2，表示程序运行时出现在文件类型下拉框的过滤器是第2个过滤器。
例程中关于文件打开的代码如下：
procedure TEditForm.Open/Click(Sender : TObject);
begin
if OpenDialog/.Execult then
begin
…
Open(Open Dialog/.FileName)
end
end;
打开，保存对话框中的Options属性值见表4.4
表4.4 打开、保存对话框的Options属性取值及含义
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
值 含义
──────────────────────────────────────
ofAllowMultiSelect 如果是真值，则允许在文件名列表中选择多个文件。
ofCreatePrompt 如果是真值，当用户在文件编辑框中输入一不存在的文件名，
并选择OK按钮，则会出现消息框， 提示用户此文件不存在并
询问是否以此文件名创建一新文件。
ofExiengronDifferent 如果是真值，从对话框中返回的文件扩展名将不同于缺省扩展名。
其值存入DefaultExt属性中。
ofFileMustExist 如果是真值， 当用户在文件编辑框中输入一个不存在的文件名时，
并选择OK按钮， 则会出现一消息框提示用户此文件不存，并询
问是否输入了正确的路径和文件名。
ofNoChangeDir 如果是真值，当前目录将设置成对话框第一次出现的目录，并忽
略任何目录改变。
ofOverWritePrompt 如果是真值，当用户试图保存一个已存在的文件时， 将出现一消息
框，提示用户此文件已存在，并询问是否覆盖。
ofPathMastExit 如果是真值，用户在文件名编辑框只能输入有效路径名， 否则出
现消息框，提示用户路径无效。
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
表4.4 打开、保存对话框中的Options属性取值及含义
文件保存对话框与打开对话框类似，如图4.11。它的Option属性见上表。例程在保存文件前先对文件进行读写判断，如果文件是只读文件或未指定文件名的新文件， 则程序对文件不保存，否则备份文件。代码如下:
procedure TEditForm.Save1Click(Sender: TObject);
procedure CreateBackup(const Filename: string);
var
BackupFilename: string;
begin
BackupFilename := ChangeFileExt(Filename, BackupExt);
DeleteFile(BackupFilename);
RenameFile(Filename, BackupFilename);
end;
function IsReadOnly(const Filename: string): Boolean;
begin
Result := Boolean(FileGetAttr(Filename) and faReadOnly);
if Result then MessageDlg(Format('%s is read only.',
[ExtractFilename(Filename)]), mtWarning, [mbOK], 0);
end;
begin
if (Filename = '') or IsReadOnly(Filename) then
SaveAs1Click(Sender)
else
begin
CreateBackup(Filename);
Memo1.Lines.SaveToFile(Filename);
Memo1.Modified := False;
end;
end;
其中CreateBackup过程用以改变需备份文件的扩展名。IsReadOnly 用以判断文件属性。
4.5 文件打印
在Delphi中，文件打印有两种方式：
1. 将文件变量分配给打印机，用此变量名创建或打开文件后， 往此文件变量写入的任何文本都视为向打印机输出，以下过程可实现文件的打印。
procedure TEditForm,Print1Click(Sender: TObject);
var
Line: Integer;
PrintText: System.Text;
begin
if PrintDialog1.Execute then
begin
AssignPrn(PrintText)
Rewrite(PrintText);
Print.CanvasFont := Memo1.Font;
For Line := 0 to Memo1.Lines.Count - 1 do
Writeln(PrintText,Memo1.Line[line];
System.Close(PrintText);
end;
end;
2. 利用Printers单元中定义的TPrinter对象进行文件打印，本章例程采用这种方法打印文件。
4.5.1 TPrinter对象
TPrinter对象可调用Windows的打印机，在Printer 单元中定义了TPrinter 的实例Printer，用户可直接使用。
调用TPrinter的BeginDoc方法可开始一项打印工作，调用EndDoc 方法可结束一项已成功发送给打印机的工作。如果在发送过程中出现问题或用户想中途终止打印工作，可调用Abort方法。
通过检查Printing属性可测试当前是否有打印工作，如果打印工作被终止，Abort属性为真。
Canvas属性代表打印表面，Brush,Font,Pen属性可决定打印字体或图像的特征。
Printers属性中包含着已安装的打印机列表，PrinterIndex 属性是当前选择的打印
机，Fonts属性中有当前打印机支持的字体。Orientertion属性可决定打印方向。
PageHeight,PageWith中包含着当前的高度和宽度。PageNanber为当前页的值。
设置Title属性可决定在Windows打印管理器或网络中出现的文本。
4.5.2 TPrintDialog打印对话框
TPrintDialog部件显示一打印对话框。用户在对话框中，可以选择打印机、打印页数、打印份数。当用户选择对话框中的Setup按钮，则出现打印设置对话框。
调用Execute方法显示打印对话框。如图4.12。使用Option属性可设置打印对话框显示的形式。Options的设置如表4.5所示。
PrintRange属性可定义打印的范围。如果PrintPage的值是prPageNums，则可以设置FromPage和ToPage属性来确定打印范围。设置MinPage,MaxPage属性可限制用户的打印范围。
表4.5 打印对话框的Option属性的取值及含义
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
取值 含义
──────────────────────────────────────
PoHelp 如果是真值，对话框出现帮助按钮。
PoPageNums 如果是真值，页数按钮有效，用户可以设置打印范围。
PoPrintToFile 如果是真值，文件打印检查框将出现在对话框中，用户可以选
择文件打印。
PoSelection 如果是真值，选择按钮有效， 用户可打印文件中所选择的文本。
PoWarning 如果是真值，在打印机尚未安装时，用户选择OK 按按钮将出
现警告信息。
PoDisablePrinttoToFile 如果是真值，而PoPrintToFile亦是真值时，当对话框出现时，文
件打印对话框将无效。
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
本章例程是利用Printer的画布进行文本打印的。用户选择打印菜单后，将弹出打印对话框，用户可设置各种参数。当用户选择打印按钮后，打印工作进行发送，此时将弹出打印取消对话框，见图4.13， 用户可中止打印工作。有关打印和打印取消的代码如下：
procedure TEditForm.Print1Click(Sender: TObject);
var
DistanceLine,Line: Integer;
PrintText: System.Text;
begin
if PrintDialog1.Execute then
begin
Printer.Canvas.font := Memo1.Font;
DistanceLine := Trunc(1.5*FontDialog1.font.size);
OpenPrintCancelDialog;
Printer.BeginDoc;
for line := 0 to Memo1.Lines.Count - 1 do
begin
Printer.canvas.textout(0,DistanceLine*Line,Memo1.lines[Line]);
end;
Printer.EndDoc;
BtnBottomDlg.free;
end;
end;
procedure TEditForm.OpenPrintCancelDialog;
begin
BtnBottomDlg := TBtnBottomDlg.Create(Application);
BtnBottomDlg.show;
BtnBottomDlg.canvas.Brush.Color := clActiveBorder;
BtnBottomDlg.canvas.TextOut(50,20,'Print'+FileName);
BtnBottomDlg.canvas.TextOut(30,40,'if you want to
stop, please choice Cancel Button.');
end;
