CODEWITHSUNDEEP
delphitthread
Ben
Ben

Reputation: 3440

Set/Change TThread.FreeOnTerminate while on TThread.OnTerminate

I've been trying to to set the FreeOnTerminate property in the OnTerminate procedure but it seems like it's either too late to set it or it's completely ignoring the write procedure.

How can I set/change the FreeOnTerminate property in the OnTerminate procedure? Are there any workarounds for that?

A little code:

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.

Upvotes: 0

Views: 2202

Answers (3)

Remy Lebeau
Remy Lebeau

Reputation: 595897

FreeOnTerminate is evaluated after Execute() exits but before DoTerminate() is called to trigger the OnTerminate event. You can change FreeOnTerminate until Execute() exits, then it is too late. So a workaround would be to trigger OnTerminate manually from inside of Execute(), eg:

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;

The only gotcha is that if Terminate() is called before Execute() is called then TThread will skip Execute(), but it will still call the overridden DoTerminate().

Upvotes: 5

NGLN
NGLN

Reputation: 43649

Presumably, you want to set FreeOnTerminate False in some sort of condition, but let it otherwise stay True. If that condition by any chance depends on whether its termination is natural (Execute ended normally without intervention) or manual (Terminate is called), then I suggest you do the exact opposite: create the thread with FreeOnTerminate = False and set it True when the Terminated property is False:

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

See its functioning for example in When to free a Thread manually.

Upvotes: 3

bummi
bummi

Reputation: 27377

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;

Upvotes: 4

Related Questions