画出每个自画项目
这在TabSet的OnDrawTab事件处理过程中完成这一事件处理过程的参数中包含了待画项目索引画板待画区域是否被选中等这里我们只利用了前三个参数事实上利用最后一个参数我们可以对被选中的标签进行一些特殊的视觉效果处理这一工作就留给读者自己去完成
procedure TFMFormDriveTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean)
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(DriveTabSetTabsObjects[Index])
with TabCanvas do
begin
Draw(RLeft RTop + Bitmap)
TextOut(RLeft + + BitmapWidth RTop + DriveTabSetTabs[Index])
end;
end;
文件管理基本功能的实现
在子窗口的File菜单中定义了文件管理的基本功能它们是
● Open :打开或运行一个文件(从文件列表框双击该文件可实现同样效果)
● Move :文件在不同目录间的移动
● Copy :文件拷贝
● Delete :文件删除
● Rename :文件更名
● Properties :显示文件属性
文件打开
文件打开功能可以运行一个可执行文件或把文件在与之相关联的应用程序中打开文件总是与创建它的应用程序相关联这种关联可以在Windows的文件管理器中修改要注意的是文件的关联是以后缀名为标志的因而对一个文件关联方式的修改将影响所有相同后缀名的文件
文件打开功能实现的关键是利用了Windows API函数ShellExecute 由于Windows API函数的参数要求字符串类型是PChar而Delphi中一般用的是有结束标志的String类型因此为调用方便我们把这一函数进行了重新定义如下
function ExecuteFile(const FileName Params DefaultDir: String;
ShowCmd: Integer) THandle;
var
zFileName zParams zDir: array[] of Char;
begin
Result := ShellExecute(ApplicationMainFormHandle nil
StrPCopy(zFileName FileName) StrPCopy(zParams Params)
StrPCopy(zDir DefaultDir) ShowCmd)
end;
以上函数在fmxutils单元中定义fmxutils是一个自定义代码单元
有关ShellExecute中各参数的具体含义读者可查阅联机Help文件
StrPCopy把一个Pascal类型的字符串拷贝到一个无结束符的PChar类型字符串中
在子窗口的OpenClick事件处理过程中
procedure TFMFormOpenClick(Sender: TObject)
begin
with FileList do
ExecuteFile(FileName Directory SW_SHOW) ;
end;
如果FileList允许显示目录的话(即FileType属性再增加一项ftDirectory)那么对于一个目录而言打开的含义应该是显示它下边的子目录和文件程序修改如下
procefure TFMFormOpenClick(Sender: Tobject)
begin
With FileList do
begin
if HasAttr(FileNamefaDirectory) then
DirectoryOutlineDirectory := FileName
else
ExecuteFile(FileName DirectorySW_SHOW)
end;
end;
其中HasAttr是一个fmxutils单元中的自定义函数用于检测指定文件是否具有某种属性
function HasAttr(const FileName: String; Attr: Word) Boolean;
begin
Result := (FileGetAttr(FileName) and Attr) = Attr;
end;
文件拷贝移动删除更名
文件拷贝的关键是使用了以文件句柄为操作对象的文件管理函数因而提供了一种底层的I/O通道在Object Pascal中这一点是利用无类型文件实现的
在文件拷贝中首先检查目标文件名是否是一个目录如是则把原文件的文件名添加到目标路径后生成目标文件全路径名而后提取源文件的时间戳以备拷贝完成后设置目标文件拷贝过程中使用了返回文件句柄或以文件句柄为参数的文件管理函数FileOpenFileCreateFileReadFileWriteFileClose为保证文件的正常关闭和内存的释放在拷贝过程中进行异常保护
过程CopyFile实现上述功能它定义在fmxutils单元中
procedure CopyFile(const FileName DestName: TFileName)
var
CopyBuffer: Pointer;
TimeStamp BytesCopied: Longint;
Source Dest: Integer;
Destination: TFileName;
const
ChunkSize: Longint = ;
begin
Destination := ExpandFileName(DestName)
if HasAttr(Destination faDirectory) then
Destination := Destination + \ + ExtractFileName(FileName)
TimeStamp := FileAge(FileName)
GetMem(CopyBuffer ChunkSize)
try
Source := FileOpen(FileName fmShareDenyWrite)
if Source < then
raise EFOpenErrorCreate(FmtLoadStr(SFOpenError [FileName]))
try
Dest := FileCreate(Destination)
if Dest < then
raise EFCreateErrorCreate(FmtLoadStr(SFCreateError[Destination]))
try
repeat
BytesCopied := FileRead(Source CopyBuffer^ ChunkSize)
if BytesCopied > then
FileWrite(Dest CopyBuffer^ BytesCopied)
until BytesCopied < ChunkSize;
finally
FileSetDate(DestTimeStamp)
FileClose(Dest)
end;
finally
FileClose(Source)
end;
finally
FreeMem(CopyBuffer ChunkSize)
end;
end;
如果我们不使用FileSetDate过程Windows自动把当前时间作为时间戳写入文件
文件移动事实上是文件拷贝与文件删除的结合fmxutils单元中的MoveFile过程实现了这一功能
procedure MoveFile(const FileName DestName: TFileName)
var
Destination: TFileName;
begin
Destination := ExpandFileName(DestName)
if not RenameFile(FileName Destination) then
begin
if HasAttr(FileName faReadOnly) then
raise EFCantMoveCreate(Format(SFCantMove [FileName]))
CopyFile(FileName Destination)
DeleteFile(FileName)
end;
end;
EFCanMove是一个自定义异常类
type
EFCanMove := Class(EStreamError)
有关自定义异常类请参阅第十二章
文件删除文件更名直接调用Delphi文件管理过程DeleteFileRenameFile它们都以文件名为参数操作执行前应弹出一个对话框进行确认执行完毕后应调用Update方法更新FileList的显示
[] [] [] []