Вы не сигнализируете потоку о том, что он завершает себя до закрытия вашей Формы. Например, если поток заблокирован в ожидании MEvent
, необходимо сообщить MEvent
, чтобы поток мог проснуться и проверить его на завершение.
Свойство Application.Terminated
не установлено на True
пока основное сообщение l oop не обработает сообщение WM_QUIT
от PostQuitMessage()
, которое Application.Terminate()
вызывает. Программа Application.MainForm
вызывает Application.Terminate()
, когда Форма закрыта (не уничтожена, это происходит позже).
Если вы сохраняете ссылку на созданный вами объект TThread
, вы можете затем вызвать * Непосредственно метод 1015 *, который устанавливает для свойства Terminated
потока значение True (в противном случае вообще нет смысла вызывать TThread.CheckTerminated()
внутри потока), например:
type
TForm1 = class(TForm)
...
labelNewMsg: TLabel;
ButtonDoSetEvent: TButton;
...
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure ButtonDoSetEventClick(Sender: TObject);
...
private
MEvent: TEvent;
Thread: TThread;
procedure waitNewMessage;
procedure ThreadTerminated(Sender: TObject);
...
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MEvent := TEvent.Create(nil, False, False, '');
waitNewMessage();
end;
procedure TForm1.FormClose(Sender: TObject; Action: TCloseAction);
begin
if Thread <> nil then
begin
Thread.Terminate;
MEvent.SetEvent;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Thread <> nil then
Thread.OnTerminate := nil;
MEvent.Free;
end;
procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
MEvent.SetEvent;
end;
procedure TForm1.waitNewMessage;
begin
Thread := TThread.CreateAnonymousThread(
procedure
var
IntCnt: Integer;
Status: TWaitResult;
begin
while not TThread.CheckTerminated do begin
Sleep(100);
Status := MEvent.WaitFor(INFINITE);
if (Status = wrSignaled) and (not TThread.CheckTerminated) then begin
for IntCnt := 1 to 5 do begin
Sleep(1000);
TThread.Synchronize(nil,
procedure
begin
labelNewMsg.Visible := not labelNewMsg.Visible;
end
);
end;
end;
end;
end
);
Thread.OnTerminate := ThreadTerminated;
Thread.Start;
end;
procedure TForm1.ThreadTerminated(Sender: TObject);
begin
Thread := nil;
end;
Но на самом деле, почему Вы вообще используете нить? Ничто из того, что делает ваш поток, на самом деле не должно быть в потоке. Вместо этого будет достаточно простого таймера, и он будет безопаснее для пользовательского интерфейса и его будет легче остановить во время завершения работы программы.
type
TForm1 = class(TForm)
...
labelNewMsg: TLabel;
ButtonDoSetEvent: TButton;
NewMsgTimer: TTimer;
...
procedure ButtonDoSetEventClick(Sender: TObject);
procedure NewMsgTimerTimer(Sender: TObject);
...
end;
procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
NewMsgTimer.Tag := 0;
NewMsgTimer.Enabled := True;
end;
procedure TForm1.NewMsgTimerTimer(Sender: TObject);
begin
NewMsgTimer.Tag := NewMsgTimer.Tag + 1;
labelNewMsg.Visible := not labelNewMsg.Visible;
if NewMsgTimer.Tag = 5 then
NewMsgTimer.Enabled := False;
end;