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

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线程示例

此示例搜索文件中的文本(同时5个线程).显然,当你创建这样的任务时,你必须看到所有匹配的结果(例如在ListView中).

问题是,如果我在meany文件中搜索,并且搜索字符串很短(如"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;