delphi - MessageBoxEx 停止更新操作

Question

我使用Delphi 7，我的项目有几个非模态可见表单。问题是，如果在其中之一中调用 MessageBoxEx，那么在关闭 MessageBoxEx 的表单之前，应用程序的所有操作都不会更新。在我的项目中，它可能会破坏应用程序的业务逻辑。

当显示 MessageBoxEx 的窗口时，永远不会调用 TApplication.HandleMessage 方法，因此它不会调用 DoActionIdle 并且操作不会更新。

我认为我需要的是在应用程序空闲时捕获应用程序的状态并更新所有操作的状态。

首先我实现了TApplication。 OnIdle 处理程序:

procedure TKernel.OnIdle(Sender: TObject; var Done: Boolean);
begin
  {It’s only to switch off the standard updating from TApplication.Idle. It's to make the CPU usage lower while MessageBoxEx's window isn't shown }
 Done := False;
end;

implementation

var
  MsgHook: HHOOK;

{Here is a hook}
function GetMsgHook(nCode: Integer; wParam: Longint; var Msg: TMsg): Longint; stdcall;
var
  m: TMsg;
begin
  Result := CallNextHookEx(MsgHook, nCode, wParam, Longint(@Msg));
  if (nCode >= 0) and (_instance <> nil) then
  begin
    {If there aren’t the messages in the application's message queue then the application is in idle state.}
    if not PeekMessage(m, 0, 0, 0, PM_NOREMOVE) then
    begin
      _instance.DoActionIdle;
      WaitMessage;
    end;
  end;
end;

initialization
    MsgHook := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgHook, 0, GetCurrentThreadID);

finalization
  if MsgHook <> 0 then
    UnhookWindowsHookEx(MsgHook);

这是一种更新应用程序所有操作状态的方法。它只是 TApplication.DoActionIdle 的修改版本:

type
  TCustomFormAccess = class(TCustomForm);

procedure TKernel.DoActionIdle;
var
  i: Integer;
begin
  for I := 0 to Screen.CustomFormCount - 1 do
    with Screen.CustomForms[i] do
      if HandleAllocated and IsWindowVisible(Handle) and
        IsWindowEnabled(Handle) then
        TCustomFormAccess(Screen.CustomForms[i]).UpdateActions;
end;

状态的更新似乎比平时更频繁(我将使用探查器找出问题所在)。

此外，当鼠标光标不在应用程序窗口上时，CPU 使用率会严重增加(在我的 DualCore Pentium 上大约为 25%)。

您对我的问题以及我尝试解决它的方式有何看法？使用钩子(Hook)是一个好主意还是有更好的方法来捕获应用程序空闲状态？在设置 Hook 期间我是否需要使用 WH_CALLWNDPROCRET？

为什么 MessageBoxEx 会阻止 TApplication.HandleMessage？有办法阻止这种行为吗？我尝试使用 MB_APPLMODAL、MB_SYSTEMMODAL、MB_TASKMODAL 标志来调用它，但没有帮助。

Answer 1

MessageBox/Ex() 是一个模式对话框，因此它在内部运行自己的消息循环，因为调用线程的正常消息循环被阻止。 MessageBox/Ex() 接收调用线程消息队列中的任何消息，并正常将它们分派(dispatch)到目标窗口(因此基于窗口的计时器之类的东西仍然有效，例如 TTimer)，但它的模态消息循环没有 VCL 特定消息的概念，例如操作 upates，并且会丢弃它们。 TApplication.HandleMessage() 仅由主 VCL 消息循环、TApplication.ProcessMessages() 方法和 TForm.ShowModal() 调用> 方法(这就是为什么模态 VCL 窗体窗口不会遇到此问题)，当 MessageBox/Ex() 运行时不会调用任何一个方法(对于任何操作系统模态对话框也是如此) .

要解决您的问题，您有几种选择:

1. 在调用 MessageBox/Ex() 之前通过 SetWindowsHookEx() 设置线程本地消息 Hook ，然后在 MessageBox 之后释放该 Hook /Ex() 退出。这使您可以查看 MessageBox/Ex() 接收的每条消息，并根据需要将它们分派(dispatch)给 VCL 处理程序。 请勿在消息 Hook 内调用 PeekMessage()、GetMessage() 或 WaitMessage()!

   type
     TApplicationAccess = class(TApplication)
     end;
   
   function GetMsgHook(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
   var
     Msg: TMsg;
   begin
     if (nCode >= 0) and (wParam = PM_REMOVE) then
     begin
       Msg := PMsg(lParam)^;
       with TApplicationAccess(Application) do begin
         if (not IsPreProcessMessage(Msg))
           and (not IsHintMsg(Msg))
           and (not IsMDIMsg(Msg))
           and (not IsKeyMsg(Msg))
           and (not IsDlgMsg(Msg)) then
         begin
         end;
       end;
     end;
     Result := CallNextHookEx(MsgHook, nCode, wParam, lParam);
   end;
   
   function DoMessageBoxEx(...): Integer;
   var
     MsgHook: HHOOK;
   begin
     MsgHook := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgHook, 0, GetCurrentThreadID);
     Result := MessageBoxEx(...);
     if MsgHook <> 0 then UnhookWindowsHookEx(MsgHook);
   end;
   

2. 将 MessageBox/Ex() 调用移至单独的工作线程，以便调用线程可以自由地正常处理消息。如果需要等待MessageBox/Ex()的结果，比如提示用户输入时，那么可以使用MsgWaitForMultipleObjects()来等待线程终止，同时允许等待线程在有待处理消息时调用 Application.ProcessMessages()。

   type
     TMessageBoxThread = class(TThread)
     protected
       procedure Execute; override;
       ...
     public
       constructor Create(...);
     end;
   
   constructor TMessageBoxThread.Create(...);
   begin
     inherited Create(False);
     ...
   end;
   
   function TMessageBoxThread.Execute;
   begin
     ReturnValue := MessageBoxEx(...);
   end;
   
   function DoMessageBoxEx(...): Integer;
   var
     Thread: TMessageBoxThread;
     WaitResult: DWORD;
   begin
     Thread := TMessageBoxThread.Create(...);
     try
       repeat
         WaitResult := MsgWaitForMultipleObjects(1, Thread.Handle, False, INFINITE, QS_ALLINPUT);
         if WaitResult = WAIT_FAILED then RaiseLastOSError;
         if WaitResult = WAIT_OBJECT_0 + 1 then Application.ProcessMessages;
       until WaitResult = WAIT_OBJECT_0;
       Result := Thread.ReturnVal;
     finally
       Thread.Free;
     end;
   end;