<

Displaying progress in the main form from a thread in Delphi

Published on
39,060 Points
28,660 Views
14 Endorsements
Last Modified:
Approved
Community Pick
Geert G
These are my last weeks. If the doctors can reduce the pain I'll still get to september. Pity, but the Delphi ACE level is out of reach.
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
Author:Geert G
Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free