<

Displaying progress in the main form from a thread in Delphi

Published on
35,453 Points
25,053 Views
14 Endorsements
Last Modified:
Approved
Geert Gruwez
6 months until my next "Did i really beat the cancer ?" check
A lot of questions regard threads in Delphi.  
One of the more specific questions is how to show progress of the thread.  
Updating a progressbar from inside a thread is a mistake.
A solution to this would be to send a synchronized message to the main thread.
This message would then contain the progress of the thread from 0 to 100.
 

1. Setting the progress bar


The progressbar will be displaying from 0 to 100
Property Max = 100
Property Min = 0
 

2. The base thread: TProgressThread


I defined a thread class for sending messages back via a synchronize procedure
type
  TProgressProc = procedure (aProgress: Integer) of object; // 0 to 100
 
  TProgressThread = class(TThread)
  private
    FProgressProc: TProgressProc;
    FProgressValue: integer;
    procedure SynchedProgress;
  protected
    procedure Progress(aProgress: integer); virtual;
  public
    constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end;
 
{ TProgressThread }
 
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); 
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FProgressProc := aProgressProc;
end;
 
procedure TProgressThread.Progress(aProgress: Integer);
begin
  FProgressValue := aProgress;
  Synchronize(SynchedProgress);
end;
 
procedure TProgressThread.SynchedProgress;
begin
  if Assigned(FProgressProc) then
    FProgressProc(FProgressValue);
end;

Open in new window

 

3. Define your own thread: TMyThread


Now define your own thread as a descendant of the TProgressThread.
This thread just counts to 100 over 100 seconds
type
  TMyThread = class(TProgressThread)
  protected
    procedure Execute; override;
  end; 
procedure TMyThread.Execute; 
var I: Integer;
begin
  Progress(0);
  for I := 1 to 100 do 
  begin 
    Sleep(1000);
    Progress(I);
  end;
end;

Open in new window

 

4. Define the procedure to adjust the progress bar position


This procedure will receive the messages from the progress thread.
type  
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
  private
    procedure UpdateProgressBar(aProgress: Integer);
  end; 
procedure TForm1.UpdateProgressBar(aProgress: Integer);
begin
  ProgressBar1.Position := aProgress;
  ProgressBar1.Update; // Make sure to repaint the progressbar
end;

Open in new window

 

5. Start a thread from the form


This starts the progress thread
type
  TForm1 = class(TForm)
    btnStart: TButton;
    procedure btnStartClick(Sender: TObject);
  private
    fMyThread: TMyThread;
  end;   
procedure TForm1.btnStartClick(Sender: TObject);
begin
  if not Assigned(fMyThread) then 
    fMyThread := TMyThread.Create(UpdateProgressbar);
end;

Open in new window

 

6. Complete code


Here is a copy of the complete unit
 
unit Unit1; 
interface 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls; 
type
  TProgressProc = procedure (aProgress: Integer) of object; // 0 to 100 
  TProgressThread = class(TThread)
  private
    FProgressProc: TProgressProc;
    FProgressValue: integer;
    procedure SynchedProgress;
  protected
    procedure Progress(aProgress: integer); virtual;
  public
    constructor Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end; 
  TMyThread = class(TProgressThread)
  protected
    procedure Execute; override;
  end; 
  TForm1 = class(TForm)
    btnStart: TButton;
    ProgressBar1: TProgressBar;
    procedure btnStartClick(Sender: TObject);
  private
    fMyThread: TMyThread;
    procedure UpdateProgressBar(aProgress: Integer);
  end; 
var
  Form1: TForm1; 
implementation 
{$R *.dfm} 
{ TProgressThread } 
constructor TProgressThread.Create(aProgressProc: TProgressProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FProgressProc := aProgressProc;
end; 
procedure TProgressThread.Progress(aProgress: Integer);
begin
  FProgressValue := aProgress;
  Synchronize(SynchedProgress);
end; 
procedure TProgressThread.SynchedProgress;
begin
  if Assigned(FProgressProc) then
    FProgressProc(FProgressValue);
end; 
{ TMyThread } 
procedure TMyThread.Execute;
var I: Integer;
begin
  Progress(0);
  for I := 1 to 100 do
  begin
    Sleep(1000);
    Progress(I);
  end;
end; 
{ TForm1 } 
procedure TForm1.UpdateProgressBar(aProgress: Integer);
begin
  ProgressBar1.Position := aProgress;
  ProgressBar1.Update; // Make sure to repaint the progressbar
  if aProgress >= 100 then
    fMyThread := nil;
end; 
procedure TForm1.btnStartClick(Sender: TObject);
begin
  if not Assigned(fMyThread) then
    fMyThread := TMyThread.Create(UpdateProgressBar);
end; 
end.

Open in new window


No more complex synchronise methods needed in the descendant classes !
14
Comment
  • 3
4 Comments
 
LVL 14

Expert Comment

by:systan
I voted yes
0
 
LVL 38

Author Comment

by:Geert Gruwez
Lol ... when i get time again ...
i'll try and add a OTL sample :)
0
 
LVL 14

Expert Comment

by:systan
Lol ..... Wow, do you think you could do that?  I think you have no time for that!
Anyway OTL is just another method of threading, I still don't see the big impact, because I didn't see any binary samples yet.

3 beers is enough, would not make you drunk.
0
 
LVL 14

Expert Comment

by:systan
Geert, can you correct this solution, seems I don't know if I got it correct as this article says.
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_26640643.html

is it wrong?
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Join & Write a Comment

Kernel Data Recovery is a renowned Data Recovery solution provider which offers wide range of softwares for both enterprise and home users with its cost-effective solutions. Let's have a quick overview of the journey and data recovery tools range he…
This video tutorial shows you the steps to go through to set up what I believe to be the best email app on the android platform to read Exchange mail.  Get the app on your phone: The first step is to make sure you have the Samsung Email app on your …
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month