018.htm

delphi教程

<p>end;</p>
<p>if (ShowModal &lt;&gt; idCancel) and (ToFileName.Text &lt;&gt; '') then</p>
<p>ConfirmChange(Caption, FromFileName.Text, ToFileName.Text);</p>
<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 &lt;&gt; 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 &lt;&gt; 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">
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 在实现这一功能的最初设计中，我试图使用</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 &lt;&gt; idCancel) and</p>
<p>(SearchFile.Text &lt;&gt; '') and (SearchPath.text &lt;&gt; '') then</p>
<p>begin</p>
<p>FindIt := SearchPath.text+'\'+SearchFile.text;</p>
<p>Return := FindFirst(FindIt,faAnyFile,SearchRec);</p>
<p>if Return &lt;&gt; 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">
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 磁盘信息的获取是在</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 &lt;&gt; idCancel) and (DirName.Text &lt;&gt; '') then</p>
<p>Dir := ExpandFileName(DirName.text);</p>
<p>end;</p>
<p>MkDir(Dir);</p>
<p>if IOResult &lt;&gt; 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>