其中用到的自定義私有過程ConfirmChange用於執行相應的動作:
procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: String);
begin
if MessageDlg(Format('%s %s to %s', [ACaption, FromFile, ToFile]),
mtConfirmation, [mbYes, mbNo], 0) = idYes then
begin
if ACaption = 'Move' then
MoveFile(FromFile, ToFile)
else if ACaption = 'Copy' then
CopyFile(FromFile, ToFile)
else if ACaption = 'Rename' then
RenameFile(FromFile, ToFile)
else if ACaption = 'Change Directory' then
changeDirectory(ToFile);
FileList.Update;
end;
end;
6.4.5.4 顯示文件屬性
當程序執行PropertIEs 菜單項的Click 事件處理過程時,首先彈出一個TFileAttrForm類型的對話框,顯示文件的屬性
當用戶修改並確認後程序重新設置文件屬性。
PropertIEs菜單項的Click事件處理過程如下:
procedure TFMForm.PropertIEs1Click(Sender: TObject);
var
Attributes, NewAttributes: Word;
FileAttrForm: TFileAttrForm;
begin
FileAttrForm := TFileAttrForm.Create(self);
ShowFileAttr(FileAttrForm,FileList.FileName,FileList.Directory);
end;
其中過程ShowFileAttr的實現如下:
procedure TFMForm.ShowFileAttr(FileAttrForm:TFileAttrForm;
AFileName,Directory:String);
var
Attributes,NewAttributes: Word;
begin
with FileAttrForm do
begin
FileName.Caption := AFileName;
FilePath.Caption := Directory;
ChangeDate.Caption := DateTimeToStr(FileDateTime(AFileName));
Attributes := FileGetAttr(AFileName);
ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;
Archive.Checked := (Attributes and faArchive) = faArchive;
System.Checked := (Attributes and faSysFile) = faSysFile;
Hidden.Checked := (Attributes and faHidden) = faHidden;
if ShowModal <> idCancel then
begin
NewAttributes := Attributes;
if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly
else NewAttributes := NewAttributes and not faReadOnly;
if Archive.Checked then NewAttributes := NewAttributes or faArchive
else NewAttributes := NewAttributes and not faArchive;
if System.Checked then NewAttributes := NewAttributes or faSysFile
else NewAttributes := NewAttributes and not faSysFile;
if Hidden.Checked then NewAttributes := NewAttributes or faHidden
else NewAttributes := NewAttributes and not faHidden;
if NewAttributes <> Attributes then
FileSetAttr(AFileName, NewAttributes);
end;
end;
end;
以上過程中用到的函數FileDataTime在fmxutils單元中定義,返回一個TDatatime類型的變量。
function FileDateTime(const FileName: String): System.TDateTime;
begin
Result := FileDateToDateTime(FileAge(FileName));
end;
6.4.6 其它文件管理功能的實現
在子窗口的Function菜單中,定義了一些其它的文件管理功能:
● Search :查找一個給定名字的文件,若存在則顯示該文件屬性
● Disk VIEw :顯示當前驅動器的大小和剩余空間
● VIEw type :確定顯示文件的類型
6.4.6.1 文件查找
當用戶單擊Search菜單項時,程序彈出一個對話框(如圖6.10),要求輸入待查找的文件名和查找路徑。文件名可以是通配符。當用戶確認後程序顯示第一個匹配文件的屬性(如圖6.9)。查找不到匹配文件則給出相應的信息。
在實現這一功能的最初設計中,我試圖使用FileSearch函數,這個函數允許在多個不同路徑中查找。但可惜的是:也許由於系統設計者的失誤,這個函數並沒有返回它應該返回的東西(第一個匹配文件的全路徑名),而是仍把輸入的匹配符返回。
沒有辦法我只能再次使用FindFirst,這個函數的特性在6.3節中已進行了介紹。下面是這一功能的實現代碼。
procedure TFMForm.search1Click(Sender: TObject);
var
SearchForm: TSearchForm;
FileAttrForm: TFileAttrForm;
FindIt,path: String;
SearchRec: TSearchRec;
Return: Integer;
begin
SearchForm := TSearchForm.Create(self);
with SearchForm do
begin
SearchFile.text := '';
SearchPath.text := DirectoryOutline.Directory;
if (ShowModal <> idCancel) and
(SearchFile.Text <> '') and (SearchPath.text <> '') then
begin
FindIt := SearchPath.text+'\'+SearchFile.text;
Return := FindFirst(FindIt,faAnyFile,SearchRec);
if Return <> 0 then
FindIt := ''
else
FindIt := ExpandFileName(SearchRec.Name);
end;
if FindIt = '' then
MessageDlg('Cannot find the file in current directory.',
mtWarning, [mbOk], 0)
else
begin
Path := ExtractFilePath(FindIt);
FindIt := ExtractFileName(FindIt);
FileAttrForm := TFileAttrForm.Create(self);
ShowFileAttr(FileAttrForm,FindIt,Path);
end;
end;
end;
6.4.6.2 顯示磁盤信息
當用戶單擊Disk View菜單項時,將彈出一個TDiskVIEwForm類型的對話框,用來顯示當前磁盤的信息
磁盤信息的獲取是在DiskVIEwForm中DriveEdit編輯框的OnChange事件處理過程中實現的。
procedure TDiskVIEwForm.driveEditChange(Sender: TObject);
var
dr: Byte;
Free,Total: LongInt;
begin
Free := DiskFree(0);
Total := DiskSize(0);
FreeSpace.text := IntToStr(Free)+ ' bytes.';
TotalSpace.text := IntToStr(Total) + ' bytes.';
end;
DiskFree、DiskSize帶參數為0表示當前驅動器。讀者可以很容易把它改成按用戶輸入顯示磁盤信息的情況。
DiskVIEwForm中的三個編輯框設計時都令ReadOnly為True。
6.4.6.3 改變顯示文件的類型
改變顯示文件的類型事實上是設置FileList的Mask屬性。我們利用一個標准的InputBox輸入文件的匹配字符串。而後利用Update方法更新FileList。
procedure TFMForm.VIEwtype1Click(Sender: TObject);
var
FileMask: String;
begin
FileMask := InputBox('File type','Input File type For VIEw :',FileList.Mask);
If FileMask = '' then FileMask := '*.*';
FileList.Mask := FileMask;
FileList.Update;
CreateCaption;
end;
其中的CreateCaption私有過程將在(6.4.8)中進行介紹。
6.4.7 目錄管理功能的實現
在子窗口的Directory菜單中,提供了目錄管理功能:
● Create Directory :創建一個子目錄
● Delete Directory :刪除一個空的子目錄
● Change Directory :改變當前目錄
6.4.7.1 創建目錄
創建目錄時首先彈出一個TNewDir類型的對話框
對話框中要求用戶輸入目錄名。如果用戶不輸入路徑,則缺省認定為當前目錄的子目錄:
Dir := ExpandFileName(DirName.Text);
而後調用MkDir函數。在目錄創建過程中關閉了I/O錯誤檢測,出錯不產生異常而是把IOResult設置為非零值。通過檢查IOResult是否為0可以確定創建是否成功。
程序清單如下:
procedure TFMForm.CreateDirectory1Click(Sender: TObject);
var
NewDir: TNewDir;
Dir: String;
begin
{$I-}
NewDir := TNewDir.Create(self);
with NewDir do
begin
CurrentDir.Caption := DirectoryOutline.Directory;
if (ShowModal <> idCancel) and (DirName.Text <> '') then
Dir := ExpandFileName(DirName.text);
end;
MkDir(Dir);
if IOResult <> 0 then
MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0);
end;
但不幸的是目錄創建後我們卻無法從當前目錄樹中看到。必須移到另一個驅動器而後再返回,創建的目錄才是可見的。在後邊我們將提供一種解決方法。
6.4.7.2 刪除目錄
在實現目錄刪除過程中,遠不如創建目錄那麼順利。碰到的問題是:
1.RmDir不允許刪除當前目錄。但為了操作方便,我們要求刪除的恰恰是當前目錄;
2.目錄刪除後調用Refresh方法或Update方法並不能使該目錄從屏幕顯示中去除。因而當用戶試圖進入該目錄時會導致系統崩潰。
對第一個問題,我們的解決辦法是把當前目錄轉換到其父目錄。假如讀者記得目錄也被操作系統作為一種特殊的文件對待的話,那麼就不會對下面的語句感到奇怪了:
path := DirectoryOutline.Directory;
Directoryoutlin.Directory := ExpandFilePath(Path);
而後調用RmDir過程:
RmDir(Path);
第二個問題的解決卻頗為費神。因為DirectoryOutline是Delphi提供的示例部件,沒有Help文件支持。通過試驗發現:只有當DirectoryOutline的Drive屬性改變時,才重新從相應驅動器讀取目錄。而且它基本上是只讀的,除非清除( Clear) 它,象Add、Delete這些方法對它都是無效的。
我曾經考慮過一個笨拙的方法,那就是先改變當前驅動器而後再改回來。但這種方法一方面速度無法忍受,另一方面當只存在一個驅動器可用時會導致系統崩潰。
正當我一籌莫展時,突然想到:DirectoryOutline是一個Sample部件,Delphi 提供了它的源代碼。而當我分析了它的源代碼後,我知道應該做什麼了,那就是為DirectoryOutline增添一個Reset方法!
6.7.3 為部件增添一個方法
嚴格地說,我們所做的工作屬於創建一個新部件。但因為我們有源代碼,所以不必從DirectoryOutline繼承而是直接修改它。這樣我們可以省去與創建部件有關的許多繁瑣工作。對創建新部件感興趣的讀者可閱讀本書第三編的有關章節。
在Delphi IDE中打開DirectoryOutline的源文件後:
1.把庫單元名改為DirPlus,類名改為TDirectoryOutlinePlus,表明這是DirectoryOutline的增強版。而後存入另一個目錄中;
2.添加一個公有方法Reset。這一方法的作用是重新讀取當前驅動器的目錄。程序清單如下。
procedure TDirectoryOutlinePlus.Reset;
begin
ChDir(FDrive + ':');
GetDir(0, FDirectory);
FDirectory := ForceCase(FDirectory);
if not (csLoading in ComponentState) then BuildTree;
end;
讀者也許被這段代碼弄糊塗了。由於篇幅所限,而且涉及到許多自定義部件開發的內容,我們也不准備去詳細解釋它。假如讀者想徹底搞懂它,我建議先看一下本書第三編有關自定義部件開發的內容,而後再對照原DirectoryOutline的源代碼進行分析。
3.編譯成一個庫文件DirPlus.tpu;
4.把DirPlus加入部件的Samples頁中。
如何添加一個部件見第三編有關章節的介紹。
當增強的目錄樹准備好以後,必須修改我們的子窗口設計,但卻不必親自修改源代碼。
1.刪除子窗口中的TDirectoryOutline類部件DirectoryOutline。此時FileList占據了整個客戶區;
2.把FileList的Align屬改為None,並留出左邊的空白供放部件用;
3.在窗口左部加入TDirectoryOutlinPlus類的部件DirectoryOutline;
4.把DirectoryOutline的Align屬性改為Left,FileList的Align屬性還原為ClIEnt;
5.在DirectoryOutline的事件OnChange列表中選取DirectoryOutlineChange,即原DirectoryOutline的處理過程。
以上工作的最終目標是實現目錄創建、刪除後屏幕的正確顯示。這只需要調用DirectoryOutline的Reset方法即可。
目錄刪除過程的實現代碼如下。
procedure TFMForm.DeleteDirectory1Click(Sender: TObject);
var
path: String;
k: Integer;
begin
{$I-}
path := DirectoryOutline.Directory;
DirectoryOutline.Directory := ExtractFilePath(Path);
if MessageDlg('Delete ' + path + '?', mtConfirmation,[mbYes, mbNo], 0) = idYes then
RmDir(path);
if IOResult <> 0 then
MessageDlg(' Cannot remove directory! The path might not'+
'exist,non-empty or is the current logged directory.',mtWarning,[mbOk], 0)
else
DirectoryOutline.Reset;
end;
修改後的目錄創建過程如下。
procedure TFMForm.CreateDirectory1Click(Sender: TObject);
var
NewDir: TNewDir;
Dir: String;
begin
{$I-}
NewDir := TNewDir.Create(self);
with NewDir do
begin
CurrentDir.Caption := DirectoryOutline.Directory;
if (ShowModal <> idCancel) and (DirName.Text <> '') then
Dir := ExpandFileName(DirName.text);
end;
MkDir(Dir);
if IOResult <> 0 then
MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0)
else
DirectoryOutline.Reset;
end;
當完成了這些工作,把程序重新編譯、運行後,可以發現我們所希望實現的功能完全實現了!同時,我們有了一個更好的目錄樹部件。
6.4.7.4 改變當前目錄
改變當前目錄的實現非常簡單,只要修改DirectoryOutline的Directory屬性。但需注意的是:當改變後目錄所在驅動器也發生變化時應相應修改DriveTabSet的當前值。由於驅動器名與DriveTabSet的索引屬性TabIndex之間並沒有確定的對應關系,因而需要通過一個循環進行查找匹配。
Change Directory的菜單事件處理過程是FileChange,即與文件的移動、拷貝、更名共用一個事件處理過程。詳細情況請讀者參看(6.4.5.3)中的介紹。
改變當前目錄的實現如下。
procedure TFMForm.ChangeDirectory(Todir: String);
var
i: Integer;
begin
{$I-}
ChDir(ToDir);
if IOResult <> 0 then
MessageDlg('Cannot find directory', mtWarning, [mbOk], 0)
else
begin
with DirectoryOutline do
begin
Directory := ToDir;
Refresh;
if DriveTabSet.Tabs[DriveTabSet.TabIndex][1]<>drive then
for I := 1 to 25 do
if DriveTabSet.Tabs[i][1] = drive then
begin
DriveTabSet.TabIndex := i;
Exit;
end;
end;
end;
end;
6.4.8 一些問題的處理
6.4.8.1 子窗口的標題
Windows的文件管理器是我們設計的楷模,在子窗口顯示標題上也不例外。我們把當前目錄加上文件的類型作為子窗口的標題。
過程CreateCaption用於生成子窗口的標題。
procedure TFMForm.CreateCaption;
var
Cap: String;
begin
Cap := DirectoryOutline.Directory;
Cap := cap+'\'+FileList.mask;
Caption := Cap;
end;
當前目錄或文件顯示類型發生變化時改變子窗口的標題。如DirectoryOutline的Change事件處理過程和VIEwType菜單項的Click事件處理過程就調用了該過程。
6.4.8.2 狀態條的顯示
狀態條用於顯示當前目錄和當前選中文件。它們的值在DirectoryOutline 和FileList的Change事件處理過程中修改。
DirectoryOutline和FileList最終的Change事件處理過程如下:
procedure TFMForm.DirectoryOutlineChange(Sender: TObject);
begin
CreateCaption;
FileList.clear;
FileList.Directory := DirectoryOutline.Directory;
FileList.Update;
FileManager.DirectoryPanel.Caption := DirectoryOutline.Directory;
end;
procedure TFMForm.FileListChange(Sender: TObject);
begin
with FileList do
begin
if (ItemIndex >= 0) and (Not HasAttr(FileName,faDirectory)) then
begin
TheFileName := FileName;
FileManager.FilePanel.Caption :=
Format('%s, %d bytes', [TheFileName, GetFileSize(TheFileName)]);
end
else
FileManager.FilePanel.Caption := '';
end;
end;
6.4.8.3 版本信息
當用戶單擊主窗口的Help|About菜單項時將彈出一個About對話框,用於顯示版本信息(如圖6.13)。
這一對話框是用Delphi提供的模板做的。
6.4.8.4 菜單項的變灰與使能
File菜單中定義的文件管理功能只有當活動焦點在FileList(即有當前選中文件)時才起作用。否則所有菜單項應變灰,以免導致系統崩潰。
這一功能在File菜單的Click事件處理過程中實現。這一點並不很容易被人想到,希望讀者能從中受到啟發。
procedure TFMForm.File1Click(Sender: TObject);
var
FileSelected: Boolean;
begin
FileSelected := FileList.ItemIndex >= 0;
Open1.Enabled := FileSelected;
Delete1.Enabled := FileSelected;
Copy1.Enabled := FileSelected;
Move1.Enabled := FileSelected;
Rename1.Enabled := FileSelected;
PropertIEs1.Enabled := FileSelected;
end;
判斷是否有文件被選中是通過檢測ItemIndex屬性是否大於等於0來實現的。
FileSelected := FileList.ItemIndex >= 0;
6.4.8.5 可重用的文件處理模塊
庫單元fmxutils是一個代碼庫,提供了若干文件處理模塊。這些模塊除在本程序中使用外,讀者可以在其它應用程序中直接調用,而且不必重新編譯,只要在Uses子句中包含即可。從中我們可以體會到,Delphi 以庫單元為中心的程序組織方式提供了一種較完善的代碼重用機制。
6.4.9 小結
文件管理器是一個較為綜合的例程,使用到了絕大部分以文件名、文件句柄以及其它參數(除文件變量)為操作對象的文件管理過程/函數,同時也提供了一些程序設計開發的思想。我們的介紹是以程序功能模塊來組織的,我建議讀者在學習並試圖自己建立這一程序時采用同樣的方法。(6.4.8)中的內容或許是一開始就應了解的,但其它完全可以按順序逐步地擴充,最後得到一個完整的程序。這一例程在後邊的拖放操作和異常處理等章節中還要用到。讀者可以以此為基礎進一步完善它,使它真正成為一個完全實用的程序。
文件管理是在開發一個高級的Windows程序中不可避免的要涉及到的問題。本章介紹的思路和方法將為讀者成為一個熟練的程序員奠定基礎。