<

[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x

Displaying progress in the main form from a thread in Delphi

Published on
34,715 Points
24,315 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Join & Write a Comment

Video by: ITPro.TV
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonst…
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month