Delphi TTask.run 会阻塞界面

Question

Delphi xe10.4 TTask.run 会阻塞界面

找不到原因 运行几十次才出现一次阻塞

unit UTask;

interface
uses
  System.Classes,Vcl.Forms,System.SysUtils,DateUtils,winapi.shellapi,winapi.Windows,

  System.Threading,System.Generics.Collections, System.Generics.Defaults,obj,TURING_TLB,Ualone;
  const
  WM_MSG        =1280;    //通知消息
  WM_UPDATE     =0;       //通知更新
  WM_STOP       =1;       //通知停止
  WM_BACKROLL   =2;       //通知重新运行
  UI_ADD        =0;       //UI增加
  UI_DELEAT     =1;       //UI删除
  UI_UPDATE     =2;       //UI更新

Type
  TaskMsgState=(UI_PARTMSG,TD_UNSTART,TD_ISOVER,TD_STARTING,TD_RUNNING,TD_PAUSEING,TD_PAUSE,TD_RECOVERING,TD_STOPING);
  TTaskMsg=record
    taskNum:integer;//执行的编号
    id:Integer;//序号

  end;

  TMyTask = class(TTask)
  private

    isPause:boolean;      //是否暂停
    MyITask:ITask;// 启动后的句柄
    procedure Execute;
  public
    _TaskMsg: TTaskMsg;
    _body:Pointer;
    ThreadID:Integer;//线程句柄
    iniName:String; //配置文件名字
    constructor Create(TaskMsg: TTaskMsg);
    function Start(): ITask;
    property Pause:Boolean read isPause write isPause;   //是否暂停
    procedure stop;                    //停止
    function readOver():boolean;        //判断是否停止
    procedure noticeOver();  //通知主线程已经完成
    procedure setTask(Task:string);  //设置任务状态
    procedure setTaskMsg(t:TTaskMsg); //重设taskmsg
    procedure post(WParam:integer);      //多线程控制异步通知UI
    procedure send(WParam:integer);      //多线程控制同步通知UI
end;


var
  taskList: TObjectList<TMyTask>;
  tasks: TArray<ITask>;
  dm:Tzai;
  tl:OleVariant;
implementation
uses
  Ubody,Frame;
{ TMyTask }

constructor TMyTask.Create(TaskMsg: TTaskMsg);
begin
  _TaskMsg := TaskMsg;
  Self.isPause:=False;
  Self.iniName:='当前配置';
end;

procedure TMyTask.Execute;
var
  i:Integer;
  temp:Pointer;
begin
	//阻塞的时候并不会执行到此处
  OutputDebugString('-------------------执行体--1----------------------------');
  temp:=@self;
  OutputDebugString('-------------------执行体--2----------------------------');
  Tbody(_body):=Tbody.Create(temp);
  OutputDebugString('-------------------执行体--3----------------------------');
  ThreadID:=GetCurrentThreadID;
  OutputDebugString('-------------------执行体--4----------------------------');
  Tbody(_body).firing;
  Tbody(_body).Free;

end;


procedure TMyTask.noticeOver;
begin
  self.isPause   :=false;
  _TaskMsg.status    :=TD_ISOVER;
  self.post(WM_UPDATE);
end;

procedure TMyTask.post(WParam: integer);
begin
  postmessage(_TaskMsg.msghandle,1280,WParam, _TaskMsg.id);
end;

function TMyTask.readOver: boolean;
begin
  if (self.CurrentTask.Status=TTaskStatus.Completed)
  or (self.CurrentTask.Status=TTaskStatus.Canceled) then
    result:=True
  else
    result:=False;

end;

procedure TMyTask.send(WParam: integer);
begin
  sendmessage(_TaskMsg.msghandle,1280,WParam, _TaskMsg.id);
end;

procedure TMyTask.setTask(Task: string);
begin
  try
    _TaskMsg.task:=task;
    self.post(WM_UPDATE);
  except

  end;
end;

procedure TMyTask.setTaskMsg(t: TTaskMsg);
begin
  Self._TaskMsg:=t;
end;

function TMyTask.Start(): ITask;
begin
  self._TaskMsg.status:=TD_STARTING;
  OutputDebugString('-------------------启动线程--通知主界面开始----------------------------');
  self.post(WM_UPDATE);
  if IsWindow(self._TaskMsg.winHandle)=false then
  begin
    result:=self.MyITask;
    FrmMain.butRefresh.onClick(FrmMain);
    exit;
  end;

  OutputDebugString('-------------------启动线程--运行TTask.run----------------------------');
  self.MyITask:=TTask.Run(Execute);  //就是这里会阻塞界面!!!!!!!!!!!!!!!!!!!!!!!!!!!
  OutputDebugString('-------------------启动线程--运行TTask.run--结束----------------------------');
  Result :=self.MyITask

end;


procedure TMyTask.stop;
begin
  self.isPause:=False;

  if self.MyITask<>nil then
  begin
    OutputDebugString('TTask.CurrentTask 停止');
    self.MyITask.Cancel;
    self._TaskMsg.status:=TD_ISOVER;
    self.post(WM_UPDATE);
  end
  else
    OutputDebugString('TTask.CurrentTask 为空');
end;

end.

Answer 1

替换这一行：
self.MyITask:=TTask.Run(Execute);
使用这些行：
TThread.CreateAnonymousThread(Execute).Start;
Self.MyITask := TTask.CurrentTask;
这将创建一个匿名线程并启动它。然后，它会将当前任务分配给MyITask您之前正在做的事情。但是，由于线程现在是匿名创建的，因此它不应导致 UI 阻塞。