Проблема в том - при нажатии на батон, прога как будто виснет, IdAntiFreeza поставил, но нифига.Как бы сделать, чтоб бегал прогресс бар как в IE, и показывать отсчёт времени до конца считывания инфы?А то не поймёшь- зависла или работает

Код

procedure TForm1.Button1Click(Sender: TObject); var Adr, html : string; Posts : TPosts;  PostNo, i, i2: integer;  tag: integer;  User: boolean; procedure AddText (const txt : string; c : TColor; fs : TFontStyles); var  st : integer; begin   st := RichEdit1.SelStart;   RichEdit1.Lines.Add(txt);   RichEdit1.SelStart := st;   RichEdit1.SelLength := Length(txt);   RichEdit1.SelAttributes.Color := c;   RichEdit1.SelAttributes.Style := fs;   RichEdit1.SelectAll;   RichEdit1.SelStart := RichEdit1.SelLength; end; begin RichEdit1.Lines.Clear; SetLength (Posts, 0); IdHTTP1.Host := HostName; IdHTTP1.Connect; PostNo := 0; repeat   AddText ('Get from PostNo: ' + IntToStr(PostNo), clBlue, []);   RichEdit1.Update;   Adr := URL + 't=' + Edit1.Text + '&start=' + IntToStr(PostNo);   html := IdHTTP1.Get(Adr);   i := GetPosts(html, Posts);   Inc (PostNo, i); until i = 0;  Tag := 0;  for i := 0 to High(Posts) do Posts[i].Tag := 0; //Тут присваиваем уникальному юзверю уникальный тэг.  for i := 0 to High(Posts) do    if Posts[i].Tag = 0 then      begin        Inc(Tag);        Posts[i].Tag := Tag;        for i2 := i + 1 to High(Posts) do          if Posts[i2].User = Posts[i].User then Posts[i2].Tag := Tag;      end; //Тут выводим в порядке возрастания значения поля Tag все посты каждого //юзверя.  for i := 1 to Tag do    begin      User := true;      for i2 := 0 to High(Posts) do        if Posts[i2].Tag = i then          begin            if User then              begin                AddText (Posts[i2].User, clBlack, [fsBold]);                User := false;              end;            AddText (Posts[i2].PostDate, clGreen, [fsItalic]);            AddText (Posts[i2].Text, clBlack, []);            AddText ('', clBlack, []);          end;          IdHTTP1.Disconnect;    end; end;

могет поток?

Забросить код в отдельную нитку

В смысле в отдельную?

1) В циклах, где идёт изменение на форме поставить Application.ProcessMessages
Пример:

Код

for i:=1 to 2004 do begin   Label1.Caption:=IntToStr(i);   Application.PrecossMessages end;

2) Создать поток.

Код

for i := 1 to Tag do   begin     User := true;     for i2 := 0 to High(Posts) do       if Posts[i2].Tag = i then         begin           if User then             begin               AddText (Posts[i2].User, clBlack, [fsBold]);               User := false;             end;           AddText (Posts[i2].PostDate, clGreen, [fsItalic]);           AddText (Posts[i2].Text, clBlack, []);           AddText ('', clBlack, []);   Application.ProcessMessages;//?????         end;

Так что-ли?

Немного подумал и решил, что лучше так:

Код

procedure AddText (const txt : string; c : TColor; fs : TFontStyles); var st : integer; begin  st := RichEdit1.SelStart;  RichEdit1.Lines.Add(txt);  RichEdit1.SelStart := st;  RichEdit1.SelLength := Length(txt);  RichEdit1.SelAttributes.Color := c;  RichEdit1.SelAttributes.Style := fs;  RichEdit1.SelectAll;  RichEdit1.SelStart := RichEdit1.SelLength;  Application.ProcessMessages; end;

Но можно и так, как предложил. Просто в первом варианте - конечные изменения, а во втором - каждое изменение.

Во, спасибо гут, заработало.....Но 2 вопроса остались....

Знакомый код!
Сама закачка происходит тут:

Код

repeat  AddText ('Get from PostNo: ' + IntToStr(PostNo), clBlue, []);  RichEdit1.Update;  Adr := URL + 't=' + Edit1.Text + '&start=' + IntToStr(PostNo);  html := IdHTTP1.Get(Adr);  i := GetPosts(html, Posts);  Inc (PostNo, i); until i = 0;

AddText тут поставлен + RichEdit1.Update лишь для того, что показать, что чо-то там происходит... Это было сделано так, для примера.
Для того, чтобы сделать прогресс-бар, надо закачать первую страницу темы, оттуда выдрать количество страниц в теме, и уже тогда можно будет сделать прогресс бар, и кстати, цикл немного изменится (будет на 1 запрос к серверу меньше, так как было сделано по-халявному):

Код

PageNo := 1; PageMax := 1; repeat  Adr := URL + 't=' + Edit1.Text + '&start=' + IntToStr(PostNo);  html := IdHTTP1.Get(Adr);  if PageNo = 1 then PageMax := GetMaxPage(html);  Inc (PostNo, GetPosts(html, Posts));  Inc(PageNo);  ProgressBar1.Max := PageMax;  ProgressBar1.Position := PageNo;  Application.ProcessMessages; until (PageNo > PageMax);

Тебе тут надо написать функцию GetMaxPage, которая из html-текста выдирает макс. № страницы (где-то на странице либо вверху, либо внизу должны быть ссылки)...


Добавлено @ 18:31
Кстати, у тебя IdHTTP1.Disconnect; стоит в цикле... лучше вынеси из цикла

Хм, сенкс.А как показать, сколько осталось до конца отображения информации в РичЭдите?
В смысле в минутах, начиная с максимального времени и до нуля.

Это сообщение отредактировал(а) Alkash - 6.8.2004, 23:03

Для поиска макс. страницы - ищи <span class="nav">Страница
там далее идёт например: <b>1</b> из <b>3</b>
Время - примерно так:

Код

PageNo := 1; PageMax := 1; TimeStart := GetTickCount; repeat Adr := URL + 't=' + Edit1.Text + '&start=' + IntToStr(PostNo); html := IdHTTP1.Get(Adr); if PageNo = 1 then PageMax := GetMaxPage(html); TimeDelta := GetTickCount - TimeStart; TimeTotal := TimeDelta*PageMax / PageNo Inc (PostNo, GetPosts(html, Posts)); Inc(PageNo); ProgressBar1.Max := PageMax; ProgressBar1.Position := PageNo; Application.ProcessMessages; until (PageNo > PageMax);

TimeDelta и TimeTotal - в миллисекундах, первое - сколько прошло времени, второе - сколько всего времени надо на закачку...

Спасибо.