FireMonkey の最小化問題と右クリック問題に対処する

ソースはこちら(GitHub)

元々リリースの早い段階から FireMonkey3 を Windows で使うと最小化時にタスクバーに収まらないという問題があることが知られていました。



今回さらに、Delphi ML で『タスクバーの右クリックで出てくるシステムメニューで「ウィンドウを閉じる」を選択してもアプリが終わらない』という問題が指摘されました。



実は２つとも原因は同じです。
原因は、TApplication の設計上のミスです。

このバグが出た背景として、MacOS X 対応が上げられます。
MacOS X は、メインフォームを閉じてもアプリが終了しません。
あくまで、メニューからアプリケーションの終了を選ばないと、終了しないのです！
しかし、Windows では、メインフォームの終了は即ちアプリケーションの終了です。
TApplication は Win と Mac ２つの環境で違う立ち振る舞いをすべきですが、今回は Windows への対応が甘くなっていました。
それは、ベータテスターの主な注目点が iOS 対応だったためだと考えています。
僕自身も Windows でのテストはせずに iOS と MacOS X 部分のみテストしていました。
今後のベータテストでは、Windows もしっかりと見ていく必要がありそうです。

最小化できない問題について

１．TForm の Owner に TApplication が設定されている
２．TForm の WndParent には DesktopWindow が設定されている

という２つの事象から発生しています。
オーナーが設定されている、かつ、拡張ウィンドウスタイルに WS_EX_APPWINDOW が設定されていないので、タスクバーにはオーナーウィンドウ（TApplication）のみが表示されます。
しかし、WndParent（親ウィンドウ）に DesktopWindow が指定されているため、最小化するとデスクトップウィンドウ内の子フォームとして最小化されてしまいます。

システムメニューで閉じない問題について

最小化できない問題のところで、タスクバーにはオーナーウィンドウ（TApplication）が表示されていると記しました。
もうおわかりかと思いますが、タスクバーを右クリックして出てきたシステムメニューは TApplication のモノです。



システムメニューをクリックしても TForm に WM_SYSCOMMAND メッセージは送出されず、TApplication に対して送出されます。
TApplication は、受け取った WM_SYSCOMMAND を、そのまま DefWindowProc に流しているだけなので、TApplication のウィンドウハンドルは閉じてしまい、無効になります。
しかし、プロセスを終了させていないので、プロセスは残り続けます。
この問題を解決するためには TApplication が WM_SYSCOMMAND を受け取った時に メインフォームの Close を呼ぶようにしてやるだけです。

ただ、それだけだと最小化の問題は解決できません。
そこで、今回、下記のユニットを作りました。
ユニット uFixFMXForm.pas は、uses するだけで、上記の２つの問題を解決します。
このユニットは Application のタスクバーボタンを消して、フォームのタスクバーボタンを表示する、という解決方法をとりました。

ただし、副作用があって TApplication がオーナーのウィンドウは全てトップレベルウィンドウになります。
TApplication がオーナーでは無い ShowMessage などのダイアログ系はトップレベルにならないので、実用上の問題にはならないでしょう。

詳細はコード中のコメントを参照してください。

unit uFixFMXForm;
 
interface
 
implementation
 
// Win32 API を使いまくるので Windows 以外ではコンパイルされないようにする
{$IFDEF MSWINDOWS}
uses
  System.SysUtils,
  Winapi.Messages, Winapi.Windows;
 
var
  GHookHandle: HHOOK; // フックハンドル
  GAppWnd: HWND = 0;  // TApplication のハンドル
 
// SendMessage でメッセージが送られたときに呼ばれる
function CallWndProc(
  iNCode: Integer;
  iWParam: WPARAM;
  iLParam: LPARAM): LRESULT; stdcall;
var
  ActiveThreadID: DWORD;
  TargetID: DWORD;
begin
  // フックチェインの他のフックハンドラを先に呼んでしまう
  Result := CallNextHookEx(GHookHandle, iNCode, iWParam, iLParam);
 
  // nCode が 0 以下の時は処理してはいけない
  if (iNCode < 0) then
    Exit;
 
  // iLParam には CWPSTRUCT 型へのポインタが格納されている
  // この型には SendMessage で送られたメッセージの詳細が入っている
  with PCWPStruct(iLParam)^ do begin
    case message of
      // ウィンドウができるとき
      WM_CREATE: begin
        with PCREATESTRUCT(lParam)^ do begin
          // まだ TApplication が生成されていない、かつ「ウィンドウクラス」が
          // TFMAppClass（FireMonkey の TApplication のクラス名）だったとき
          if (GAppWnd = 0) and (StrComp(lpszClass, 'TFMAppClass') = 0) then
            // hwnd を TApplication のウィンドウハンドルとして保存しておく
            GAppWnd := hwnd
          else begin
            // もしも TApplication が visible（＝タスクバーに表示されている）
            // なら、非表示にする！
            if (GAppWnd <> 0) and (IsWindowVisible(GAppWnd)) then
              ShowWindow(GAppWnd, SW_HIDE);
 
            // オーナーウィンドウが TApplication なら TForm のインスタンスと
            // みなして拡張ウィンドウスタイルに WS_EX_APPWINDOW を設定する
            // WS_EX_APPWINDOW が設定されたフォームは、トップレベルウィンドウ
            // となるので、タスクバーに表示される
            if (GetWindow(hwnd, GW_OWNER) = GAppWnd) then
              SetWindowLong(
                hwnd,
                GWL_EXSTYLE,
                GetWindowLong(hwnd, GWL_EXSTYLE) or WS_EX_APPWINDOW);
          end;
        end;
      end;
 
      // ウィンドウが表示されるとき
      WM_SHOWWINDOW: begin
        // オーナーがあるのに拡張スタイルに WS_EX_APPWINDOW を指定していると
        // 最前面に表示されない事があるので、ウィンドウが表示されるときは
        // 強制的に最前面にする
        // 強制最前面化処理は、下記のように AttachThreadInput を使うが
        // 詳細は省略
        if (GetWindow(hwnd, GW_OWNER) = GAppWnd) then begin
          ActiveThreadID := GetWindowThreadProcessId(GetForegroundWindow, nil);
          TargetID := GetWindowThreadProcessId(hwnd, nil);
 
          AttachThreadInput(TargetID, ActiveThreadID, True);
          try
            SetForegroundWindow(hwnd);
            SetActiveWindow(hwnd);
          finally
            AttachThreadInput(TargetID, ActiveThreadID, False);
          end;
        end;
      end;
    end;
  end;
end;
 
initialization
begin
  // WH_CALLWNDPROC フックを仕掛ける
  // WH_CALLWNDPROC は SendMessage が呼ばれたときに呼ばれるフック
  GHookHandle :=
    SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, 0, GetCurrentThreadID);
end;
 
finalization
begin
  // フックを解放
  UnhookWIndowsHookEx(GHookHandle);
end;
{$ENDIF}
 
end.

と、まあ今回このようなユニットを作りましたが、近日リリースされるであろう XE4 Update1 で、このバグは治っている事でしょう。
ですから、無理してこのユニットを使わず、Update1 を待っても良いかも知れません。