这是简化的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)
正如其他人所说,这个代码/模式应该重新设计.
解决方法
如果您绝对需要主线程处理每条消息,则需要维护自己的队列.而且您可能需要限制添加到队列的线程.
你的睡眠(1)会踩油门,但是会非常粗暴.也许它会扼杀太多,也许还不够.一般来说,您需要更精确地了解节流.通常,您可以通过跟踪队列的大小来自适应地进行限制.如果你可以避免节流这样做.它很复杂,难以很好地实现,并且会损害性能.
如果有另一个线程准备运行,则调用Sleep(0)将产生.否则Sleep(0)无效.从文档中
A value of zero causes the thread to relinquish the remainder of its time slice to any other thread that is ready to run. If there are no other threads ready to run,the function returns immediately,and the thread continues execution.
另一方面,如果你需要做的只是在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,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,ThreadId); CloseHandle(ThreadHandle); Timer1.Enabled := True; end;