<

Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x

Displaying progress in the main form from a thread in Delphi

Published on
34,501 Points
24,101 Views
14 Endorsements
Last Modified:
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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Join & Write a Comment

Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month