Проблема в том - при нажатии на батон, прога как будто виснет, 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; |
|
