Использование анонимной темы в Delphi для мигания метки - PullRequest
0 голосов
/ 23 января 2020

Мне нужно сделать ярлык, чтобы мигать 5 раз с помощью нити.

Когда я нажимаю на кнопку, мне нужно, чтобы ярлык мигал 5 раз.

Теперь у меня проблема ,

при закрытии формы происходит утечка памяти в потоке.

Что я здесь не так делаю?

type
  TForm1= class(TForm)
  ...
  labelNewMsg:Tlabel;
  private
    MEvent: TEvent;

procedure Torm1.FormCreate(Sender: TObject);
begin
  MEvent := TEvent.Create(nil, False, False, '');
  waitNewMessage();
end;  

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MEvent.Free;
end;

procedure TForm1.ButtonDoSetEventClick(Sender: TObject);
begin
 Mevent.SetEvent;
end;


procedure TForm1.waitNewMessage;
var
    Status:TWaitResult;
begin
     TThread.CreateAnonymousThread(
        procedure
        var IntCnt: Integer;
        begin
           while not TThread.CurrentThread.CheckTerminated and (not application.terminated) do begin
            Sleep(100);
            Status:=MEvent.WaitFor(INFINITE);
            if Status=wrSignaled then begin
              for IntCnt:=1 to 5 do begin
                Sleep(1000);
                TThread.Synchronize(nil,procedure begin
                  labelNewMsg.Visible:=not labelNewMsg.Visible;
                end);
              end;
              IntCnt:=0;
              MEvent.ResetEvent;
            end;
           end;
        end
      ).Start;
end;

Привет, я создал второй вариант, но У меня та же проблема:

procedure TFrm_PrincipalDemo.waitNewMessage;
var
    Status:TWaitResult;
begin
      TThread.CreateAnonymousThread(
        procedure
        var IntCnt: Integer;
        begin
           while MEvent.WaitFor(INFINITE) in [wrSignaled] do begin
              if TThread.CurrentThread.CheckTerminated then exit;
              MEvent.ResetEvent;
              Sleep(100);
              for IntCnt:=1 to 5 do begin
                Sleep(1000);
                TThread.Synchronize(nil,procedure begin
                  labelNewMsg.Visible:=not labelNewMsg.Visible;
                end);
              end;
              if TThread.CurrentThread.CheckTerminated then exit;
           end;
        end
      ).Start;
end;

1 Ответ

5 голосов
/ 23 января 2020

Вы не сигнализируете потоку о том, что он завершает себя до закрытия вашей Формы. Например, если поток заблокирован в ожидании 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;
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...