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

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

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

Сообщение McLion » 29.05.2015 20:46:43

Всем привет,

подскажите, что делаю не так... 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;


Спасибо!
Аватара пользователя
McLion
постоялец
 
Сообщения: 332
Зарегистрирован: 06.02.2015 18:41:00

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

Сообщение resident » 29.05.2015 21:33:25

Индикацию нужно показывать во время копирования, у вас же после строки
Код: Выделить всё
T.CopyFrom(S, S.Size);
копирование уже завершено, показывать соответственно нечего.
resident
энтузиаст
 
Сообщения: 605
Зарегистрирован: 13.03.2013 16:58:51

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

Сообщение runewalsh » 29.05.2015 22:27:03

Предлагаю чихнуть на кроссплатформенность и RTL-обёртки и использовать WinAPI-функцию CopyFileEx.
А если реалистично, то копируй кусочками в Clamp(1% размера файла, 64 Кб, 1 Мб).
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 579
Зарегистрирован: 27.04.2010 00:15:25

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

Сообщение Mikhail » 29.05.2015 22:42:10

Можно так, например
Код: Выделить всё
 
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; 
Mikhail
энтузиаст
 
Сообщения: 565
Зарегистрирован: 24.10.2013 16:06:47


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 250

Рейтинг@Mail.ru
cron