?? 018.htm
字號:
<p>end;</p>
<p>end;<font face="宋體" lang="ZH-CN"> </font></p>
<p><font face="宋體" lang="ZH-CN">其中用到的自定義私有過程</font>ConfirmChange<font
face="宋體" lang="ZH-CN">用于執行相應的動作： </p>
</font><p>procedure TFMForm.ConfirmChange(const ACaption, FromFile, ToFile: String);</p>
<p>begin</p>
<p>if MessageDlg(Format('%s %s to %s', [ACaption, FromFile, ToFile]),</p>
<p>mtConfirmation, [mbYes, mbNo], 0) = idYes then</p>
<p>begin</p>
<p>if ACaption = 'Move' then</p>
<p>MoveFile(FromFile, ToFile)</p>
<p>else if ACaption = 'Copy' then</p>
<p>CopyFile(FromFile, ToFile)</p>
<p>else if ACaption = 'Rename' then</p>
<p>RenameFile(FromFile, ToFile)</p>
<p>else if ACaption = 'Change Directory' then</p>
<p>changeDirectory(ToFile);</p>
<p>FileList.Update;</p>
<p>end;</p>
<p>end; </p>
<p>6.4.5.4 <font face="宋體" lang="ZH-CN">顯示文件屬性 </p>
<p> 當程序執行</font>Properties <font face="宋體" lang="ZH-CN">菜單項的</font>Click
<font face="宋體" lang="ZH-CN">事件處理過程時，首先彈出一個</font>TFileAttrForm<font
face="宋體" lang="ZH-CN">類型的對話框，顯示文件的屬性</font></p>
<font face="宋體" lang="ZH-CN"><p>當用戶修改并確認后程序重新設置文件屬性。</p>
<p> </font>Properties<font face="宋體" lang="ZH-CN">菜單項的</font>Click<font
face="宋體" lang="ZH-CN">事件處理過程如下： </p>
</font><p>procedure TFMForm.Properties1Click(Sender: TObject);</p>
<p>var</p>
<p>Attributes, NewAttributes: Word;</p>
<p>FileAttrForm: TFileAttrForm;</p>
<p>begin</p>
<p>FileAttrForm := TFileAttrForm.Create(self);</p>
<p>ShowFileAttr(FileAttrForm,FileList.FileName,FileList.Directory);</p>
<p>end;</p>
<font face="宋體" lang="ZH-CN"><p> 其中過程</font>ShowFileAttr<font
face="宋體" lang="ZH-CN">的實現如下： </p>
</font><p>procedure TFMForm.ShowFileAttr(FileAttrForm:TFileAttrForm;</p>
<p>AFileName,Directory:String);</p>
<p>var</p>
<p>Attributes,NewAttributes: Word;</p>
<p>begin</p>
<p>with FileAttrForm do</p>
<p>begin</p>
<p>FileName.Caption := AFileName;</p>
<p>FilePath.Caption := Directory;</p>
<p>ChangeDate.Caption := DateTimeToStr(FileDateTime(AFileName));</p>
<p>Attributes := FileGetAttr(AFileName);</p>
<p>ReadOnly.Checked := (Attributes and faReadOnly) = faReadOnly;</p>
<p>Archive.Checked := (Attributes and faArchive) = faArchive;</p>
<p>System.Checked := (Attributes and faSysFile) = faSysFile;</p>
<p>Hidden.Checked := (Attributes and faHidden) = faHidden;</p>
<p>if ShowModal <> idCancel then</p>
<p>begin</p>
<p>NewAttributes := Attributes;</p>
<p>if ReadOnly.Checked then NewAttributes := NewAttributes or faReadOnly</p>
<p>else NewAttributes := NewAttributes and not faReadOnly;</p>
<p>if Archive.Checked then NewAttributes := NewAttributes or faArchive</p>
<p>else NewAttributes := NewAttributes and not faArchive;</p>
<p>if System.Checked then NewAttributes := NewAttributes or faSysFile</p>
<p>else NewAttributes := NewAttributes and not faSysFile;</p>
<p>if Hidden.Checked then NewAttributes := NewAttributes or faHidden</p>
<p>else NewAttributes := NewAttributes and not faHidden;</p>
<p>if NewAttributes <> Attributes then</p>
<p>FileSetAttr(AFileName, NewAttributes);</p>
<p>end;</p>
<p>end;</p>
<p>end; </p>
<p><font face="宋體" lang="ZH-CN">以上過程中用到的函數</font>FileDataTime<font
face="宋體" lang="ZH-CN">在</font>fmxutils<font face="宋體" lang="ZH-CN">單元中定義，返回一個</font>TDatatime<font
face="宋體" lang="ZH-CN">類型的變量。 </p>
</font><p>function FileDateTime(const FileName: String): System.TDateTime;</p>
<p>begin</p>
<p>Result := FileDateToDateTime(FileAge(FileName));</p>
<p>end; </p>
<p>6.4.6 <font face="宋體" lang="ZH-CN">其它文件管理功能的實現 </p>
<p> 在子窗口的</font>Function<font face="宋體" lang="ZH-CN">菜單中，定義了一些其它的文件管理功能：</p>
<p> ●</font> Search <font face="宋體" lang="ZH-CN">：查找一個給定名字的文件，若存在則顯示該文件屬性</p>
<p> ●</font> Disk View <font face="宋體" lang="ZH-CN">：顯示當前驅動器的大小和剩余空間</p>
<p> ●</font> View type <font face="宋體" lang="ZH-CN">：確定顯示文件的類型 </p>
</font><p>6.4.6.1 <font face="宋體" lang="ZH-CN">文件查找 </p>
<p> 當用戶單擊</font>Search<font face="宋體" lang="ZH-CN">菜單項時，程序彈出一個對話框</font>(<font
face="宋體" lang="ZH-CN">如圖</font>6.10)<font face="宋體" lang="ZH-CN">，要求輸入待查找的文件名和查找路徑。文件名可以是通配符。當用戶確認后程序顯示第一個匹配文件的屬性</font>(<font
face="宋體" lang="ZH-CN">如圖</font>6.9)<font face="宋體" lang="ZH-CN">。查找不到匹配文件則給出相應的信息。</font></p>
<p><font face="宋體" lang="ZH-CN">
在實現這一功能的最初設計中，我試圖使用</font>FileSearch<font
face="宋體" lang="ZH-CN">函數，這個函數允許在多個不同路徑中查找。但可惜的是：也許由于系統設計者的失誤，這個函數并沒有返回它應該返回的東西</font>(<font
face="宋體" lang="ZH-CN">第一個匹配文件的全路徑名</font>)<font face="宋體"
lang="ZH-CN">，而是仍把輸入的匹配符返回。</p>
<p> 沒有辦法我只能再次使用</font>FindFirst<font face="宋體" lang="ZH-CN">，這個函數的特性在</font>6.3<font
face="宋體" lang="ZH-CN">節中已進行了介紹。下面是這一功能的實現代碼。 </p>
</font><p>procedure TFMForm.search1Click(Sender: TObject);</p>
<p>var</p>
<p>SearchForm: TSearchForm;</p>
<p>FileAttrForm: TFileAttrForm;</p>
<p>FindIt,path: String;</p>
<p>SearchRec: TSearchRec;</p>
<p>Return: Integer;</p>
<p>begin</p>
<p>SearchForm := TSearchForm.Create(self);</p>
<p>with SearchForm do</p>
<p>begin</p>
<p>SearchFile.text := '';</p>
<p>SearchPath.text := DirectoryOutline.Directory;</p>
<p>if (ShowModal <> idCancel) and</p>
<p>(SearchFile.Text <> '') and (SearchPath.text <> '') then</p>
<p>begin</p>
<p>FindIt := SearchPath.text+'\'+SearchFile.text;</p>
<p>Return := FindFirst(FindIt,faAnyFile,SearchRec);</p>
<p>if Return <> 0 then</p>
<p>FindIt := ''</p>
<p>else</p>
<p>FindIt := ExpandFileName(SearchRec.Name);</p>
<p>end;</p>
<p>if FindIt = '' then</p>
<p>MessageDlg('Cannot find the file in current directory.',</p>
<p>mtWarning, [mbOk], 0)</p>
<p>else</p>
<p>begin</p>
<p>Path := ExtractFilePath(FindIt);</p>
<p>FindIt := ExtractFileName(FindIt);</p>
<p>FileAttrForm := TFileAttrForm.Create(self);</p>
<p>ShowFileAttr(FileAttrForm,FindIt,Path);</p>
<p>end;</p>
<p>end;</p>
<p>end;<font face="宋體" lang="ZH-CN"> </font></p>
<p>6.4.6.2 <font face="宋體" lang="ZH-CN">顯示磁盤信息</p>
<p> 當用戶單擊</font>Disk View<font face="宋體" lang="ZH-CN">菜單項時，將彈出一個</font>TDiskViewForm<font
face="宋體" lang="ZH-CN">類型的對話框，用來顯示當前磁盤的信息</font></p>
<p><font face="宋體" lang="ZH-CN">
磁盤信息的獲取是在</font>DiskViewForm<font
face="宋體" lang="ZH-CN">中</font>DriveEdit<font face="宋體" lang="ZH-CN">編輯框的</font>OnChange<font
face="宋體" lang="ZH-CN">事件處理過程中實現的。 </p>
</font><p>procedure TDiskViewForm.driveEditChange(Sender: TObject);</p>
<p>var</p>
<p>dr: Byte;</p>
<p>Free,Total: LongInt;</p>
<p>begin</p>
<p>Free := DiskFree(0);</p>
<p>Total := DiskSize(0);</p>
<p>FreeSpace.text := IntToStr(Free)+ ' bytes.';</p>
<p>TotalSpace.text := IntToStr(Total) + ' bytes.';</p>
<p>end;</p>
<font face="宋體" lang="ZH-CN"><p> </font>DiskFree<font face="宋體" lang="ZH-CN">、</font>DiskSize<font
face="宋體" lang="ZH-CN">帶參數為</font>0<font face="宋體" lang="ZH-CN">表示當前驅動器。讀者可以很容易把它改成按用戶輸入顯示磁盤信息的情況。</p>
<p> </font>DiskViewForm<font face="宋體" lang="ZH-CN">中的三個編輯框設計時都令</font>ReadOnly<font
face="宋體" lang="ZH-CN">為</font>True<font face="宋體" lang="ZH-CN">。 </p>
</font><p>6.4.6.3 <font face="宋體" lang="ZH-CN">改變顯示文件的類型 </p>
<p> 改變顯示文件的類型事實上是設置</font>FileList<font face="宋體"
lang="ZH-CN">的</font>Mask<font face="宋體" lang="ZH-CN">屬性。我們利用一個標準的</font>InputBox<font
face="宋體" lang="ZH-CN">輸入文件的匹配字符串。而后利用</font>Update<font
face="宋體" lang="ZH-CN">方法更新</font>FileList<font face="宋體" lang="ZH-CN">。 </p>
</font><p>procedure TFMForm.Viewtype1Click(Sender: TObject);</p>
<p>var</p>
<p>FileMask: String;</p>
<p>begin</p>
<p>FileMask := InputBox('File type','Input File type For View :',FileList.Mask);</p>
<p>If FileMask = '' then FileMask := '*.*';</p>
<p>FileList.Mask := FileMask;</p>
<p>FileList.Update;</p>
<p>CreateCaption;</p>
<p>end;</p>
<font face="宋體" lang="ZH-CN"><p> 其中的</font>CreateCaption<font face="宋體"
lang="ZH-CN">私有過程將在</font>(6.4.8)<font face="宋體" lang="ZH-CN">中進行介紹。 </p>
</font><p>6.4.7 <font face="宋體" lang="ZH-CN">目錄管理功能的實現 </p>
<p> 在子窗口的</font>Directory<font face="宋體" lang="ZH-CN">菜單中，提供了目錄管理功能：</p>
<p> ●</font> Create Directory <font face="宋體" lang="ZH-CN">：創建一個子目錄</p>
<p> ●</font> Delete Directory <font face="宋體" lang="ZH-CN">：刪除一個空的子目錄</p>
<p> ●</font> Change Directory <font face="宋體" lang="ZH-CN">：改變當前目錄 </p>
</font><p>6.4.7.1 <font face="宋體" lang="ZH-CN">創建目錄 </p>
</font><p><font face="宋體" lang="ZH-CN"> 創建目錄時首先彈出一個TNewDir類型的對話框</font></p>
<font face="宋體" lang="ZH-CN"><p>對話框中要求用戶輸入目錄名。如果用戶不輸入路徑，則缺省認定為當前目錄的子目錄： </p>
<p> </font>Dir := ExpandFileName(DirName.Text)<font face="宋體" lang="ZH-CN">； </p>
<p> 而后調用</font>MkDir<font face="宋體" lang="ZH-CN">函數。在目錄創建過程中關閉了</font>I/O<font
face="宋體" lang="ZH-CN">錯誤檢測，出錯不產生異常而是把</font>IOResult<font
face="宋體" lang="ZH-CN">設置為非零值。通過檢查</font>IOResult<font
face="宋體" lang="ZH-CN">是否為</font>0<font face="宋體" lang="ZH-CN">可以確定創建是否成功。</font></p>
<p><font face="宋體" lang="ZH-CN">程序清單如下： </p>
</font><p>procedure TFMForm.CreateDirectory1Click(Sender: TObject);</p>
<p>var</p>
<p>NewDir: TNewDir;</p>
<p>Dir: String;</p>
<p>begin</p>
<p>{$I-}</p>
<p>NewDir := TNewDir.Create(self);</p>
<p>with NewDir do</p>
<p>begin</p>
<p>CurrentDir.Caption := DirectoryOutline.Directory;</p>
<p>if (ShowModal <> idCancel) and (DirName.Text <> '') then</p>
<p>Dir := ExpandFileName(DirName.text);</p>
<p>end;</p>
<p>MkDir(Dir);</p>
<p>if IOResult <> 0 then</p>
<p>MessageDlg('Cannot Create directory', mtWarning, [mbOk], 0);</p>
<p>end;</p>
<font face="宋體" lang="ZH-CN"><p> 但不幸的是目錄創建后我們卻無法從當前目錄樹中看到。必須移到另一個驅動器而后再返回，創建的目錄才是可見的。在后邊我們將提供一種解決方法。 </p>
</font><p>6.4.7.2 <font face="宋體" lang="ZH-CN">刪除目錄 </p>
<p> 在實現目錄刪除過程中，遠不如創建目錄那么順利。碰到的問題是</font>:</p>
<font face="宋體" lang="ZH-CN"><p> </font>1.RmDir<font face="宋體" lang="ZH-CN">不允許刪除當前目錄。但為了操作方便，我們要求刪除的恰恰是當前目錄；</p>
<p> </font>2.<font face="宋體" lang="ZH-CN">目錄刪除后調用</font>Refresh<font
face="宋體" lang="ZH-CN">方法或</font>Update<font face="宋體" lang="ZH-CN">方法并不能使該目錄從屏幕顯示中去除。因而當用戶試圖進入該目錄時會導致系統崩潰。</p>
<p> 對第一個問題，我們的解決辦法是把當前目錄轉換到其父目錄。假如讀者記得目錄也被操作系統作為一種特殊的文件對待的話，那么就不會對下面的語句感到奇怪了： </p>
<p> </font>path := DirectoryOutline.Directory;</p>
<font face="宋體" lang="ZH-CN"><p> </font>Directoryoutlin.Directory :=
ExpandFilePath(Path);</p>
<font face="宋體" lang="ZH-CN"><p> 而后調用</font>RmDir<font face="宋體"
lang="ZH-CN">過程： </p>
</font><p>RmDir(Path)<font face="宋體" lang="ZH-CN">；</p>
<p> </p>
<p> 第二個問題的解決卻頗為費神。因為</font>DirectoryOutline<font
face="宋體" lang="ZH-CN">是</font>Delphi<font face="宋體" lang="ZH-CN">提供的示例部件，沒有</font>Help<font
face="宋體" lang="ZH-CN">文件支持。通過試驗發現：只有當</font>DirectoryOutline<font
face="宋體" lang="ZH-CN">的</font>Drive<font face="宋體" lang="ZH-CN">屬性改變時，才重新從相應驅動器讀取目錄。而且它基本上是只讀的，除非清除</font>(
Clear) <font face="宋體" lang="ZH-CN">它，象</font>Add<font face="宋體"
lang="ZH-CN">、</font>Delete<font face="宋體" lang="ZH-CN">這些方法對它都是無效的。</p>
<p> 我曾經考慮過一個笨拙的方法，那就是先改變當前驅動器而后再改回來。但這種方法一方面速度無法忍受，另一方面當只存在一個驅動器可用時會導致系統崩潰。</p>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -