delphi - MessageBoxEx 停止更新操作

Question

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

TApplication.HandleMessage 方法在显示 MessageBoxEx 的窗口时永远不会被调用，因此它不会调用 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%）。

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

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

score 8 · Accepted Answer

MessageBox/Ex()是一个模态对话框，因此它在内部运行自己的消息循环，因为调用线程的正常消息循环被阻塞。 MessageBox/Ex()接收调用线程的消息队列中的任何消息，并将它们正常发送到目标窗口（因此基于窗口的计时器之类的东西仍然可以工作，例如TTimer），但是它的模态消息循环没有 VCL 特定消息的概念，例如行动更新，并将丢弃它们。 TApplication.HandleMessage()仅由主 VCL 消息循环、TApplication.ProcessMessages()方法和TForm.ShowModal()方法调用（这就是模态 VCL 窗体窗口不会遇到此问题的原因），在MessageBox/Ex()运行时均不会调用（对于任何 OS 模态也是如此对话）。

要解决您的问题，您有几个选择：

SetWindowsHookEx()在调用之前通过设置线程本地消息挂钩，然后在退出MessageBox/Ex()后立即释放挂钩。MessageBox/Ex()这使您可以根据需要查看MessageBox/Ex()接收它们并将它们分派到 VCL 处理程序的每条消息。 不要调用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;

将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;

delphi - MessageBoxEx 停止更新操作

1 回答 1

Related

Reference