• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 673
  • Last Modified:

Delphi Thread and Form Freezzzing

I have a problem with form frezzing, when I click button form freezz until the code is not executed. I tried to solve this with making this code to run in a thread but its still freezzs the form.  Here is the code below.

I have 1 ListBox which has a list of urls and ListView in report mode where i save url and http response from the url. This is just a simple code my original code is more complex but it is like this.

So can anyone help to write code that want freezz the form when I start this code.

Thank you.



unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListView1: TListView;
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TThreadForm1     =  class(TThread)
  private
     // Private declarations
     FForm:         TForm1;
     IdHTTP1:  TIdHTTP;
  protected
     // Protected declarations
     procedure      AfterSend;
     procedure      BeforeSend;
     procedure      Execute; override;
  public
     // Public declarations
     function       GetGoogleData(URL : string) : string;
     constructor    Create(Form: TForm1);
     procedure Main;
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
TThreadForm1.Create(Self);
end;

procedure TThreadForm1.Main;
var i : integer;
googledata : string;
begin
i := 0;

while (i < FForm.ListBox1.Items.Count) do
begin
FForm.ListView1.Items.Add.Caption := FForm.ListBox1.Items.Strings[i];
Application.ProcessMessages;
googledata := GetGoogleData(FForm.ListBox1.Items.Strings[i]);
FForm.ListView1.Items.Item[i].SubItems.Add(googledata);

i := i + 1;
end;
end;





constructor TThreadForm1.Create(Form: TForm1);
begin
  // Set parameters
  FForm:=Form;
  // Perform inherited (don't suspend)
  inherited Create(False);
  // Set thread props
  FreeOnTerminate:=True;
  Priority:=tpLower;
end;

procedure TThreadForm1.BeforeSend;
begin
  IdHTTP1 := TIdHTTP.Create(nil);
end;

procedure TThreadForm1.AfterSend;
begin

end;

procedure TThreadForm1.Execute;
begin
  // ---- Set IdHTTP2 settings ---- //

     try
        Synchronize(BeforeSend);
        Synchronize(Main);
        Synchronize(AfterSend);

     finally
        IdHTTP1.Free;
     end;

end;




function TThreadForm1.GetGoogleData(URL : string) : string;
var
   GoogleResponse: TStringList;
begin
   GoogleResponse := TStringList.Create;
   FForm.IdHTTP1.HandleRedirects := true;
   GoogleResponse.Text := FForm.IdHTTP1.Get(URL);
   result := GoogleResponse.Text;

end;

end.
0
triz99
Asked:
triz99
1 Solution
 
ziolkoCommented:
if you want your app stop frezing you have to put your main loop (operating on listbox items) into thread's execute method, and change application.processmessages into sleep(1)
...ohh and loop must check if thread is not terminated

ziolko.
0
 
diniludCommented:
Try  Like This


=================

Unit1.dfm
=======

object Form1: TForm1
  Left = 121
  Top = 189
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 280
    Top = 16
    Width = 225
    Height = 137
    ItemHeight = 13
    Items.Strings = (
      'http://www.google.co.in/'
      'http://www.experts-exchange.com/'
      'http://www.yahoo.co.in/')
    TabOrder = 0
  end
  object ListView1: TListView
    Left = 8
    Top = 8
    Width = 250
    Height = 201
    Columns = <
      item
      end
      item
        Width = 100
      end>
    TabOrder = 1
    ViewStyle = vsReport
  end
  object Button1: TButton
    Left = 56
    Top = 248
    Width = 153
    Height = 33
    Caption = 'Button1'
    TabOrder = 2
    OnClick = Button1Click
  end
end

Unit1.pas
=========

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListView1: TListView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TThreadForm1     =  class(TThread)
  private
     // Private declarations
     FForm:         TForm1;
     IdHTTP1:  TIdHTTP;
     FItemIndex:Integer;
     FUrl:String;
     Fgoogledata:String;
  protected
     // Protected declarations
     procedure      AfterSend;
     procedure      BeforeSend;
     procedure      Execute; override;
  public
     // Public declarations
     function       GetGoogleData(URL : string) : string;
     constructor    Create(Form: TForm1;ItemIndex:Integer;Url:String);
     procedure Main;
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
begin
  for i:=0 to ListBox1.Count-1 do
  begin
     ListView1.Items.Add.Caption := ListBox1.Items.Strings[i];
     TThreadForm1.Create(Self,i,ListBox1.Items.Strings[i]);
  end;
end;

procedure TThreadForm1.Main;
begin
  FForm.ListView1.Items.Item[FItemIndex].SubItems.Add(Fgoogledata);
end;


constructor TThreadForm1.Create(Form: TForm1;ItemIndex:Integer;Url:String);
begin
  // Set parameters
  FForm:=Form;
  FItemIndex:=ItemIndex;
  FUrl:=Url;
  // Perform inherited (don't suspend)
  inherited Create(False);
  // Set thread props
  FreeOnTerminate:=True;
  Priority:=tpLower;
end;

procedure TThreadForm1.BeforeSend;
begin
  IdHTTP1 := TIdHTTP.Create(nil);
end;

procedure TThreadForm1.AfterSend;
begin

end;

procedure TThreadForm1.Execute;
begin
  // ---- Set IdHTTP2 settings ---- //

     try
        BeforeSend;
        Fgoogledata:=GetGoogleData(FUrl);
        Synchronize(Main);
        AfterSend;
     finally
        IdHTTP1.Free;
     end;

end;




function TThreadForm1.GetGoogleData(URL : string) : string;
var
   GoogleResponse: TStringList;
begin
  try
   GoogleResponse := TStringList.Create;
   IdHTTP1.HandleRedirects := true;
   GoogleResponse.Text := IdHTTP1.Get(URL);
   result := GoogleResponse.Text;
  finally
   GoogleResponse.Free;
  end;

end;

end.
0
 
Tomas Helgi JohannssonCommented:
  Hi!
In Indy package there is a component called AntiFreeze or something like that.
Put that component on the form and see if that won't help.

Regards,
   Tomas Helgi
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
triz99Author Commented:
dinilud solution is excelent, can you write me how to limit number of thread running at the same time, becuase i think it will be the problem when I will have 100-200 url to process.
0
 
diniludCommented:
i not experience with Threads.

I think You can Use a TthreadList.
0
 
triz99Author Commented:
Ok, thank you for your help
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now