0

我一直在尝试在FreeOnTerminate程序中设置该属性，但似乎设置它为时已晚，或者它完全忽略了该程序。OnTerminatewrite

如何在程序中设置/更改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.
4

3 回答 3

5

FreeOnTerminateExecute()在退出之后被评估，但在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()。

于 2013-11-25T16:22:38.740 回答
4

If you take a look to the sources of ThreadProc in Classes.pas, you will find that FreeOnTerminate is evaluated to a local variable Freethread before calling the OnTerminate event in DoTerminate.
After calling DoTerminate the thread is freed depending of the now outdated variable: if FreeThread then Thread.Free;.
You could start the thread without FreeOnTerminate and use PostMessage with an own message e.g. WM_MyKillMessage (WM_APP + 1234) called in OnTerminate to free the thread after leaving the OnTerminate event.

This could look like:

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;
于 2013-11-25T06:49:50.203 回答
3

大概，您想FreeOnTerminate在某种条件下设置 False，但在其他情况下让它保持 True。如果该条件取决于它的终止是自然的（执行正常结束而无需干预）还是手动（调用终止），那么我建议您做完全相反的事情：创建线程并在属性为 FalseFreeOnTerminate = False时将其设置为 True Terminated：

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

例如，在何时手动释放线程中查看其功能。

于 2013-11-25T17:34:58.910 回答