delphi Parallel 之 TTask 初试

Posted 2020-10-06 jjw

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  System.Generics.Collections;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
    { Public declarations }
  end;


var
  Form1: TForm1;



implementation

{$R *.dfm}

uses
  System.Threading, System.SyncObjs, System.Diagnostics;

procedure TForm1.Button1Click(Sender: TObject);
const
  C = 1000;
var
  TaskArray: array of ITask;
  I: Integer;
  ATask: ITask;
begin
  Button1.Enabled := False;

  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;

  SetLength(TaskArray, C);

  for I := 0 to C - 1 do
  begin
    TaskArray[I] := TTask.Create(procedure
      var
        Id: string;
      begin
        Id := TThread.Current.ThreadID.ToString;
        TThread.Queue(nil, procedure
          begin
            if Memo1.Lines.IndexOf(Id)=-1 then
              Memo1.Lines.Add(Id);
            //Memo2.Lines.Add( IntToStr(Memo2.Lines.Count+1) );
          end);
      end);
    TaskArray[I].Start;
  end;

  TThread.CreateAnonymousThread(procedure
    var
      I: Integer;
      Task: ITask;
    J: Integer;
    begin
      I := C;
      while I > 0 do
      begin
        for Task in TaskArray do
          if Task.Status = TTaskStatus.Completed then
            Dec(I);
      end;

      TThread.Synchronize(nil, procedure
        begin
          Memo1.Lines.Add(‘OK‘);
          Button1.Enabled := True;
        end);

      //否则有内存泄漏
      for J := 0 to C - 1 do
        TaskArray[J] := nil;
     end).Start;

  if TTask.WaitForAll(TaskArray) then
    Memo1.Lines.Add(‘WaitForAll‘);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
end;



end.

输出结果

1 WaitForAll
2 7120
3 7064
4 7052
5 OK
6 3272

有时候，输出结果是：

1 WaitForAll
2 7064
3 7120
4 3272
5 7052
6 OK

测试结果：

1  WaitForAll  不会阻塞主线程。

2  100 个 TTask 不会创建100个线程，不用写代码就可得到 【线程池】 一样的功能！

3  无法判断 Task 全部结束？？

4  线程中涉及到 【接口】时要多注意！

 

测试环境：

win10 + delphi 10.1 berlin