Community Pick: Many members of our community have endorsed this article.
Editor's Choice: This article has been selected by our editors as an exceptional contribution.

Adding threads for loading data in background to a delphi application

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:
Have you ever had your Delphi form/application just hanging while waiting for data to load?
This is the article to read if you want to learn some things about adding threads for data loading in the background.

First, I'll setup a general application with the irritating behaviour.
Second, I'll add a first step to separate the data loading into 2 procedures: GatheringData and ShowingData
Last, I'll use a thread inside the GatheringData procedure

1. The irritating application

This application loads a stringgrid with some data.
It takes about 30 seconds to create the data in the stringlist
This long time is simulated using sleep
form code:
 
unit uEEMain;
                      
                      interface
                      
                      uses
                        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                        Dialogs, Grids, StdCtrls, ExtCtrls;
                      
                      const WaitSleep = 500;
                      
                      type
                        TfrmEEThreads = class(TForm)
                          pnlOptions: TPanel;
                          btnShowData: TButton;
                          sgData: TStringGrid;
                          procedure btnShowDataClick(Sender: TObject);
                        private
                          procedure LoadGrid(grid: TStringGrid);
                          procedure LoadData(List: TStrings);
                          procedure ShowData(grid: TStringGrid; List: TStrings);
                        end;
                      
                      var
                        frmEEThreads: TfrmEEThreads;
                      
                      implementation
                      
                      {$R *.dfm}
                      
                      procedure TfrmEEThreads.btnShowDataClick(Sender: TObject);
                      begin
                        // Call procedure and pass grid to load
                        LoadGrid(sgData);
                      end;
                      
                      procedure TfrmEEThreads.LoadGrid(grid: TStringGrid);
                      var List: TStrings;
                      begin
                        // Create some data in a stringlist
                        List := TStringList.Create;
                        try
                          LoadData(List);
                          // Show data in the grid
                          ShowData(grid, List);
                        finally
                          List.Free;
                        end;
                      end;
                      
                      procedure TfrmEEThreads.LoadData(List: TStrings);
                      const
                        DataRows = 10;
                        DataCols = 5;
                      var I, J: Integer;
                        temp: string;
                      begin
                        List.BeginUpdate;
                        try
                          List.Values['ROWS'] := IntToStr(DataRows +1);
                          List.Values['COLS'] := IntToStr(DataCols +1);
                          for I := 1 to DataRows +1 do
                            for J := 1 to DataCols +1 do
                            begin
                              temp := '';
                              if (J = 1) and (I > 1) then
                                temp := Format('Row %d', [I-1])
                              else if (I = 1) and (J > 1) then
                                temp := Format('Column %d', [J-1])
                              else if (J > 1) and (I > 1) then
                                Temp := Format('Data %d_%d', [I-1, J-1]);
                              List.Values[Format('%d_%d', [I, J])] := Temp;
                              Sleep(WaitSleep);
                            end;
                        finally
                          List.EndUpdate;
                        end;
                      end;
                      
                      procedure TfrmEEThreads.ShowData(grid: TStringGrid; List: TStrings);
                      var I, J: Integer;
                      begin
                        grid.FixedCols := 1;
                        grid.FixedRows := 1;
                        grid.RowCount := StrToInt(List.Values['ROWS']);
                        grid.ColCount := StrToInt(List.Values['COLS']);
                        for I := 0 to grid.ColCount-1 do
                          for J := 0 to grid.RowCount-1 do
                            grid.Cells[I, J] := List.Values[Format('%d_%d', [J+1, I+1])];
                      end;
                      
                      end.

Open in new window

form dfm:
   
