Question

我的问题是，如果一个帖子快速将消息发布到主UI线程，如果我当时更新了UI，有时主消息队列会被卡住（我没有更好的词来形容这个）。

以下是简化的repro代码：

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被更新，除非我添加Label1.Update;并且主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中）。

问题在于，如果我在meany文件中搜索，并且搜索字符串很短（例如＆＃34; a＆＃34;） - 找到了很多匹配项。忙碌循环while FileStream.Read(Ch,1)= 1 do正在快速发布消息（TH_FOUND）并将其充满消息队列。

实际上没有到达消息队列的消息。正如@Sertac所提到的那样＃34;默认情况下，消息队列的限制为10000＆＃34;。

来自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]值并调用GetLastError if {{ 1}}返回PostMessage。如果邮件队列已满，False应返回GetLastError。

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

2 个答案: