delphi7 线程应用
Have you ever had your Delphi form/application just hanging while waiting for data to load?
您是否曾经在等待数据加载时挂起了Delphi表单/应用程序?
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
其次,我将添加第一步,将数据加载分为两个过程:GatheringData和ShowingData
Last, I'll use a thread inside the GatheringData procedure
最后,我将在GatheringData过程中使用一个线程
1.令人讨厌的应用 (1. The irritating application)
该应用程序将一些数据加载到stringgrid中。It takes about 30 seconds to create the data in the stringlist
在字符串列表中创建数据大约需要30秒
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.
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
2.分离加载数据过程 (2. Separating the loading data procedure)
创建/加载数据后,必须在网格中填充数据。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.
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.
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.添加后台线程以加载数据 (3. Adding a background thread 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.
4.添加反馈 (4. Adding 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.
Here is the changed code and dfm for the mainunit (with the progressbar).
这是主机的更改代码和dfm(带有进度条)。
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
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.
I hope threads provide some fun in future projects.
我希望线程可以在将来的项目中提供一些乐趣。
G
G
delphi7 线程应用