ダイアログが出ていることを確認するには？ (ID:27091)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

まだ完璧ではありませんが，ご提示いただいたコードの意味を解釈し，実際に
サンプルプログラムに組み込んで使ってみました。参考までに，以下に
現時点での結果を示します。

まず，ベースとしては，みふ。様のご提示くださったコードを使用しま
した。ですが，そのまま使用した場合，以下のような問題が発生しまし
た。

・例外が発生した時に表示されるダイアログボックスが出ても，
  「出てない」が表示されてしまう。
・TOpenDialog等で，ダイアログボックスからさらにダイアログが表示
  された場合(「指定されたファイルは存在しません」等のメッセージ
  です。)にも，「出てない」が表示される。

今作成しているプログラムは，ただ1つのフォームしか持ちませんの
で，モーダルなダイアログが1つでも出ているときは，メインフォーム
にモーダルなダイアログが出ているということになります。そのため，
以下のようにコードをカスタマイズしました。コードは今書いて，一
通り動かしてみただけなので，さらに十分な検証を終えた時点で，「解決」
としたいと思います。

※ただ，このような分野を扱ったのは初めてですので，もしどなたか
  お気づきの点がありましたら，ご指摘いただくと本当に助かります。

// 判定用関数本体。Unit1に記述して使用した。

var
  TopMostWindow: HWnd = 0;

function DoFindWindow(Window: HWnd; Param: Longint): Boolean; stdcall;
begin
  if (Window <> Application.Handle) and
    IsWindowVisible(Window) and
    // IsWindowEnabled(Window) and
    // ↑これがあると，OpenDialog1のFileMustExistsの関係でエラーメッセージ
    // が出たとき，まれに 「モーダルダイアログ無し」が返ってきてしまうので，コメントアウト。
    (GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_TOPMOST = 0) then
    TopMostWindow := Window;
  Result := True;
end;

function IsShowModal(MainWindow: HWnd): Boolean;
begin
  Result := False;
  TopMostWindow := 0;
  if not IsWindowEnabled(MainWindow) then
    EnumThreadWindows(GetCurrentThreadID, @DoFindWindow, 0);
  Result := TopMostWindow <> 0;
  // ↑最前面表示のウィンドウが1つでもあったらモーダル有りと判定。
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Listbox1.Items.Clear;
  if IsShowModal(Handle) then
    Caption := 'モーダルダイアログ有り'
  else
    Caption := 'モーダルダイアログ無し';
end;

// 以下は単に検証に用いたコード。参考までに提示しておきます。1通り，結果は良好でした。

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Form2はNormalとStayOnTopで検証。→どちらも正しく「モーダルダイアログ有り」を返した。
  Form2.ShowModal;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  A: Integer;
begin
  // わざとエラーを起こしてみる。
  A := 0;
  ShowMessage(IntToStr(1 div A));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ShowMessage('');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  MessageDlg('', mtError, [mbOK], 0);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  // OpenDialogはOptionsにFileMustExistsを設定して，エラーダイアログを出して様子を見る。
  if OpenDialog1.Execute then;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  A: String;
begin
  // 開発時によく使用する文字列入力ダイアログ。
  A := '1';
  InputQuery(A, A, A);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  Application.MessageBox('', '', 0);
end;

←解決時は質問者本人がここをチェックしてください。

戻る