Когда вручную освобождать тему

Question

Если я создаю (приостановленный) поток из основного потока как таковой:

  with TMyThread.Create(True) do
  begin
    OnTerminate := ThreadTerminated;
    FreeOnTerminate := False;
    Start;
  end;

Как мне освободить этот экземпляр после его завершения? (т. е. процедура Execute завершила выполнение - предположим, что я перехватил исключения).

Правильный способ уничтожения ссылки на объект tthread показывает способ (с помощью процедуры PostMessage), который работает нормально и имеет смысл. Однако, что если я создаю поток, и у меня нет дескриптора формы или чего-то еще, где я могу вызвать процедуру PostMessage. Например, я создаю поток внутри класса, произошедшего непосредственно от TObject?

TMyClass = class
public
  procedure DoSomething;
end;

TMyClass.DoSomething;
begin
      with TMyThread.Create(True) do
      begin
        OnTerminate := ThreadTerminated;
        FreeOnTerminate := False;
        Start;
      end;  
end;

Итак, я думаю, как мне освободить поток без доступа к дескриптору формы?

Спасибо

Answer 1

Очевидно, что где-то должна быть ссылка на созданный поток. Но я могу относиться к вашему желанию: вы хотите, чтобы решение всегда делалось без забот.

Я предлагаю вам управлять существованием потока отдельным классом ThreadController:

unit Unit2;

interface

uses
  Classes, SysUtils, Forms, Windows, Messages;

type
  TMyThreadProgressEvent = procedure(Value: Integer;
    Proceed: Boolean) of object;

procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);

implementation

type
  TMyThread = class(TThread)
  private
    FException: Exception;
    FOnProgress: TMyThreadProgressEvent;
    FProceed: Boolean;
    FValue: Integer;
    procedure DoProgress;
    procedure HandleException;
    procedure ShowException;
  protected
    procedure Execute; override;
  end;

  TMyThreadController = class(TObject)
  private
    FThreads: TList;
    procedure StartThread(StartValue: Integer;
      OnProgress: TMyThreadProgressEvent);
    procedure ThreadTerminate(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  FMyThreadController: TMyThreadController;

function MyThreadController: TMyThreadController;
begin
  if not Assigned(FMyThreadController) then
    FMyThreadController := TMyThreadController.Create;
  Result := FMyThreadController
end;

procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
begin
  MyThreadController.StartThread(StartValue, OnProgress);
end;

{ TMyThreadController }

constructor TMyThreadController.Create;
begin
  inherited;
  FThreads := TList.Create;
end;

destructor TMyThreadController.Destroy;
var
  Thread: TThread;
begin
  while FThreads.Count > 0 do
  begin
    Thread := FThreads[0]; //Save reference because Terminate indirectly
                           //extracts the list entry in OnTerminate!
    Thread.Terminate; //Indirectly decreases FThreads.Count
    Thread.Free;
  end;
  FThreads.Free;
  inherited Destroy;
end;

procedure TMyThreadController.StartThread(StartValue: Integer;
  OnProgress: TMyThreadProgressEvent);
var
  Thread: TMyThread;
begin
  Thread := TMyThread.Create(True);
  FThreads.Add(Thread); //Add to list before a call to Resume because once
                        //resumed, the thread might be gone already!
  Thread.FValue := StartValue;
  Thread.FOnProgress := OnProgress;
  Thread.OnTerminate := ThreadTerminate;
  Thread.Resume;
end;

procedure TMyThreadController.ThreadTerminate(Sender: TObject);
begin
  FThreads.Extract(Sender);
end;

{ TMyThread }

procedure TMyThread.DoProgress;
begin
  if (not Application.Terminated) and Assigned(FOnProgress) then
    FOnProgress(FValue, FProceed);
end;

procedure TMyThread.Execute;
begin
  try
    FProceed := True;
    while (not Terminated) and (not Application.Terminated) and FProceed and
      (FValue < 20) do
    begin
      Synchronize(DoProgress);
      if not FProceed then
        Break;
      Inc(FValue);
      Sleep(2000);
    end;
    //In case of normal execution ending, the thread may free itself. Otherwise,
    //the thread controller object frees the thread.
    if not Terminated then
      FreeOnTerminate := True;
  except
    HandleException;
  end;
end;

procedure TMyThread.HandleException;
begin
  FException := Exception(ExceptObject);
  try
    if not (FException is EAbort) then
      Synchronize(ShowException);
  finally
    FException := nil;
  end;
end;

procedure TMyThread.ShowException;
begin
  if GetCapture <> 0 then
    SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
  if (FException is Exception) and (not Application.Terminated) then
    Application.ShowException(FException)
  else
    SysUtils.ShowException(FException, nil);
end;

initialization

finalization
  FreeAndNil(FMyThreadController);

end.

Для запуска этого примера потока, который считает от 5 до 19 с интервалом в 2 секунды и обеспечивает обратную связь и возможность преждевременного завершения, вызовите из основного потока:

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure MyThreadProgress(Value: Integer; Proceed: Boolean);
  end;

...

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunMyThread(5, MyThreadProgress);
end;

procedure TForm1.MyThreadProgress(Value: Integer; Proceed: Boolean);
begin
  Caption := IntToStr(Value);
end;

Этот поток автоматически убивает себя при завершении потока или приложения.

Может быть, этот блок немного излишним для вашей ситуации, потому что он способен обрабатывать несколько потоков (одного типа), но я думаю, что он отвечает на ваш вопрос. Отрегулируйте по своему вкусу.

^{Частичное происхождение этого ответа: NLDelphi.com.}