|
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; |