我可以从非 UI 线程安全地启用 TTimer 吗？

Question

我在 Windows 10 上使用 Delphi XE7。

下面的代码我用了很久了，刚刚看了SetTimer()上的文档。简单地说，我是从非 UI 线程设置计时器，但微软的文档说它们应该只在 UI 线程上设置。广泛的测试表明我的代码工作正常，但我不能相信我的系统与其他系统的行为相同，或者 Microsoft 文档是 100% 准确的。任何人都可以验证此代码是否正常？

Delphi 代码不会死锁，它几乎只是调用SetTimer()（我知道有一个竞争条件设置TTimer.FEnabled）。

MSDN documentation 说：

hWnd

类型：HWND

要与计时器关联的窗口句柄。此窗口必须由调用线程拥有。

我想要完成的是工作线程在做一些事情，并且在适当的时候，它们会通知主线程必须更新 UI 的元素，并且主线程会更新 UI。我知道如何使用TThread.Synchronize()，但在某些情况下可能会发生死锁。我可以在工作线程中使用PostMessage() 并在 UI 线程中处理消息。

Delphi 中还有其他方式通知和更新 UI 线程吗？

unit FormTestSync;

interface
uses SysUtils, Classes, Forms, StdCtrls, ExtCtrls, Controls;

type
  TypeThreadTest = class(TThread)
    protected
      procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
      timer_update: TTimer;
      Label1: TLabel;
      procedure timer_updateTimer(Sender: TObject);
      procedure FormCreate(Sender: TObject);
    private
      m_thread: TypeThreadTest;
      m_value: integer;

    private
      procedure Notify(value: integer);
    public
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TypeThreadTest.Execute;
begin
  while (not terminated) do begin
    //do work...
    form1.Notify(random(MaxInt));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  timer_update.enabled := false;
  timer_update.interval := 1;
  m_thread := TypeThreadTest.Create();
end;

procedure TForm1.Notify(value: integer);
begin
  //run on worker thread
  //Race conditions here, I left out the synchronization for simplicity
  m_value := value;
  timer_update.Enabled := true;
end;

procedure TForm1.timer_updateTimer(Sender: TObject);
begin
  timer_update.Enabled := false;
  label1.Caption := IntToStr(m_value);
end;

end.

Answer 1

TTimer 正在主 UI 线程中构建，此时 TForm 在其 DFM 资源中流式传输。 TTimer 的构造函数创建一个内部 HWND 供计时器接收 WM_TIMER 消息。 HWND 因此归主 UI 线程所有。

TForm.Notify() 将计时器的Enabled 属性设置为true，这将调用SetTimer()。 Notify() 是在工作线程的上下文中调用的，而不是主 UI 线程。如SetTimer()'s documentation 所述，此不应该起作用。只有主 UI 线程才能启动定时器运行，因为主 UI 线程拥有定时器的 HWND。

TTimer.UpdateTimer()，由计时器的Enabled、Interval 和OnTimer 属性的设置器在内部调用，如果SetTimer() 失败，将引发EOutOfResources 异常。所以，在TypeThreadTest.Execute() 中调用form1.Notify() 不应该 工作。在这种情况下不会调用SetTimer() 的唯一方法是：

• Interval 为 0
• Enabled 是 false
• OnTimer 未分配

否则，您的工作线程应该崩溃。

正如您所指出的，当您的工作线程想要通知主 UI 线程执行某些操作时，它可以交替使用 TThread.Synchronize()（或 TThread.Queue()）或 PostMessage()（或 SendMessage()）。这些是可行且优选的解决方案。就个人而言，我会选择TThread.Queue()，例如：

unit FormTestSync;

interface

uses
  SysUtils, Classes, Forms, StdCtrls, ExtCtrls, Controls;

type
  TypeThreadTest = class(TThread)
  protected
    procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    m_thread: TypeThreadTest;
  private
    procedure Notify(value: integer);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TypeThreadTest.Execute;
begin
  while not Terminated do begin
    //do work...
    Form1.Notify(random(MaxInt));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_thread := TypeThreadTest.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  m_thread.Terminate;
  m_thread.WaitFor;
  m_thread.Free;
end;

procedure TForm1.Notify(value: integer);
begin
  //runs on worker thread
  TThread.Queue(nil,
    procedure
    begin
      //runs on main UI thread
      Label1.Caption := IntToStr(value);
    end
  );
