【Delphi】实现程序关闭时自动先关闭线程【20210125更新】

unit Unit1; //测试用

interface

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

type
//改为TTestThread = class(TThread)会报内存泄漏，证明线程没有自动释放
  TTestThread = class(TGenericThread)
  public
    procedure Execute; override;
  end;

  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TTestThread.Execute;
var
  I: Integer;
begin
  Sleep(Random(1000));
  while not Terminated do
  begin
    for I := 1 to 100000000 do
    begin
      Sqrt(I);
    end;
    sleep(50);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := True;
  Position := poScreenCenter;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  TTestThread.Create;
  TTestThread.Create;
  TTestThread.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 //
end;

end.

unit uGenericThread;  //实现主Form关闭时，程序自动先关闭线程, 然后才关闭主Form
                       //此单元中，线程数>0时重载了主Form的OnCloseQuery事件
interface

uses System.Classes, Generics.Collections, System.SysUtils,
     Winapi.Windows, Vcl.Forms, Winapi.Messages, System.SyncObjs;

type
  TGenericThread = class(TThread)
  private
    class procedure NewCloseQuery(Sender: TObject; var CanClose: Boolean);
  public
    constructor Create(aCreateSuspended: Boolean = False);
    destructor Destroy; override;
  end;

implementation

var
  CritSect: TCriticalSection;
  MainFormClosing: Boolean;
  ThreadList: TList<TThread>;
  OriginalCloseQuery: procedure(Sender: TObject; var CanClose: Boolean) of Object;

class procedure TGenericThread.NewCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Thread: TThread;
begin
  CritSect.Enter;
    if ThreadList.Count <> 0 then
    begin
      CanClose := False; //还有线程没释放的情况下，暂时不关闭主Form
      MainFormClosing := True;
      for Thread in ThreadList do
      begin
        Thread.Terminate;
      end;
    end;
  CritSect.Leave;
end;

//============================================================================

constructor TGenericThread.Create(aCreateSuspended: Boolean);
begin
  CritSect.Enter;
    if ThreadList.Count = 0 then
    begin   //一旦有线程创建，主Form的OnCloseQuery就使用这里定义的FormCloseQuery
      OriginalCloseQuery := Application.MainForm.OnCloseQuery;
      Application.MainForm.OnCloseQuery := NewCloseQuery;
    end;
    ThreadList.Add(Self);
  CritSect.Leave;

  inherited;
  FreeOnTerminate := True;
end;

destructor TGenericThread.Destroy;
begin
  //在FreeOnTerminate := True的情况下，Destroy的执行实际上是在线程里面进行的
  CritSect.Enter;
    ThreadList.Remove(Self); //对ThreadList的操作需要在临界保护区里完成
    if (ThreadList.Count = 0) then
    begin //一旦线程释放完毕，主Form的OnCloseQuery恢复使用原来定义的FormCloseQuery
      Application.MainForm.OnCloseQuery := OriginalCloseQuery;
      if MainFormClosing then   //线程已经释放完毕，发消息关闭主Form
        PostMessage(Application.MainForm.Handle, WM_CLOSE, 0, 0);
    end;
  CritSect.Leave;

  inherited;
end;

initialization
  MainFormClosing := False;
  ThreadList := TList<TThread>.Create;
  CritSect   := TCriticalSection.Create;

finalization
  ThreadList.Free;
  CritSect.Free;

end.