testmain.pas

这是一个间歇的小唾弃,希望大家希望,以后大家多学习,多多交流共同进步!

unit TestMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, FileCtrl, StdCtrls,ShellAPI;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    popCopyFile: TMenuItem;
    popDeleteFile: TMenuItem;
    N2: TMenuItem;
    popReNameFile: TMenuItem;
    popAttributeFile: TMenuItem;
    CopyF: TMenuItem;
    DeleteF: TMenuItem;
    N3: TMenuItem;
    ReNameF: TMenuItem;
    AttributeF: TMenuItem;
    DriveComboBox: TDriveComboBox;
    DirectoryListBox: TDirectoryListBox;
    FileListBox: TFileListBox;
    lbInfo: TLabel;
    Label1: TLabel;
    procedure DriveComboBoxChange(Sender: TObject);
    procedure DirectoryListBoxChange(Sender: TObject);
    procedure ReNameFClick(Sender: TObject);
    procedure AttributeFClick(Sender: TObject);
    procedure DeleteFClick(Sender: TObject);
    procedure FileListBoxChange(Sender: TObject);
    procedure FileListBoxDblClick(Sender: TObject);
    procedure CopyFClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses Attribute, ReName;

{$R *.DFM}

procedure TfrmMain.DriveComboBoxChange(Sender: TObject);
begin
     DirectoryListBox.Drive  :=self.DriveComboBox.Drive  ; //目录列表框随着驱动列表框改变而改变
     
end;

procedure TfrmMain.DirectoryListBoxChange(Sender: TObject);
begin
    FileListBox.Directory :=self.DirectoryListBox.Directory ;//文件列表框随着目录列表框改变而改变
end;

procedure TfrmMain.ReNameFClick(Sender: TObject);
begin
//手动创建窗体
   frmReName:=TfrmReName.Create (application);
   try
      frmReName.ShowModal ;
   finally
      frmReName.Free ;
      frmReName:=nil;
   end;
end;

procedure TfrmMain.AttributeFClick(Sender: TObject);
begin
     frmAttibute.ShowModal ;
end;

procedure TfrmMain.DeleteFClick(Sender: TObject);
begin
    if Application.MessageBox ('确实要删除吗？',' 系统提示',MB_YESNO)=IDYES then
    begin
         if DeleteFile(FileListBox.FileName)=False then //如果删除不成功
            Showmessage('删除失败！'+#13+#10+'你是否选择了文件？')
         else
            FileListBox.Update ;//文件列表框更新
    end;
end;

procedure TfrmMain.FileListBoxChange(Sender: TObject);
begin
     lbInfo.Caption :=FileListBox.FileName ;
end;

procedure TfrmMain.FileListBoxDblClick(Sender: TObject);
begin
     ShellExecute(0,'open',Pchar(lbInfo.Caption ),nil,nil,1);
     //双击文件列表框时，打开或运行文件，此时调用了Win32 API函数
    // showmessage('open');
end;

procedure TfrmMain.CopyFClick(Sender: TObject);
var
   dir:string;
   FromF,ToF:file;
   numRead,numWritten:Integer;
   Buf:Array[1..8096]of char;  //定义一个缓存区
begin
   SelectDirectory('请选择一个文件要复制的文件夹','',dir);
   //调用win32 API函数 弹出"选择路径"对话框  
   AssignFile(FromF,lbInfo.Caption );
   Reset(FromF,1);
   AssignFile(ToF,dir+'\'+ExtractFileName(lbInfo.Caption));
   ReWrite(ToF,1);
   Repeat  //执行复制文件，直到文件复制完成
      BlockRead(FromF,Buf,Sizeof(Buf),NumRead);
      BlockWrite(ToF,Buf,Sizeof(Buf),NumWritten);
   until (numRead=0) or (numWritten<>numRead);
   Closefile(FromF);
   Closefile(Tof);
end;

end.