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.
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
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.
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.
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.
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.
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.
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
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.
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.
Comments (5)
Commented:
God bless you
I voted yes
Commented:
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
Commented:
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:
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: