Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> помогите найти ошибку 
V
    Опции темы
Victor_b
Дата 8.9.2009, 21:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 20.9.2007

Репутация: нет
Всего: нет
Помогите выяснить почему не работает прогрессбар в примере, позволяющем скачать файл (процедура TForm1.MyProgress ни одного раза не срабатывает). На форме следующие элементы:

user posted image
Код:
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, ComCtrls;
const
  MY_MESS = WM_USER + 100;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    Button2: TButton;
    IdHTTP1: TIdHTTP;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
  { public declarations }
    procedure thrTerminate(Sender: TObject);
    procedure MyProgress(var msg: TMessage); message MY_MESS;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//---------------------------------------
type
  TDownLoader = class(TThread)
  private
    FURL: string;
    FToFolder: string;
  protected
    procedure Execute; override;
  public
    property URL: string read FURL write FURL;
    property ToFolder: string read FToFolder write FToFolder;
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  end;



procedure TForm1.Button1Click(Sender: TObject);
begin
 //Этой строкой мы скопируем имя файла SaveDialog1.FileName:=copy(Edit1.Text,LastDelimiter('\?',Edit1.Text)+1,maxint);
  SaveDialog1.FileName := copy(Edit1.Text, LastDelimiter('\?', Edit1.Text) + 1, maxint);
  if SaveDialog1.Execute then
    Edit2.Text := SaveDialog1.FileName;
end;

{ TDownLoader }

procedure TDownLoader.Execute;
var
  http: TIdHTTP;
  str: TFileStream;
begin
  //Создим класс для закачки
  http := TIdHTTP.Create(nil);
  //каталог, куда файл положить
  ForceDirectories(ExtractFileDir(ToFolder));
  //Поток для сохранения
  str := TFileStream.Create(ToFolder, fmCreate);
  try
    //Качаем
    http.Get(url, str);
  finally
    //Нас учили чистить за собой
    http.Free;
    str.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var d: TDownLoader;
begin
  //Создадим класс потока.
  //Поток для начала будет остановлен
  d := TDownLoader.Create(true);
  //Передадим параметры потоку
  d.URL := Edit1.Text;
  d.ToFolder := Edit2.Text;
  //Поток должен удалить себя по завершению своей работы
  d.FreeOnTerminate := true;
  d.OnTerminate := thrTerminate;
  //И запустим его на закачку.
  d.Resume;
  //Теперь с процедуры мы выйдем, но поток работает
  //и живёт своей жизней
end;

procedure TForm1.MyProgress(var msg: TMessage);
begin
  caption := IntToStr(msg.LParam);
  case msg.WParam of
    0: begin ProgressBar1.Max := msg.LParam;
        ProgressBar1.Position := 0;
      end;
    1: ProgressBar1.Position := msg.LParam;
  end;
end;

procedure TForm1.thrTerminate(Sender: TObject);
begin
  ShowMessage('Готово');
end;

procedure TDownLoader.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
  PostMessage(Application.MainForm.Handle, MY_MESS, 1, AWorkCount);
end;

procedure TDownLoader.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Integer);
begin
  PostMessage(Application.MainForm.Handle, MY_MESS, 0, AWorkCountMax);
end;

procedure TDownLoader.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
//
end;

end.


В примере объясняется, что прогрессбар запускается так: 
Цитата

Мы шлём сообщение посреднику, чтобы он сообщил другому потоку (а может и группе), чтобы он что-то сделал. Этот способ хорош тем, что поток может обрабатывать сообщения не по принуждению, а по возможности. То есть сообщения встают в очередь. В качестве посредника мы выберем саму среду Windows.
PM MAIL   Вверх
Romikgy
Дата 8.9.2009, 21:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 3
Всего: 146
и что не работает?


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Данкинг
Дата 8.9.2009, 21:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Yersinia pestis
****


Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 1
Всего: 130
Цитата(Victor_b @  8.9.2009,  22:31 Найти цитируемый пост)
процедура TForm1.MyProgress ни одного раза не срабатывает

Ну а вызывается-то она откуда?

А, понял. Но обычно после изменения значения прогрессбара делается Application.Processmessages.

Это сообщение отредактировал(а) Данкинг - 8.9.2009, 21:43


--------------------
There's nothing left but silent epitaphs.
PM MAIL WWW   Вверх
Romikgy
Дата 8.9.2009, 21:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 3
Всего: 146
Цитата(Данкинг @  8.9.2009,  20:40 Найти цитируемый пост)
Ну а вызывается-то она откуда?

ну типо по сообщению

я бы посоветовал или перейти на синхронизацию вместо сообщений
или передавать в класс даунлоадер хендл окна приемщика сообщений....


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Victor_b
Дата 8.9.2009, 21:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 20.9.2007

Репутация: нет
Всего: нет
В силу малограмотности моей нельзя ли подправить код. Чесслово, так до меня быстрее дойдет... Спасибо всем откликнувшимся.
PM MAIL   Вверх
Victor_b
Дата 12.9.2009, 18:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 20.9.2007

Репутация: нет
Всего: нет
Application.Processmessages куда только не вставлял, индикация не работает. Как еще можно ее реализовать?
PM MAIL   Вверх
Matematik
Дата 12.9.2009, 19:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50
 Victor_b,
Надо еще указать события у IdHTTP
примерно так
Код

  FHttp := TIdHTTP.Create(nil);
  with FHttp do
  begin
    SendBufferSize  := 1024; // OnWork будет вызываться чаще, прогресс плавнее
    RecvBufferSize  := 1024;
    OnWork          := HTTPWork; // твои методы
    OnWorkBegin     := HTTPWorkBegin;
    OnWorkEnd       := HTTPWorkEnd;


> я бы посоветовал или перейти на синхронизацию вместо сообщений

В данном случае без разницы, тем более синхронизация тормозит доп.поток пока метод не обработает главный поток - это лишнее действие и код

Victor_b, пример с синхронизацией
http://forum.vingrad.ru/index.php?showtopi...t&p=1945561

PS
Прогресс может вообще не работать, в некоторых случаях сервер не сообщает размер пересылаемых данных, соответственно прогресс построить невозможно.

Это сообщение отредактировал(а) Matematik - 12.9.2009, 19:42
PM MAIL WWW ICQ   Вверх
Romikgy
Дата 12.9.2009, 20:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 3
Всего: 146
все оказалось проще

Цитата(Victor_b @  8.9.2009,  20:31 Найти цитируемый пост)
procedure TDownLoader.Execute;
var
  http: TIdHTTP;
  str: TFileStream;
begin
  //Создим класс для закачки
  http := TIdHTTP.Create(nil);
  //каталог, куда файл положить
  ForceDirectories(ExtractFileDir(ToFolder));
  //Поток для сохранения
  str := TFileStream.Create(ToFolder, fmCreate);
  try
    //Качаем
    http.Get(url, str);
  finally
    //Нас учили чистить за собой
    http.Free;
    str.Free;
  end;
end;

Код

http := TIdHTTP.Create(nil);
http.OnWorkBegin:=IdHTTP1WorkBegin;
http.OnWork:=IdHTTP1Work;
http.OnWorkEnd:=IdHTTP1WorkEnd;



--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Victor_b
Дата 12.9.2009, 20:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 20.9.2007

Репутация: нет
Всего: нет
Все заработало, спасибо. Единственное что не понравилось - прогресс прогрессбара грубый, но думаю разберусь, тем более Matematik пример подбросил. Спасибо.

Это сообщение отредактировал(а) Victor_b - 12.9.2009, 20:30
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1080 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.