带进度的文件复制 回复 "冷风无泪" 的问题

问题来源: http://www.cnblogs.com/del/archive/2008/12/02/1066817.html#1389078

---

本例效果图:

---

代码文件:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  getPath = 'c:\temp\get.rar';
  setPath = 'c:\temp\set.rar';
var
  getStream,setStream: TFileStream;
  num, n: Integer;
  buf: PByte;
  BufSize,block: Integer;
begin

  if not FileExists(getPath) then
  begin
    ShowMessage('源文件不存在');
    Exit;
  end;

  getStream := TFileStream.Create(getPath, fmOpenRead or fmShareExclusive);
  setStream := TFileStream.Create(setPath, fmCreate);

  num := getStream.Size;
  setStream.Size := num;
  getStream.Position := 0;
  setStream.Position := 0;

  BufSize := num;
  block := BufSize div 100;
  GetMem(buf, BufSize);

  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
  ProgressBar1.Position := 0;

  while num <> 0 do
  begin
    Application.ProcessMessages;
    n := block;
    if n > num then n := num;
    getStream.ReadBuffer(buf^, n);
    setStream.WriteBuffer(buf^, n);
    ProgressBar1.Position := Trunc((1 - num / BufSize) * 100);
    Dec(num, n);
  end;

  FreeMem(buf, BufSize);
  getStream.Free;
  setStream.Free;

  ShowMessage('复制完毕');
  ProgressBar1.Position := 0;
end;

end.

窗体文件:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 104
  ClientWidth = 265
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 96
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ProgressBar1: TProgressBar
    Left = 8
    Top = 16
    Width = 249
    Height = 17
    TabOrder = 1
  end
end