图例:
程序及源代码下载地址: http://115.com/file/bhioozql
unit uForm_Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls; type TForm_Main = class(TForm) Label1: TLabel; Label2: TLabel; edt_Des: TEdit; //目标目录文本框 LB_Files: TListBox; //文件清单 btn_OK: TButton; btn_Exit: TButton; btn_Des: TButton; //选择目录按钮 btn_Files: TButton; //选择文件按钮 OpenDialog1: TOpenDialog; //用来选择文件用的 lb_ACount: TLabel; //状态显示,显示文件数目 ProgressBar1: TProgressBar; //进度条 lb_: TLabel; //状态显示中的'/' lb_Count: TLabel; //状态显示,显示已经复制了几个文件 procedure btn_FilesClick(Sender: TObject); procedure btn_ExitClick(Sender: TObject); procedure btn_DesClick(Sender: TObject); procedure btn_OKClick(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form_Main: TForm_Main; ds: string; //用来存放目标目录 implementation Uses FileCtrl; //需要用SelectDirectory函数 {$R *.dfm} procedure TForm_Main.btn_DesClick(Sender: TObject); begin selectdirectory('选择你所要粘贴的位置:', '', ds); //弹出目录选择框,并将路径赋值给ds edt_des.Text:= ds; end; procedure TForm_Main.btn_ExitClick(Sender: TObject); begin Close; end; procedure TForm_Main.btn_FilesClick(Sender: TObject); var i: integer; begin if OpenDialog1.Execute then begin LB_Files.Clear; for i := OpenDialog1.Files.Count - 1 downto 0 do begin Application.ProcessMessages; //为了避免假死,给程序接收其他消息和处理其他消息的时间 LB_Files.Items.Add(OpenDialog1.Files[i]); //循环向ListBox添加item // ShowMessage(ExtractFileName(OpenDialog1.Files[i])); end; end; lb_ACount.Caption:= inttostr(OpenDialog1.Files.Count); //将文件总数显示在标签上 end; procedure TForm_Main.btn_OKClick(Sender: TObject); var i: integer; //hthread:thandle; begin ProgressBar1.Max:= OpenDialog1.Files.Count; //进度条最大值就是待复制文件的数量 ProgressBar1.Min:= 0; //最小值及起始值当然为0 ProgressBar1.Position:= 0; ds:= edt_Des.Text; if not directoryExists(ds)then //如果目录不存在,提示错误 MessageBox(handle, '请正确输入目的文件夹! ', '错误', MB_OK+MB_ICONERROR) else if OpenDialog1.Files.Count > 0 then begin for i := 0 to OpenDialog1.Files.Count - 1 do begin Application.ProcessMessages; //为了避免假死,给程序接收其他消息和处理其他消息的时间 CopyFile(PWideChar(OpenDialog1.Files[i]), PWideChar(ds + '\' + ExtractFileName(OpenDialog1.Files[i])), True); //复制,ExtractFileName可提取详细路径中的文件名 ProgressBar1.Position:= i + 1; //每复制一个,进度条和状态显示标签走一步 lb_Count.Caption:= inttostr(i + 1); end; MessageBox(handle,'文件复制完毕!', '提示', MB_OK+MB_ICONINFORMATION); end else MessageBox(handle, '请选择好您要复制的文件后,再试!', '错误', MB_OK+MB_ICONERROR); end; procedure TForm_Main.FormCreate(Sender: TObject); begin lb_Count.Caption:= '0'; lb_ACount.Caption:= '0'; end; end.