Как к FileStream прекрепить ProgressBar?

[McLion]

Всем привет,

подскажите, что делаю не так... ProgressBar не отображает продвижение в копирование.

Код: Выделить всё

procedure TMainForm.Button2Click(Sender: TObject);
var
  S: TFileStream = nil;
  T: TFileStream = nil;
  src, dest: String;
begin
  src := 'D:\film.flv';
  dest := 'D:\filmcopy.flv';

  S := TFileStream.Create(src, fmOpenRead);
  Progressbar3.Min := 0;
  Progressbar3.Max := S.Size;

  try
    Application.ProcessMessages;

    T := TFileStream.Create(dest, fmOpenWrite or fmCreate);
    T.CopyFrom(S, S.Size);

    ProgressBar3.Position := Round((S.Position / S.Size) * 100);
    Application.ProcessMessages;

    {$ifdef Windows}
      FileSetDate(T.Handle, FileGetDate(S.Handle));
    {$endif}
  finally
    if T <> nil then T.Free;
    S.Free;
  end;
end; 

Спасибо!

[resident]

Индикацию нужно показывать во время копирования, у вас же после строки

Код: Выделить всё

T.CopyFrom(S, S.Size);

копирование уже завершено, показывать соответственно нечего.

[runewalsh]

Предлагаю чихнуть на кроссплатформенность и RTL-обёртки и использовать WinAPI-функцию CopyFileEx.
А если реалистично, то копируй кусочками в Clamp(1% размера файла, 64 Кб, 1 Мб).

[Mikhail]

Можно так, например

Код: Выделить всё

  
procedure TForm1.CopyFile(const ASource, ADest: string);
var   Source: TFileStream;
      Dest: TFileStream;
      buf: pointer;
      bufsize: integer;
      bytesreaded:Integer;
begin
 bufsize:=1024*16;

 Source:=TFileStream.Create(ASource, fmOpenRead);
 pbProgress.Min:=0;
 pbProgress.Max:=100;
 pbProgress.Position:=0;

 try
  Dest:=TFileStream.Create(ADest, fmOpenWrite or fmCreate);
  try
   GetMem(buf, bufsize);
   try
    while Source.Position < Source.Size do begin
     BytesReaded:=Source.Read(buf^, bufsize);
     Dest.WriteBuffer(buf^, BytesReaded);
     pbProgress.Position:=Trunc((Source.Position / Source.Size)*100);
     Application.ProcessMessages;
    end;
   finally
    FreeMem(buf);
    buf:=nil;
   end;
  finally
   FreeAndNil(Dest);
  end;
 finally
  FreeAndNil(Source);
 end;
end;

procedure TForm1.btnCopyClick(Sender: TObject);
begin
 (Sender as TButton).Enabled:=False;
 CopyFile('pinkfloyd.aac', 'tst.dat');
 (Sender as TButton).Enabled:=True;
end;