... function ImInThreadWaitOrRunning(xxxxThread : TThread type ):boolean; begin result := xxxxThread.Running or Waiting.... end
... "Close" event:
onClose ... begin // CanClose := NOT(ImInThreadWaitOrRunning(zzzThread)); // end;
.... procedure TForm1.BtnThreadTerminateClick(Sender: TObject); begin if Assigned(MyThreadAnonimous) then begin MyThreadAnonimous.Terminate; // MyThreadAnonimous := nil; // // Self.Close; // ok // Application.Terminate; // ok // Halt; // AV... end; end;
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3
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; OriginalCloseQuery: procedure(Sender: TObject; var CanClose: Boolean) of Object;
class procedure TGenericThread.NewCloseQuery(Sender: TObject; var CanClose: Boolean); var I: Integer; Thread: TThread; begin CritSect.Enter; if ThreadList.Count <> 0 then begin CanClose := False; //还有线程没释放的情况下,暂时不关闭主Form MainFormClosing := True; for i := 0 to ThreadList.Count-1 do begin Thread := ThreadList[I]; 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;
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;
6楼的东西做得挺有用的, for i := 0 to ThreadList.Count-1 do begin Thread := ThreadList[I]; Thread.Terminate; end; 1。这个改成downto更好一点,按栈的形式处理虽然不能完全解决万一有线程会建立线程对象又被其它再参照或线程内建锁的问题,但后面的先关总是能解决多数较简单的问题,放心一点儿。 2。不要用FreeOnTerminate := True;把Thread.Terminate;用三行代替, Thread.Terminate; Thread.waitfor; Thread.Free; 这个还是一个一个关,再配合一下上面的倒序更安全。毕竟我们不知道Thread.Free;会释放些啥。