object frmEEThreads: TfrmEEThreads
                        Left = 229
                        Top = 138
                        Caption = 'Loading data with background threads'
                        ClientHeight = 357
                        ClientWidth = 403
                        Color = clBtnFace
                        Font.Charset = DEFAULT_CHARSET
                        Font.Color = clWindowText
                        Font.Height = -11
                        Font.Name = 'Tahoma'
                        Font.Style = []
                        OldCreateOrder = False
                        Position = poScreenCenter
                        PixelsPerInch = 96
                        TextHeight = 13
                        object pnlOptions: TPanel
                          Left = 0
                          Top = 0
                          Width = 403
                          Height = 41
                          Align = alTop
                          TabOrder = 0
                          ExplicitLeft = 200
                          ExplicitTop = 128
                          ExplicitWidth = 185
                          object btnShowData: TButton
                            Left = 8
                            Top = 9
                            Width = 75
                            Height = 25
                            Caption = 'Show data'
                            TabOrder = 0
                            OnClick = btnShowDataClick
                          end
                        end
                        object sgData: TStringGrid
                          Left = 0
                          Top = 41
                          Width = 403
                          Height = 316
                          Align = alClient
                          TabOrder = 1
                          ExplicitLeft = 80
                          ExplicitTop = 112
                          ExplicitWidth = 320
                          ExplicitHeight = 120
                        end
                      end

Open in new window


2. Separating the loading data procedure

After the data is created/loaded, the grid must be filled with the data.  
In the following unit I have separated the loading of the data into a separate unit.
The loading data procedure is passed a procedure variable to call, after it has finished loading.
This is the easiest way to separate loading and displaying of data into 2 procedures.
 
unit uEELoadData;
                      
                      interface
                      
                      uses Classes;
                      
                      const
                        WaitSleep = 500;
                      
                      type
                        TDataLoadedProc = procedure (obj: TObject; List: TStrings) of object;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc);
                      
                      implementation
                      
                      uses SysUtils;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc);
                      const
                        DataRows = 10;
                        DataCols = 5;
                      var I, J: Integer;
                        temp: string;
                        List: TStrings;
                      begin
                        // Make sure we have all items assigned
                        if Assigned(DataLoaded) and Assigned(Obj) then
                        begin
                          // Create the data
                          List := TStringList.Create;
                          try
                            List.Values['ROWS'] := IntToStr(DataRows +1);
                            List.Values['COLS'] := IntToStr(DataCols +1);
                            for I := 1 to DataRows +1 do
                              for J := 1 to DataCols +1 do
                              begin
                                temp := '';
                                if (J = 1) and (I > 1) then
                                  temp := Format('Row %d', [I-1])
                                else if (I = 1) and (J > 1) then
                                  temp := Format('Column %d', [J-1])
                                else if (J > 1) and (I > 1) then
                                  Temp := Format('Data %d_%d', [I-1, J-1]);
                                List.Values[Format('%d_%d', [I, J])] := Temp;
                                Sleep(WaitSleep);
                              end;
                            // Call the show procedure with the obj to show the created data in
                            DataLoaded(obj, List);
                          finally
                            List.Free;
                          end;
                        end;
                      end;
                      
                      end.

Open in new window


Of course, the main unit has to be modified too:
here is the modified form code:
 
unit uEEMain;
                      
                      interface
                      
                      uses
                        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                        Dialogs, Grids, StdCtrls, ExtCtrls;
                      
                      type
                        TfrmEEThreads = class(TForm)
                          pnlOptions: TPanel;
                          btnShowData: TButton;
                          sgData: TStringGrid;
                          procedure btnShowDataClick(Sender: TObject);
                        private
                          procedure ShowData(obj: TObject; List: TStrings);
                        end;
                      
                      var
                        frmEEThreads: TfrmEEThreads;
                      
                      implementation
                      
                      uses uEELoadData;
                      
                      {$R *.dfm}
                      
                      procedure TfrmEEThreads.btnShowDataClick(Sender: TObject);
                      begin
                        // Call procedure and pass grid to load and proc to load the grid
                        LoadData(sgData, ShowData);
                      end;
                      
                      procedure TfrmEEThreads.ShowData(obj: TObject; List: TStrings);
                      var
                        I, J: Integer;
                        grid: TStringGrid;
                      begin
                        grid := TStringGrid(obj);
                        grid.FixedCols := 1;
                        grid.FixedRows := 1;
                        grid.RowCount := StrToInt(List.Values['ROWS']);
                        grid.ColCount := StrToInt(List.Values['COLS']);
                        for I := 0 to grid.ColCount-1 do
                          for J := 0 to grid.RowCount-1 do
                            grid.Cells[I, J] := List.Values[Format('%d_%d', [J+1, I+1])];
                      end;
                      
                      end.

