?
Solved

Delphi Thread and Form Freezzzing

Posted on 2007-08-01
7
Medium Priority
?
668 Views
Last Modified: 2013-11-23
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
Comment
Question by:triz99
7 Comments
 
LVL 21

Expert Comment

by:ziolko
ID: 19608625
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
 
LVL 10

Accepted Solution

by:
dinilud earned 2000 total points
ID: 19608963
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
 
LVL 26

Expert Comment

by:Tomas Helgi Johannsson
ID: 19609450
  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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:triz99
ID: 19609788
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
 
LVL 10

Expert Comment

by:dinilud
ID: 19609921
i not experience with Threads.

I think You can Use a TthreadList.
0
 

Author Comment

by:triz99
ID: 19610123
Ok, thank you for your help
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In a question here at Experts Exchange (https://www.experts-exchange.com/questions/29062564/Adobe-acrobat-reader-DC.html), a member asked how to create a signature in Adobe Acrobat Reader DC (the free Reader product, not the paid, full Acrobat produ…
When cloud platforms entered the scene, users and companies jumped on board to take advantage of the many benefits, like the ability to work and connect with company information from various locations. What many didn't foresee was the increased risk…
Suggested Courses
Course of the Month14 days, 9 hours left to enroll

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question