3

私は Delphi 7 を使用しており、私のプロジェクトにはいくつかの非モーダル表示フォームがあります。問題は、そのうちの 1 つで 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;

状態の更新は通常より頻繁に行われているようです (プロファイラーを使用してどこに問題があるかを調べます)。

その上、マウスのカーソルがアプリケーションのウィンドウ上にないとき (私の DualCore Pentium では約 25%)、CPU 使用率が大幅に増加します。

私の問題とそれを解決しようとする方法についてどう思いますか? フックを使用するのは良い考えですか、それともアプリケーションのアイドル状態をキャッチするより良い方法はありますか? フックの設定中に WH_CALLWNDPROCRET を使用する必要がありますか?

MessageBoxEx が TApplication.HandleMessage をブロックするのはなぜですか? この動作を防ぐ方法はありますか? MB_APPLMODAL、MB_SYSTEMMODAL、MB_TASKMODAL フラグを付けて呼び出そうとしましたが、役に立ちませんでした。

4

1 に答える 1

8

MessageBox/Ex()はモーダル ダイアログであり、呼び出しスレッドの通常のメッセージ ループがブロックされているため、内部で独自のメッセージ ループを実行します。 MessageBox/Ex()呼び出しスレッドのメッセージ キューにあるすべてのメッセージを受信し、それらをターゲット ウィンドウに通常どおりディスパッチします (したがって、ウィンドウ ベースのタイマーなどは引き続き機能しますTTimer)。ただし、モーダル メッセージ ループには、VCL 固有のメッセージの概念がありませんアクションは更新し、それらを破棄します。 TApplication.HandleMessage()は、メインの VCL メッセージ ループ、TApplication.ProcessMessages()メソッド、およびメソッドによってのみ呼び出されますTForm.ShowModal()(これが、モーダル VCL フォーム ウィンドウがこの問題に悩まされない理由です)。MessageBox/Ex()実行中はいずれも呼び出されません (OS モーダルについても同じことが当てはまります)。ダイアログ）。

問題を解決するには、いくつかの選択肢があります。

  1. 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;

  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;
于 2012-12-18T06:40:04.477 に答える