прогресс бар для функции

[god5]

нужно сделать прогресс бар в процентах когда идет загрузка файла
вот используемая функция

function GetInetFiles(URLbase, SaveFolder: string; IDHTP: TIDHTTP): Boolean;
var
  S: string;
  I: Integer;
  L: TStringList;
  M: TMemoryStream;


begin
  Result:= False;
  L:= TStringList.Create;
  M:= TMemoryStream.Create;
 try

  if URLBase = '' then
   ShowMessage('URL база не найдена !')
  else
  L.LoadFromFile(URLBase);

finally
  for I:= 0 to L.Count -1  do 
  begin
   IDHTP.Get(L[i], M); 
   S:= ExtractFileName(StringReplace(L[i],'/','\',[rfReplaceAll])); 
   Form1.Mmo2.Lines.Add(S);
   if not DirectoryExists(SaveFolder) then CreateDir(SaveFolder); 
   M.SaveToFile(SaveFolder +'\'+ S ); 
   Application.ProcessMessages;
   M.Clear;  
  end;
  Result:= True; 
 end;
 end;


if GetInetFiles('URLBase.txt','exe',idhtp1) then

[Lardes]

  private
    FWorkCount: Integer;
    FWorkCountMax: Integer;
  public
    procedure WorkBegin(ASender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);   
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure Work(ASender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
  end;

function ConvertBytes(Bytes: Integer): String;
begin
  if Bytes div 1024 < 1 then Result := FormatFloat('0.00 "Byte"', Bytes);
  if Bytes div 1024 >= 1 then Result := FormatFloat('0 "KB"', Bytes/1024);
  if Bytes div 1024 >= 1024 then Result := FormatFloat('0.00 "MB"', Bytes/1048576);
  if Bytes div 734003200 >= 1 then Result := FormatFloat('0.00 "GB"', Bytes/1073741824);
end;

procedure TForm1.WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin         
  FWorkCount := 0;
  FWorkCountMax := AWorkCountMax;
  ProgressBar.Position := 0;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

procedure TForm1.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  InfoLabel.Caption := 'Завершение загрузки';
end;

procedure TForm1.Work(ASender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  ProgressBar.Position := FWorkCount * 100 div FWorkCountMax;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

Перед IDHTP.Get(L[i], M); добавить:

  IDHTP.OnWorkBegin := WorkBegin;
  IDHTP.OnWorkEnd := WorkEnd;
  IDHTP.OnWork := Work;

[Lardes]

Для отображения прогресса используй TGauge

[god5]

Сообщение от Lardes

  private
    FWorkCount: Integer;
    FWorkCountMax: Integer;
  public
    procedure WorkBegin(ASender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);   
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure Work(ASender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
  end;

function ConvertBytes(Bytes: Integer): String;
begin
  if Bytes div 1024 < 1 then Result := FormatFloat('0.00 "Byte"', Bytes);
  if Bytes div 1024 >= 1 then Result := FormatFloat('0 "KB"', Bytes/1024);
  if Bytes div 1024 >= 1024 then Result := FormatFloat('0.00 "MB"', Bytes/1048576);
  if Bytes div 734003200 >= 1 then Result := FormatFloat('0.00 "GB"', Bytes/1073741824);
end;

procedure TForm1.WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin         
  FWorkCount := 0;
  FWorkCountMax := AWorkCountMax;
  ProgressBar.Position := 0;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

procedure TForm1.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  InfoLabel.Caption := 'Завершение загрузки';
end;

procedure TForm1.Work(ASender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  ProgressBar.Position := FWorkCount * 100 div FWorkCountMax;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

Перед IDHTP.Get(L[i], M); добавить:

  IDHTP.OnWorkBegin := WorkBegin;
  IDHTP.OnWorkEnd := WorkEnd;
  IDHTP.OnWork := Work;

сделал выдает ошибку на work,end,begin
что не так)? и следующее сообщение ваше не понял) можно поподробнее)

видимо нужно что то прописать в uses или нужен компонент?)

[Lardes]

Сообщение от god5

сделал выдает ошибку на work,end,begin
что не так)?

Тогда обработай события IdHTTP1 OnWorkBegin, OnWorkEnd , OnWork и пропиши в них код, который указан выше. Если не получится, вышлю исходник

Сообщение от god5

и следующее сообщение ваше не понял) можно поподробнее)

видимо нужно что то прописать в uses или нужен компонент?)

Да, компонент Gauge, вкладка Samples. По теме: просили выводить в процентах, он для этой задачи и годится

[god5]

Сообщение от Lardes

Тогда обработай события IdHTTP1 OnWorkBegin, OnWorkEnd , OnWork и пропиши в них код, который указан выше. Если не получится, вышлю исходник


Да, компонент Gauge, вкладка Samples. По теме: просили выводить в процентах, он для этой задачи и годится

большое тебе спасибо получилось) только 2 маленьких глупых вопроса)
где находится вообще в делфи infolabel))) я использовал обычный label потом что info никогда не пользовался) и с Gauge как % сделать )!!!)

[Lardes]

Сообщение от god5

где находится вообще в делфи infolabel))) я использовал обычный label потом что info никогда не пользовался)

Ты всё правильно сделал. =) Это обычный переименованный Label =)

Сообщение от god5

и с Gauge как % сделать )!!!)

procedure TForm1.WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin         
  FWorkCount := 0;
  FWorkCountMax := AWorkCountMax;
  Gauge.Progress := FWorkCount;
  Gauge.MaxValue := FWorkCountMax;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

procedure TForm1.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  InfoLabel.Caption := 'Завершение загрузки';
end;

procedure TForm1.Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  Gauge.Progress := FWorkCount;
  InfoLabel.Caption := Format('Размер: %s/%s',
    [ConvertBytes(FWorkCount), ConvertBytes(FWorkCountMax)]);
end;

И ещё... Заметил ошибки в своём же коде, а именно:
"выдает ошибку на work,end, begin" - возникает в D2007 и выше. Решение: убрать const то есть:

  public
    procedure WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);   
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
  end;

P.S. Качать файлы лучше в потоке и пересмотри свой код, в нем есть неккоректности

[god5]

спасибо большое!)

[Lardes]

Всегда пожалуйста =)