程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 帶進度條的文件復制的例子

帶進度條的文件復制的例子

編輯:Delphi

以下例子是關於Delphi復制文件,加上進度條的方法的例子的關鍵代碼:

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
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved