後一頁
前一頁
回目錄
回首頁
第四章 文本編輯器的設計(二)

4.4.2找到對話方塊部件 

  找到對話方塊部件為應用程式提供找到對話方塊, 用戶可使用找到對話方塊在文本文件中找到字元串。

  可用Execult方法顯示找到對話方塊,如圖4.8。應用程式要找到的字元放到FindText屬性中。Options 屬性可決定找到對話方塊中有哪些選項。例如, 用戶可選擇是否顯示匹配檢查框。Options的常用選項如表4.2所示。

如果用戶在對話方塊中輸入字元並選擇FindNext按鈕,對話方塊將發生OnFind事件。 

4.2 找到對話方塊的Options屬性的取值及含義

──────────────────────────────────────

取值           含義

———————————————————————————————————————

frDown 如果是真值,對話方塊中出現Down按鈕,找到方向向下。如果是假

值,Up按鈕將被選中,找到方向向上,frDown 值可在設計或執行

時設定。

frDisableUpDown 如果是真值,UpDown按鈕將變灰,用戶不能進行選取;如果是

假值,用戶可以選擇其中之一。

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,用戶可直接使用。

  呼叫TPrinterBeginDoc方法可開始一項列印工作,呼叫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,則可以設定FromPageToPage屬性來確定列印範圍。設定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;

 


後一頁
前一頁
回目錄
回首頁