多线程 – 阻止/删除线程向主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_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,@ThreadProc,nil,ThreadId);
end;

我确实意识到工作线程循环非常繁忙.我认为,由于线程将消息发布到主UI线程,因此它(主UI线程)有机会在从工作线程接收其他消息时处理它的消息.
当我增加柜台时,问题就会升级.

问题：
除非我添加Label1.Update,否则我从未看到Label1正在更新;并且主UI被阻止.
TH_ParaM_ACTION永远不会达到100000(在我的情况下) – 随机超过90000.
TH_ParaM_FINISH永远不会进入消息队列.
显然cpu使用率非常高.

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

好.感谢@Sertac和@LU,我现在意识到消息队列有一个限制,现在使用ERROR_NOT_ENOUGH_QUOTA来检查PostMessage的结果.但是,主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,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,GetCurrentThreadID);
  OutputDebugString('Thread Finish OK!'); // <- I see this
  EndThread(0);
end;

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

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

问题是,如果我在meany文件中搜索,并且搜索字符串很短(如“a”) – 就会发现很多匹配.当FileStream.Read(Ch,1)= 1时忙碌的循环确实快速发布了消息(TH_FOUND)并且匹配并充满了
消息队列.

实际上没有到达消息队列的消息.正如@Sertac所提到的“默认情况下消息队列的限制为10000”.

来自MSDN PostMessage

There is a limit of 10,000 posted messages per message queue. This
limit should be sufficiently large. If your application exceeds the
limit,it should be redesigned to avoid consuming so many system
resources. To adjust this limit,modify the following registry key (USERPostMessageLimit)

正如其他人所说,这个代码/模式应该重新设计.