线程向主 UI 线程发布消息被阻止/删除

Question

我的问题是，如果一个线程快速将消息发布到主 UI 线程并且如果我在那个时候更新 UI，有时主消息队列会卡住（我没有更好的词来描述这）。

这是简化的重现代码：

const
  TH_MESSAGE = WM_USER + 1; // Thread message
  TH_PARAM_ACTION = 1;
  TH_PARAM_FINISH = 2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    ThreadHandle: Integer;
    procedure ThreadMessage(var Message: TMessage); message TH_MESSAGE;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ThreadProc(Parameter: Pointer): Integer;
var
  ReceiverWnd: HWND;
  I: Integer;
  Counter: Integer;
begin
  Result := 0;
  ReceiverWnd := Form1.Handle;
  Counter := 100000;
  for I := 1 to Counter do
  begin
    PostMessage(ReceiverWnd, TH_MESSAGE, TH_PARAM_ACTION, I);
    //Sleep(1); // <- is this the cure?
  end;
  PostMessage(ReceiverWnd, TH_MESSAGE, TH_PARAM_FINISH, GetCurrentThreadID);
  OutputDebugString('Thread Finish OK!'); // <- I see this
  EndThread(0);
end;

procedure TForm1.ThreadMessage(var Message: TMessage);
begin
  case Message.WParam of
    TH_PARAM_ACTION:
      begin
        Label1.Caption := 'Action' + IntToStr(Message.LParam);
        //Label1.Update;
      end;
     TH_PARAM_FINISH:
       begin
         OutputDebugString('ThreadMessage Finish'); // <- Dose not see this
         Button1.Enabled := True;
         CloseHandle(ThreadHandle);
       end;
  end;    
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadId: LongWord;
begin
  Button1.Enabled := False;
  ThreadId := 1;
  ThreadHandle := BeginThread(nil, 0, @ThreadProc, nil, 0, ThreadId);
end;

我确实意识到工作线程循环非常繁忙。我认为由于线程发布消息到主 UI 线程，它（主 UI 线程）有机会在从工作线程接收其他消息的同时处理它的消息。
当我增加计数器时，问题会升级。

问题：
除非我添加 Label1.Update，否则我永远不会看到 Label1 被更新；并且主 UI 被阻止。
TH_PARAM_ACTION 永远不会达到 100000（在我的情况下） - 随机高于 90000。
TH_PARAM_FINISH 永远不会进入消息队列。
显然CPU使用率非常高。

问题：
处理这种情况的正确方法是什么？从工作线程发布的消息是否已从消息队列中删除（如果是，那么为什么）？
循环中的Sleep(1) 真的可以解决这个问题吗？如果是，那么为什么1？ （0 没有）

---

好的。感谢@Sertac 和@LU，我现在意识到消息队列有限制，现在检查来自PostMessage 和ERROR_NOT_ENOUGH_QUOTA 的结果。但是，主UI 仍然没有响应！

function ThreadProc(Parameter: Pointer): Integer;
var
  ReceiverWnd: HWND;
  I: Integer;
  Counter: Integer;
  LastError: Integer;
  ReturnValue, Retry: Boolean;
begin
  Result := 0;
  ReceiverWnd := Form1.Handle;
  Counter := 100000;
  for I := 1 to Counter do
  begin
    repeat
      ReturnValue := PostMessage(ReceiverWnd, TH_MESSAGE, TH_PARAM_ACTION, I);
      LastError := GetLastError;
      Retry := (not ReturnValue) and (LastError = ERROR_NOT_ENOUGH_QUOTA);
      if Retry then
      begin
        Sleep(100); // Sleep(1) is not enoght!!!
      end;
    until not Retry;
  end;
  PostMessage(ReceiverWnd, TH_MESSAGE, TH_PARAM_FINISH, GetCurrentThreadID);
  OutputDebugString('Thread Finish OK!'); // <- I see this
  EndThread(0);
end;

---

仅供参考这是我正在检查的原始代码：
Delphi threading by example

此示例在文件中搜索文本（同时搜索 5 个线程）。显然，当您执行这样的任务时，您必须看到所有匹配的结果（例如在 ListView 中）。

问题是，如果我在普通文件中搜索，并且搜索字符串很短（如“a”） - 会找到普通匹配项。繁忙的循环 while FileStream.Read(Ch,1)= 1 do 正在快速发布消息 (TH_FOUND) 与匹配并淹没 消息队列。

实际上没有进入消息队列的消息。正如@Sertac 提到的“默认情况下，消息队列的限制为 10000”。

来自 MSDN PostMessage

每个消息队列的发布消息限制为 10,000 条。这 限制应该足够大。如果您的申请超过 限制，应该重新设计以避免消耗这么多系统 资源。要调整此限制，请修改以下注册表项 (USERPostMessageLimit)

正如其他人所说，应该重新设计此代码/模式。

Answer 1

您正在以大于处理消息的速度淹没消息队列。最终队列变满了。

如果您绝对需要由主线程处理每条消息，则需要维护自己的队列。而且您可能需要限制添加到队列中的线程。

您的Sleep(1) 会节流，但以非常粗暴的方式。也许它会节流太多，也许不够。一般来说，您需要更精确地限制节流。通常，您会通过跟踪队列的大小来自适应地节流。如果可以避免节流，请这样做。它很复杂，很难很好地实现，并且会损害性能。

如果有另一个线程准备好运行，调用Sleep(0) 将产生。否则Sleep(0) 无效。来自文档

零值会导致线程将其时间片的剩余部分交给任何其他准备运行的线程。如果没有其他线程准备运行，则函数立即返回，线程继续执行。

另一方面，如果您只需要在 GUI 中报告状态，那么您应该完全避免排队。不要从线程发布消息到主线程。只需在主线程中运行一个 GUI 更新计时器，然后让主线程向工作人员询问他们的当前状态。

将这个想法应用到您的代码中会产生这样的结果：

const
  TH_MESSAGE = WM_USER + 1; // Thread message
  TH_PARAM_FINISH = 2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure ThreadMessage(var Message: TMessage); message TH_MESSAGE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  Count: Integer;

function ThreadProc(Parameter: Pointer): Integer;
var
  ReceiverWnd: HWND;
  I: Integer;
begin
  Result := 0;
  ReceiverWnd := Form1.Handle;
  for I := 1 to high(Integer) do
  begin
    Count := I;
  end;
  PostMessage(ReceiverWnd, TH_MESSAGE, TH_PARAM_FINISH, GetCurrentThreadID);
end;

procedure TForm1.ThreadMessage(var Message: TMessage);
begin
  case Message.WParam of
  TH_PARAM_FINISH:
    begin
      Button1.Enabled := True;
      Timer1.Enabled := False;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := 'Action' + IntToStr(Count);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadId: LongWord;
  ThreadHandle: THandle;
begin
  Count := -1;
  Button1.Enabled := False;
  ThreadHandle := BeginThread(nil, 0, @ThreadProc, nil, 0, ThreadId);
  CloseHandle(ThreadHandle);
  Timer1.Enabled := True;
end;

Answer 2

处理这种情况的正确方法是什么？是否发布消息 从正在从消息队列中删除的工作线程（如果是， 那为什么）？

可能淹没消息队列的代码很臭，应该重新设计，但如果你真的需要处理这种情况，你可以检查PostMessage返回的[boolean]值，如果PostMessage返回@987654324，则调用GetLastError @。如果消息队列已满，GetLastError 应该返回 ERROR_NOT_ENOUGH_QUOTA。