Community Pick: Many members of our community have endorsed this article.

Displaying progress in the main form from a thread in Delphi

Geert GOracle dba
CERTIFIED EXPERT
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.
Published:
Updated:
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
33,139 Views
Geert GOracle dba
CERTIFIED EXPERT
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.

Comments (4)

Commented:
I voted yes
Geert GOracle dba
CERTIFIED EXPERT
Top Expert 2009

Author

Commented:
Lol ... when i get time again ...
i'll try and add a OTL sample :)

Commented:
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.

Commented:
Geert, can you correct this solution, seems I don't know if I got it correct as this article says.
https://www.experts-exchange.com/questions/26640643/Delphi-2010-Copy-1-file-to-15-usb-devices-at-once-with-progress.html

is it wrong?

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.