Open in new window


So far, nothing has really changed about the behaviour.
Loading the data has now been separated, but the application is still hanging during the loading of the data.

3. Adding a background thread to load the data

Now a thread will be used to load the data.
Some protection has been built in so a second thread doesn't start.
 
unit uEELoadData;
                      
                      interface
                      
                      uses Classes;
                      
                      const
                        WaitSleep = 500;
                      
                      type
                        TDataLoadedProc = procedure (obj: TObject; List: TStrings) of object;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc);
                      
                      implementation
                      
                      uses SysUtils;
                      
                      var
                        mLoadDataThreadRunning: boolean;
                      
                      type
                        TLoadDataThread = class(TThread)
                        private
                          fDataLoaded: TDataLoadedProc;
                          fObj: TObject;
                          fList: TStrings;
                          procedure DoDataLoaded;
                        protected
                          procedure Execute; override;
                          property List: TStrings read fList;
                        public
                          constructor Create(Obj: TObject; DataLoaded: TDataLoadedProc); reintroduce; virtual;
                          destructor Destroy; override;
                        end;
                      
                      { TLoadDataThread }
                      
                      constructor TLoadDataThread.Create(Obj: TObject; DataLoaded: TDataLoadedProc);
                      begin
                        // Create thread not suspended
                        inherited Create(False);
                        // When finished, autofree
                        FreeOnTerminate := True;
                        // remember parameters
                        fObj := Obj;
                        fDataLoaded := DataLoaded;
                        fList := TStringList.Create;
                      end;
                      
                      destructor TLoadDataThread.Destroy;
                      begin
                        fList.Free;
                        inherited Destroy;
                      end;
                      
                      procedure TLoadDataThread.Execute;
                      const
                        DataRows = 10;
                        DataCols = 5;
                      var I, J: Integer;
                        temp: string;
                      begin
                        // Create the data
                        List.Values['ROWS'] := IntToStr(DataRows +1);
                        List.Values['COLS'] := IntToStr(DataCols +1);
                        for I := 1 to DataRows +1 do
                          for J := 1 to DataCols +1 do
                          begin
                            temp := '';
                            if (J = 1) and (I > 1) then
                              temp := Format('Row %d', [I-1])
                            else if (I = 1) and (J > 1) then
                              temp := Format('Column %d', [J-1])
                            else if (J > 1) and (I > 1) then
                              Temp := Format('Data %d_%d', [I-1, J-1]);
                            List.Values[Format('%d_%d', [I, J])] := Temp;
                            Sleep(WaitSleep);
                          end;
                        // Call the show procedure with the obj to show the created data in
                        Synchronize(DoDataLoaded);
                      end;
                      
                      procedure TLoadDataThread.DoDataLoaded;
                      begin
                        // Make sure we have all items assigned
                        if Assigned(fDataLoaded) and Assigned(fObj) then
                          fDataLoaded(fObj, fList);
                      
                        // clear the flag to stop a second thread
                        mLoadDataThreadRunning := False;
                      end;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc);
                      begin
                        if not mLoadDataThreadRunning then
                        begin
                          mLoadDataThreadRunning := True;
                          TLoadDataThread.Create(Obj, DataLoaded);
                        end;
                      end;
                      
                      initialization
                        mLoadDataThreadRunning := False;
                      end.

Open in new window


4. Adding feedback

Now we have a responsive form during the loading of the data, but we don't have any feedback.
I wrote another article using a progressbar and a thread and use the same approach to add feedback.
I first changed the data loading unit by adding a procedure variable to report progress.
 
