对不起,上周五由于忙着结贴,忘了给你分,现在给你补上。
再次感谢~hujinger(克沙) 、Linux2001(恋人不如自恋) 、weizi2000(秋风啊) 等几位朋友提的建意。另外求Delphi8的注册码~~~~谢谢~~~~~众里寻她千百度, 慕然回首,那人却在灯火阑珊处。
在学习的同时,才发现在《Delphi5开发人员指南》中就有进度条的实例。
在此贴出,与大家共享。
unit MainFrm;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ComCtrls, Gauges;type
TMainForm = class(TForm)
prbCopy: TProgressBar;
btnCopy: TButton;
procedure btnCopyClick(Sender: TObject);
end;var
MainForm: TMainForm;implementation{$R *.DFM}procedure TMainForm.btnCopyClick(Sender: TObject);
var
SrcFile, DestFile: File;
BytesRead, BytesWritten, TotalRead: Integer;
Buffer: array[1..500] of byte;
FSize: Integer;
begin
{ Assign both the source and destination files to their
respective file variables }
AssignFile(SrcFile, 'srcfile.tst');
AssignFile(DestFile, 'destfile.tst');
// Open the source file for read access.
Reset(SrcFile, 1);
try
// Open destination file for write access.
Rewrite(DestFile, 1);
try
{ Encapsulate this into a try..except so that we can erase the file if
an error occurs. }
try
// Initialize total bytes read to zero.
TotalRead := 0;
// Obtain the filesize of the source file
FSize := FileSize(SrcFile);
{ Read SizeOf(Buffer) bytes from the source file
and add these bytes to the destination file. Repeat this
process until all bytes have been read from the source
file. A progress bar is provided to show the progress of the
copy operation. }
repeat
BlockRead(SrcFile, Buffer, SizeOf(Buffer), BytesRead);
if BytesRead > 0 then
begin
BlockWrite(DestFile, Buffer, BytesRead, BytesWritten);
if BytesRead <> BytesWritten then
raise Exception.Create('Error copying file')
else begin
TotalRead := TotalRead + BytesRead;
prbCopy.Position := Trunc(TotalRead / Fsize) * 100;
prbCopy.Update;
end;
end
until BytesRead = 0;
except
{ On an exception, erase the destination file as it may be
corrupt. Then re-raise the exception. }
Erase(DestFile);
raise;
end;
finally
CloseFile(DestFile); // Close the destination file.
end;
finally
CloseFile(SrcFile); // Close the source file.
end;
end;end.
再次感谢~hujinger(克沙) 、Linux2001(恋人不如自恋) 、weizi2000(秋风啊) 等几位朋友提的建意。另外求Delphi8的注册码~~~~谢谢~~~~~众里寻她千百度, 慕然回首,那人却在灯火阑珊处。
在学习的同时,才发现在《Delphi5开发人员指南》中就有进度条的实例。
在此贴出,与大家共享。
unit MainFrm;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ComCtrls, Gauges;type
TMainForm = class(TForm)
prbCopy: TProgressBar;
btnCopy: TButton;
procedure btnCopyClick(Sender: TObject);
end;var
MainForm: TMainForm;implementation{$R *.DFM}procedure TMainForm.btnCopyClick(Sender: TObject);
var
SrcFile, DestFile: File;
BytesRead, BytesWritten, TotalRead: Integer;
Buffer: array[1..500] of byte;
FSize: Integer;
begin
{ Assign both the source and destination files to their
respective file variables }
AssignFile(SrcFile, 'srcfile.tst');
AssignFile(DestFile, 'destfile.tst');
// Open the source file for read access.
Reset(SrcFile, 1);
try
// Open destination file for write access.
Rewrite(DestFile, 1);
try
{ Encapsulate this into a try..except so that we can erase the file if
an error occurs. }
try
// Initialize total bytes read to zero.
TotalRead := 0;
// Obtain the filesize of the source file
FSize := FileSize(SrcFile);
{ Read SizeOf(Buffer) bytes from the source file
and add these bytes to the destination file. Repeat this
process until all bytes have been read from the source
file. A progress bar is provided to show the progress of the
copy operation. }
repeat
BlockRead(SrcFile, Buffer, SizeOf(Buffer), BytesRead);
if BytesRead > 0 then
begin
BlockWrite(DestFile, Buffer, BytesRead, BytesWritten);
if BytesRead <> BytesWritten then
raise Exception.Create('Error copying file')
else begin
TotalRead := TotalRead + BytesRead;
prbCopy.Position := Trunc(TotalRead / Fsize) * 100;
prbCopy.Update;
end;
end
until BytesRead = 0;
except
{ On an exception, erase the destination file as it may be
corrupt. Then re-raise the exception. }
Erase(DestFile);
raise;
end;
finally
CloseFile(DestFile); // Close the destination file.
end;
finally
CloseFile(SrcFile); // Close the source file.
end;
end;end.
我在这帮你找的,你自己看看。
http://expert.csdn.net/Expert/topic/2888/2888994.xml?temp=.4209253DPTYR-4NKF73-EW9E7H-J83M
2XV-RVG