<

Adding threads for loading data in background to a delphi application

Published on
22,907 Points
9,807 Views
11 Endorsements
Last Modified:
Awarded
Geert Gruwez
6 months until my next "Did i really beat the cancer ?" check
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
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
5 Comments
 
LVL 14

Expert Comment

by:systan
Thank you Geert
God bless you

I voted yes
0
 

Expert Comment

by:starhu
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
0
 
LVL 46

Expert Comment

by:aikimark
@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.
0
 

Expert Comment

by:starhu
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).
0
 

Expert Comment

by:deyoz
Thank you so much, Geert! The article is really helpful.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Join & Write a Comment

This course is ideal for IT System Administrators working with VMware vSphere and its associated products in their company infrastructure. This course teaches you how to install and maintain this virtualization technology to store data, prevent vuln…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month