unit uEELoadData;
                      
                      interface
                      
                      uses Classes;
                      
                      const
                        WaitSleep = 500;
                      
                      type
                        TDataLoadedProc = procedure (obj: TObject; List: TStrings) of object;
                        TDataProgressProc = procedure (obj: TObject; ProcentDone: integer) of object;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc);
                      
                      implementation
                      
                      uses SysUtils;
                      
                      var
                        mLoadDataThreadRunning: boolean;
                      
                      type
                        TLoadDataThread = class(TThread)
                        private
                          fDataLoaded: TDataLoadedProc;
                          fDataProgress: TDataProgressProc;
                          fObj: TObject;
                          fList: TStrings;
                          fProcentDone: integer;
                          procedure DoDataLoaded;
                          procedure DoProgress;
                        protected
                          procedure ReportProgress(ProcentDone: Integer);
                          procedure Execute; override;
                          property List: TStrings read fList;
                        public
                          constructor Create(Obj: TObject; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc); reintroduce; virtual;
                          destructor Destroy; override;
                        end;
                      
                      { TLoadDataThread }
                      
                      constructor TLoadDataThread.Create(Obj: TObject; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc);
                      begin
                        // Create thread not suspended
                        inherited Create(False);
                        // When finished, autofree
                        FreeOnTerminate := True;
                        // remember parameters
                        fObj := Obj;
                        fDataLoaded := DataLoaded;
                        fDataProgress := DataProgress;
                        fList := TStringList.Create;
                      end;
                      
                      destructor TLoadDataThread.Destroy;
                      begin
                        fList.Free;
                        inherited Destroy;
                      end;
                      
                      procedure TLoadDataThread.Execute;
                      const
                        DataRows = 10;
                        DataCols = 5;
                      var I, J: Integer;
                        temp: string;
                      begin
                        // Create the data
                        List.Values['ROWS'] := IntToStr(DataRows +1);
                        List.Values['COLS'] := IntToStr(DataCols +1);
                        for I := 1 to DataRows +1 do
                          for J := 1 to DataCols +1 do
                          begin
                            temp := '';
                            if (J = 1) and (I > 1) then
                              temp := Format('Row %d', [I-1])
                            else if (I = 1) and (J > 1) then
                              temp := Format('Column %d', [J-1])
                            else if (J > 1) and (I > 1) then
                              Temp := Format('Data %d_%d', [I-1, J-1]);
                            List.Values[Format('%d_%d', [I, J])] := Temp;
                            ReportProgress(Trunc(((I-1) * (DataCols+1) + J-1) / ((DataRows+1) * (DataCols+1))*100));
                            Sleep(WaitSleep);
                          end;
                        ReportProgress(100);
                        // Call the show procedure with the obj to show the created data in
                        Synchronize(DoDataLoaded);
                      end;
                      
                      procedure TLoadDataThread.ReportProgress(ProcentDone: Integer);
                      begin
                        fProcentDone := ProcentDone;
                        Synchronize(DoProgress);
                      end;
                      
                      procedure TLoadDataThread.DoDataLoaded;
                      begin
                        // Make sure we have all items assigned
                        if Assigned(fDataLoaded) and Assigned(fObj) then
                          fDataLoaded(fObj, fList);
                      
                        // clear the flag to stop a second thread
                        mLoadDataThreadRunning := False;
                      end;
                      
                      procedure TLoadDataThread.DoProgress;
                      begin
                        if Assigned(fDataProgress) then
                          fDataProgress(fObj, fProcentDone);
                      end;
                      
                      procedure LoadData(obj: TObject; DataLoaded: TDataLoadedProc; DataProgress: TDataProgressProc);
                      begin
                        if not mLoadDataThreadRunning then
                        begin
                          mLoadDataThreadRunning := True;
                          TLoadDataThread.Create(Obj, DataLoaded, DataProgress);
                        end;
                      end;
                      
                      initialization
                        mLoadDataThreadRunning := False;
                      end.

Open in new window


Here is the changed code and dfm for the mainunit (with the progressbar).
 