end;

end.

如果您想使用TTimer 代替这项工作，您可以简单地在主 UI 线程中启用计时器并将其保持启用状态，然后同步对计时器定期访问的数据的访问。那将是非常安全的，例如：

unit FormTestSync;

interface

uses
  SysUtils, Classes, Forms, StdCtrls, ExtCtrls, Controls, SyncObjs;

type
  TypeThreadTest = class(TThread)
  protected
    procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
    timer_update: TTimer;
    Label1: TLabel;
    procedure timer_updateTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    m_thread: TypeThreadTest;
    m_value: integer;
    m_updated: boolean;
    m_lock: TCriticalSection;
  private
    procedure UpdateValue(value: integer);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TypeThreadTest.Execute;
begin
  while not Terminated do begin
    //do work...
    Form1.UpdateValue(random(MaxInt));
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  m_lock := TCriticalSection.Create;
  timer_update.Interval := 100;
  timer_update.Enabled := true;
  m_thread := TypeThreadTest.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  m_thread.Terminate;
  m_thread.WaitFor;
  m_thread.Free;
  m_lock.Free;
end;

procedure TForm1.UpdateValue(value: integer);
begin
  //runs on worker thread
  m_lock.Enter;
  try
    m_value := value;
    m_updated := true;
  finally
    m_lock.Leave;
  end;
end;

procedure TForm1.timer_updateTimer(Sender: TObject);
begin
  //runs on main UI thread
  if m_updated then
  begin
    m_lock.Enter;
    try
      Label1.Caption := IntToStr(m_value);
      m_updated := false;
    finally
      m_lock.Leave;
    end;
  end;
end;

end.

更新：

我做了一个快速测试。当SetTimer() 被另一个线程拥有的非NULL HWND 调用时，果然在Windows XP、7 和10（我没有测试Vista 或8）上，SetTimer() 成功，并且WM_TIMER/TimerProc 是在拥有HWND 的线程的上下文中调用的，而不是在调用SetTimer() 的线程的上下文中。 这不是记录在案的行为，所以不要依赖它！正如您在问题中所述，SetTimer()'s documentation 明确表示 HWND“必须由调用线程拥有”。

无论如何，TTimer 是一个 VCL 组件，而 VCL 通常本身就不是线程安全的。即使您的TTimer 代码“有效”，在主 UI 线程之外访问 UI 组件也不是一个好主意，这只是糟糕的代码设计。坚持使用已知是线程安全的替代解决方案。

Answer 2

编辑：线程安全非常困难。根据mghie的评论，我插入了AllocateHwnd()来替换self.handle。

这是我计划如何实现 UI 通知 + 更新。它并不比 TTimer 方法复杂，而且它没有我所知道的任何线程安全问题。可以为需要更新的不同项目定义不同的消息。

如果可以非常快速地发送更新通知，则需要对此主题进行变体以减少PostMessage 调用的数量。如果value 不能适应WParam，也需要进行修改。

unit FormTestSync;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms, StdCtrls,
  Controls;

type
  TypeThreadTest = class(TThread)
    protected
      procedure Execute; override;
  end;


type
  TForm1 = class(TForm)
      Label1: TLabel;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
    private
      const
        WM_UPDATE = WM_USER + 1;
      procedure OnMessage_Update(var message: TMessage);
    private
      m_thread: TypeThreadTest;
      m_hwndAlwaysThere: HWND;

    private
      procedure Notify(value: integer);
    public
  end;

var
  Form1: TForm1;


implementation
{$R *.dfm}


procedure TypeThreadTest.Execute;
begin
  while (not terminated) do begin
    //do work...
    form1.Notify(random(MaxInt));
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  m_hwndAlwaysThere := AllocateHWnd(self.OnMessage_Update);
  m_thread := TypeThreadTest.Create();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  m_thread.Terminate;
  m_thread.WaitFor;
  m_thread.Free;
  DeallocateHWnd(m_hwndAlwaysThere);
end;

procedure TForm1.Notify(value: integer);
begin
  //run on worker thread
  PostMessage(m_hwndAlwaysThere, WM_UPDATE, value, 0);
end;

procedure TForm1.OnMessage_Update(var message: TMessage);
begin
  //run on UI thread
  label1.Caption := IntToStr(message.WParam);
end;

end.