delphi7 线程应用_添加用于在后台将数据加载到Delphi应用程序的线程

cunchi8090

于 2020-07-19 12:34:31 发布

阅读量485

点赞数

文章标签：列表 python java 甘特图 .net

原文链接：https://www.experts-exchange.com/articles/6613/Adding-threads-for-loading-data-in-background-to-a-delphi-application.html

版权

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.

我希望线程可以在将来的项目中提供一些乐趣。

翻译自: https://www.experts-exchange.com/articles/6613/Adding-threads-for-loading-data-in-background-to-a-delphi-application.html

delphi7 线程应用

cunchi8090

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
delphi7 线程应用_添加用于在后台将数据加载到Delphi应用程序的线程

delphi7 线程应用 Have you ever had your Delphi form/application just hanging while waiting for data to load? 您是否曾经在等待数据加载时挂起了Delphi表单/应用程序？ This is the article to...
复制链接

扫一扫