unit uEEMain;
                      
                      interface
                      
                      uses
                        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                        Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls;
                      
                      type
                        TfrmEEThreads = class(TForm)
                          pnlOptions: TPanel;
                          btnShowData: TButton;
                          sgData: TStringGrid;
                          pbLoadData: TProgressBar;
                          procedure btnShowDataClick(Sender: TObject);
                        private
                          procedure ShowData(obj: TObject; List: TStrings);
                          procedure ProgressData(obj: TObject; ProcentDone: Integer);
                        end;
                      
                      var
                        frmEEThreads: TfrmEEThreads;
                      
                      implementation
                      
                      uses uEELoadData;
                      
                      {$R *.dfm}
                      
                      procedure TfrmEEThreads.btnShowDataClick(Sender: TObject);
                      begin
                        // Call procedure and pass grid to load and proc to load the grid
                        LoadData(sgData, ShowData, ProgressData);
                      end;
                      
                      procedure TfrmEEThreads.ProgressData(obj: TObject; ProcentDone: Integer);
                      begin
                        pbLoadData.Visible := ProcentDone < 100;
                        pbLoadData.Position := ProcentDone;
                        pbLoadData.Update;
                      end;
                      
                      procedure TfrmEEThreads.ShowData(obj: TObject; List: TStrings);
                      var
                        I, J: Integer;
                        grid: TStringGrid;
                      begin
                        grid := TStringGrid(obj);
                        grid.FixedCols := 1;
                        grid.FixedRows := 1;
                        grid.RowCount := StrToInt(List.Values['ROWS']);
                        grid.ColCount := StrToInt(List.Values['COLS']);
                        for I := 0 to grid.ColCount-1 do
                          for J := 0 to grid.RowCount-1 do
                            grid.Cells[I, J] := List.Values[Format('%d_%d', [J+1, I+1])];
                      end;
                      
                      end.

Open in new window

object frmEEThreads: TfrmEEThreads
                        Left = 556
                        Top = 172
                        Caption = 'Loading data with background threads'
                        ClientHeight = 357
                        ClientWidth = 403
                        Color = clBtnFace
                        Font.Charset = DEFAULT_CHARSET
                        Font.Color = clWindowText
                        Font.Height = -11
                        Font.Name = 'Tahoma'
                        Font.Style = []
                        OldCreateOrder = False
                        Position = poScreenCenter
                        PixelsPerInch = 96
                        TextHeight = 13
                        object pnlOptions: TPanel
                          Left = 0
                          Top = 0
                          Width = 403
                          Height = 41
                          Align = alTop
                          TabOrder = 0
                          object btnShowData: TButton
                            Left = 8
                            Top = 9
                            Width = 75
                            Height = 25
                            Caption = 'Show data'
                            TabOrder = 0
                            OnClick = btnShowDataClick
                          end
                        end
                        object sgData: TStringGrid
                          Left = 0
                          Top = 41
                          Width = 403
                          Height = 299
                          Align = alClient
                          TabOrder = 1
                          ExplicitHeight = 316
                        end
                        object pbLoadData: TProgressBar
                          Left = 0
                          Top = 340
                          Width = 403
                          Height = 17
                          Align = alBottom
                          Smooth = True
                          TabOrder = 2
                          Visible = False
                        end
                      end

Open in new window


Here is also the project source code:
 
program prjEEThreads;
                      
                      uses
                        Forms,
                        uEEMain in 'uEEMain.pas' {frmEEThreads},
                        uEELoadData in 'uEELoadData.pas';
                      
                      {$R *.res}
                      
                      begin
                        Application.Initialize;
                        Application.MainFormOnTaskbar := True;
                        Application.CreateForm(TfrmEEThreads, frmEEThreads);
                        Application.Run;
                      end.

Open in new window


I hope threads provide some fun in future projects.

G
11
14,673 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 (5)

Commented:
Thank you Geert
God bless you

I voted yes

Commented:
Hello,

Can I download the whole project as one zipped file? I know that all the source is here but it contains a lot of pieces, it takes a lot of time to reconstruct it...

Thank you very much
aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Commented:
@starhu

The author did not post a single file containing the code snippets.  You might try clicking on the Select All link and copy/paste the code into Notepad or your IDE.  It shouldn't take you more than 90 seconds to do that.  I just copied/pasted all of the snippets into Notepad in less than 70 seconds.

Commented:
Thank you aikimark. I did it and I succeeded.

I new about Select all, and how to use copy/paste, but a download project would be even much faster (about 3-5 seconds).

Commented:
Thank you so much, Geert! The article is really helpful.

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.