tikskit
tikskit

Reputation: 339

MessageBoxEx stops updation of actions

I use Delphi 7 and my project has several non modal visible forms. The problem is if in one of them MessageBoxEx is called all actions of the application are not updated until MessageBoxEx’s form is closed. In my project it can broke business logic of application.

The TApplication.HandleMessage method is never called while MessageBoxEx's window is shown so it doesn’t call the DoActionIdle and Actions are not updated.

I think what I need is to catch a state of my application when it’s idle and update states of all actions.

First I implemented TApplication. OnIdle handler:

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

Here is a method for updating states of all actions of the application. It’s just a modified version of 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;

It seems that the updating of the states happens much often than usually (I’m going to find out where is a problem using profiler).

Besides, CPU usage grows seriously when the mouse’s cursor is not over the application’s windows (about 25% on my DualCore Pentium).

What do you think about my problem and the way I try to solve it? Is it a good idea to use hooks or there is a better way to catch the application idle state? Do I rather need to use WH_CALLWNDPROCRET during setting the hook?

Why MessageBoxEx blocks TApplication.HandleMessage? Is there way to prevent this behavior? I’ve tried to call it with MB_APPLMODAL, MB_SYSTEMMODAL, MB_TASKMODAL flags but it didn’t help.

Upvotes: 3

Views: 705

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 596121

MessageBox/Ex() is a modal dialog, and as such it runs its own message loop internally since the calling thread's normal message loop is blocked. MessageBox/Ex() receives any messages that are in the calling thread's message queue, and will dispatch them to target windows normally (so things like window-based timers still work, such as TTimer), but its modal message loop has no concept of VCL-specific messages, like action upates, and will discard them. TApplication.HandleMessage() is only called by the main VCL message loop, the TApplication.ProcessMessages() method, and the TForm.ShowModal() method (this is why modal VCL Form windows do not suffer from this problem), none of which are called while MessageBox/Ex() is running (the same will be true for any OS modal dialog).

To solve your problem, you have a couple of choices:

  1. set a thread-local message hook via SetWindowsHookEx() right before calling MessageBox/Ex(), then release the hook right after MessageBox/Ex() exits. This allows you to look at every message that MessageBox/Ex() receives and dispatch them to VCL handlers as needed. DO NOT call PeekMessage(), GetMessage() or WaitMessage() inside of a message hook!

    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. move the MessageBox/Ex() call to a separate worker thread so the calling thread is free to process messages normally. If you need to wait for the result of MessageBox/Ex(), such as when prompting the user for input, then you can use MsgWaitForMultipleObjects() to wait for the thread to terminate while allowing the waiting thread to call Application.ProcessMessages() whenever there are pending messages to process.

    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;
    

Upvotes: 8

Related Questions