在TThread.FreeOnTerminate上设置/更改TThread.OnTerminate

Question

我一直试图在FreeOnTerminate属性中设置 OnTerminate过程，但似乎设置它为时已晚，或者完全忽略了write过程。

如何在FreeOnTerminate 过程中设置/更改OnTerminate属性？有什么解决办法吗？

一个小小的代码：

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure OnTestThreadTerminate (Sender : TObject);
  public
    { Public declarations }
  end;

type
  TTestThread = class (TThread)
  public
    procedure Execute; override;
end;


var
  Form2: TForm2;
  GlobalThreadTest : TTestThread;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  GlobalThreadTest                    := TTestThread.Create (True);
  GlobalThreadTest.OnTerminate        := Self.OnTestThreadTerminate;
  GlobalThreadTest.FreeOnTerminate    := True;
  GlobalThreadTest.Resume;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  // 2nd Button to try to free the thread...
  // AFTER BUTTON1 has been clicked!
  try
    GlobalThreadTest.Free;
  except
    on e : exception do begin
      MessageBox(Self.Handle, pchar(e.Message), pchar(e.ClassName), 64);
    end;
  end;
end;

procedure TForm2.OnTestThreadTerminate(Sender: TObject);
begin
  TTestThread(Sender).FreeOnTerminate := False;                        // Avoid freeing...
  ShowMessage (BoolToStr (TTestThread(Sender).FreeOnTerminate, True)); // FreeOnTerminate Value has been changed successfully!
end;

procedure TTestThread.Execute;
begin
  // No code needed for test purposes.
end;

end.

Answer 1

如果您查看ThreadProc在Classes.pas中的来源，您会发现在调用DoTerminate中的OnTerminate事件之前，FreeOnTerminate被求值为局部变量Freethread。

调用DoTerminate之后，根据现在过时的变量：if FreeThread then Thread.Free;释放线程。

您可以在不使用FreeOnTerminate的情况下启动线程，并使用PostMessage与自己的消息一起使用，例如在OnTerminate中调用WM_MyKillMessage (WM_APP + 1234)，以便在离开OnTerminate事件后释放线程。

这看起来可能是：

const
  WM_KillThread = WM_APP + 1234;
type

  TTestThread = class (TThread)
  public
    procedure Execute; override;
    Destructor Destroy;override;
end;
  TForm2 = class(TForm)
    ............... 
  public
    { Public-Deklarationen }
    procedure WMKILLTHREAD(var Msg:TMessage);message WM_KillThread;
  end;


procedure TForm2.OnTestThread(Sender: TObject);
begin
  ShowMessage ('OnTestThread');
  PostMessage(handle,WM_KillThread, WPARAM(Sender), 0);
end;

procedure TForm2.WMKILLTHREAD(var Msg: TMessage);
begin
   TTestThread(Msg.WParam).Free;
end;

destructor TTestThread.Destroy;
begin
  ShowMessage ('Destroy');
  inherited;
end;

Answer 2

FreeOnTerminate是在Execute()退出后，但在调用DoTerminate()以触发OnTerminate事件之前计算的。您可以在FreeOnTerminate退出之前更改Execute()，这样就太晚了。因此，解决办法是从OnTerminate内部手动触发Execute()，例如：

type
  TTestThread = class (TThread)
  public
    procedure Execute; override;
    procedure DoTerminate; override;
  end;

​

procedure TTestThread.Execute;
begin
  try
    ...
  finally
    // trigger OnTerminate here...
    inherited DoTerminate;
  end;
end;

procedure TTestThread.DoTerminate;
begin
  // prevent TThread from triggering OnTerminate
  // again by not calling inherited here...
end;

唯一的缺点是，如果在调用Terminate()之前调用了Execute()，那么TThread将跳过Execute()，但它仍然会调用重写的DoTerminate()。

Answer 3

想必，您希望在某种情况下设置FreeOnTerminate False，但让它保持为真。如果该条件可能取决于它的终止是自然的(在没有干预的情况下正常执行)还是手动的(调用终止)，那么我建议您执行完全相反的操作:使用FreeOnTerminate = False创建线程，并在Terminated属性为False时设置为True：

procedure TTestThread.Execute;
begin
  ...
  if not Terminated then
    FreeOnTerminate := True;
end;

参见它的功能，例如，在When to free a Thread manually中。