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 を待っても良いかも知れません。

Prezi を使ってみたよ

Prezi を使ってみたよ。

Prezi のサンプルなので中身の説明は超いい加減！

もうすぐ再開します！

もう４月！
この一月以上更新が無かった理由が、もうすぐ終わるので、それに関連した話題とかも上げていきます！
しばし待たれよ！

IME のメッセージを Windows Hook で取得する

ソースはこちら(GitHub)

Delphi-ML で、IME の変換スタートと終了を知りたい、という投稿がありました。
全ての Edit をサブクラス化して実装しようとされていたのですが、それでは非常に大変だと思い、Windows Hook による方法を投稿しました。

それが、以下のコードです。

unit uIMEStartEnd;
 
interface
 
uses
  Winapi.Windows;
 
type
  // IME の開始と終了を知らせるイベント
  TIMEStartEndNotifyEvent =
    procedure(const iWnd: HWND; const iStart: Boolean) of object;
 
// イベントを受け取るイベントリスナを設定・削除する
procedure AddIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
procedure RemoveIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
 
implementation
 
uses
  Winapi.Messages, Vcl.Controls, System.Generics.Collections;
 
var
  // WindowsHook のハンドル
  GHookHandle: HHOOK;       
  // イベントリスナのリスト
  GHandlers: TList<TIMEStartEndNotifyEvent>;
                           
// イベントリスナを追加
procedure AddIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
begin
  if (GHandlers.IndexOf(iEvent) < 0) then
    GHandlers.Add(iEvent);
end;
 
// イベントリスナを削除
procedure RemoveIMEEventListener(const iEvent: TIMEStartEndNotifyEvent);
begin
  if (GHandlers.IndexOf(iEvent) > -1) then
    GHandlers.Remove(iEvent);
end;
 
// イベントリスナを呼び出す
// iWnd    IME メッセージを受け取ったウィンドウ
// iStart  開始の場合は True
procedure CallEventHandlers(const iWnd: HWND; const iStart: Boolean);
var
  Handler: TIMEStartEndNotifyEvent;
begin
  for Handler in GHandlers do
    Handler(iWnd, iStart);
end;
 
// Hook のメイン関数
function CallWndProc(
  iNCode: Integer;
  iWParam: WPARAM;
  iLParam: LPARAM): LRESULT; stdcall;
begin
  // 先に、次のフックチェインを呼び出してしまう
  Result := CallNextHookEx(GHookHandle, iNCode, iWParam, iLParam);
 
  // iNCode が 0 以下ならフックは作業してはならない
  if (iNCode < 0) then
    Exit;
 
  // lParam は CWPStruct 形式で、メッセージが入っている
  with PCWPStruct(iLParam)^ do begin
    case message of
      WM_IME_STARTCOMPOSITION: begin
        // IME 変換開始
        CallEventHandlers(hwnd, True);
      end;
 
      WM_IME_ENDCOMPOSITION: begin
        // IME 変換終了
        CallEventHandlers(hwnd, False);
      end;
    end;
  end;
end;
 
initialization
begin
  // イベントハンドラを管理するリストを作成
  GHandlers := TList<TIMEStartEndNotifyEvent>.Create;
 
  // WindowsHook
  GHookHandle :=
    SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, 0, GetCurrentThreadID);
end;
 
finalization
begin
  // Hook を解放
  UnhookWIndowsHookEx(GHookHandle);
 
  // リストを破棄
  GHandlers.Free;
end;
 
end.

具体的にはソースコードのコメントを参照してほしいのですが、一点だけ Windows Hook について説明します。
Windows Hook は Windows の作業に割り込む機構です。
例えば、キーボードの入力があった時や、新しいウィンドウが開くときなど本来アプリケーション側からは見えない Windows の作業に割り込むことができます。
Windows Hook を設定するためには SetWindowsHookEx API を使います。
SetWindowsHookEx の説明を見て頂ければわかるように、様々なフックがあります。
今回は、その中で WH_CALLWNDPROC フックを使う事にしました。
このフックは Window Procedure にメッセージが渡されるタイミングで呼び出されます。
そのタイミングとはいつかというと、具体的には SendMessage API が呼ばれた時です。

PostMessage API を使った場合は、WH_GETMESSAGE フックが使えます。

WH_CALLWNDPROC フックを使うのは IME のメッセージは SendMessage で送られるためです。
そして、今回のソースでは SetWindowsHookEx の３番目の引数に 0 を指定しています。
ここに 0 を指定して、次の引数に現在の Thread ID を指定すると、現在のスレッドで処理される SendMessage についてフックされるます。
この Unit の Initialization 節はメインスレッドから呼ばれるので、メインスレッド（GUI の操作・表示をするスレッド）がメッセージを受け取る度に、CallWndProc 関数が呼ばれることになります。
その結果、Edit などで IME の処理が行われると、それを感知してイベントを発行できます。

また、SetWindowsHookEx の３番目の引数に HInstance を指定してフックする DLL を作ると、全プロセスに結びつくフックを作る事ができます。
これによって、他のプログラムのメッセージを見ることもできます。

これをグローバルフック DLL と呼びます。
グローバルフック DLL の作成については、また次回！

ColorCheckbox を StyleElements で実装できるかどうか

DEKO さんの「TCheckBox の文字色と背景色を変えたい (Delphi) 」で、XE3 であれば StyleElements があるので VCL Style 適用時であれば比較的簡単に実装できるのではないかと思い、やってみました。

結論からいうと、そうでもなかったです。

まず、VCL Style を設定しているアプリケーションのメインフォームに、次の画像のように CheckBox1, CheckBox2 を置きました。
そして、CheckBox2 の StyleElements を [] にしました。



これを実行すると以下のようになりました。



CheckBox2 は、VCL Style ではなく、Windows のデフォルトで表示されています。
全ての Style を無効にしたので、当然の結果です。

次に、StyleElements に [seClient, seBorder] を指定して、フォントにはスタイルが要りません！宣言をします。
そして、Font.Color プロパティに clAqua を入れ、実行すると次のようになりました。



このように、フォント色は簡単に変更できることが判ります。

では、ここで StyleElements から seClient を抜いて、Color プロパティに clRed を指定してやれば、クライアント領域が赤で塗りつぶされそうな気がします。

しかし、結果は、下図のようになり、期待した動作にはなりませんでした。



実はクライアント領域は TStyleHook の方で seClient が入っていなければ、元々の動作をするように組まれているのです。

そのため、seClient を抜いても、Color プロパティで背景は描画されません。

TLabel の場合、元々背景色を塗りつぶす機能があるため、StyleElements から seClient を抜き、Transparent プロパティを False に設定すると、指定した色で背景が描画できます。

これを解決するためには、TCheckBox 用の新しい StyleHook を作る他ありません。

そこで、作ってみました。
できあがった StyleHook のソースは以下のようになります。

unit uCheckBoxStyleHookEx;
 
interface
 
uses
  System.Types, Winapi.Messages, System.Classes, Vcl.Graphics, Vcl.Controls,
  Vcl.StdCtrls, Vcl.Themes;
 
type
  TCheckBoxStyleHookEx = class(TCheckBoxStyleHook)
  protected
    procedure PaintBackground(Canvas: TCanvas); override;
    function AcceptMessage(var Message: TMessage): Boolean; override;
  end;
 
implementation
 
{ TCheckBoxStyleHookEx }
 
function TCheckBoxStyleHookEx.AcceptMessage(var Message: TMessage): Boolean;
begin
  // StyleElements が、どのような値であっても描画処理はこちらで行う
  Result := True;
end;
 
procedure TCheckBoxStyleHookEx.PaintBackground(Canvas: TCanvas);
var
  tmpRect: TRect;
  ElementSize: TElementSize;
  BoxSize: TSize;
begin
  // 元の描画処理を呼び出して、チェックボックスの図形などを書いて貰う
  inherited;
 
  // クライアント領域の描画が入っていない場合
  if not (seClient in Control.StyleElements) then begin
    // チェックボックス図形の大きさを求める
    tmpRect := Rect(0, 0, 20, 20);
    ElementSize := esActual;
 
    with StyleServices do
      if
        not GetElementSize(
          Canvas.Handle,
          GetElementDetails(tbCheckBoxCheckedNormal),
          tmpRect,
          ElementSize,
          BoxSize)
      then begin
        BoxSize.cx := 13;
        BoxSize.cy := 13;
      end;
 
    // チェックボックス図形の分を矩形から取り除く
    tmpRect := Control.ClientRect;
    Inc(tmpRect.Left, BoxSize.cx);
 
    // Color プロパティの色で背景を塗りつぶす
    Canvas.Brush.Color := TCheckBox(Control).Color;
    Canvas.FillRect(tmpRect);
  end;
end;
 
initialization
begin
  // TCheckBoxStyleHookEx を TCheckBox の Style Hook とする
  TCustomStyleEngine.RegisterStyleHook(TCheckBox, TCheckBoxStyleHookEx);
end;
 
finalization
begin
 
end;
 
end.

ポイントは、AcceptMessage で返す値を必ず True にして、描画処理をこちらで受け持つ所です。
これにより、必ず PaintBackground が呼び出されるため、背景色を自由に設定できます。
また、元々の描画処理も呼び出しているので、TFont.Color も何もしなくても効きます。
この TCheckBoxStyleHookEx を uses して実行した結果が次の画像です。



期待通り、TForm.Color と Font.Color が効いています。

結局、StyleHook を使わないと簡単にはできないんだね、という結論でした。

上記の例では StyleElements を [seBorder] にして実行しました。
もしも StyleElements を [] にすると、どうなるでしょうか？
StyleElements を [] にして実行すると、素の Windows のコントロールが描画されます。
AcceptMessage が True を返しているにも関わらず、です。
これは、TWinControl.WndProc の中で、StyleElements が [] だったら、スタイル処理を実行しない、という部分(Vcl.Controls.pas 9892 行目)があるためです。
そのため、StyleElements が [] の状態だと、スタイル処理が実行されず、素の Windows のコントロールが描画されてしまうのです。
個人的には、この if 文は要らないと思います（※）が、仕様ともいえるため QuolityCentral には報告していません。

※変更する手段が無いため。
Control.WindowProc でウィンドウプロシージャを変更しても、その時点では StyleHook を設定できない。

管理者権限で起動する CMD

ソースはこちら(GitHub)

開発していると、結構コマンドプロンプト（CMD.exe）を実行することがあります。
普通に CMD.exe を起動すると、普通の権限で起動します。
しかし、管理者権限でのみ動作するようなプログラムなどを起動したい場合に、一々 UAC が開くのは煩わしいものです。
かといって「管理者としてこのプログラムを起動する」っていうチェックをいれるというのも、いまいちです。
というのも、もしも顧客に対して提供するコマンドラインツールがあったとすると、「このコマンドを実行して下さい。このコマンドは管理者権限で～云々」と説明しなくてはならないためです（しかも正しく伝わる確率の方が低い！）。
そこで、管理者権限で起動する CMD.exe を作ってみます。

ポイントは３つ。

１つ目は、CMD.exe のパスの取得です。
CMD.exe のパスの取得はいくつかやり方があります。
まずは SHGetSpecialFolderLocation を使って「Windows\System32」のパスを取得し、そのパスに CMD.exe を結合して実行する方法です。
とても真っ当な方法ですが ItemIDList を取得したりと、何かと面倒です。
そこで、もう１つの方法「環境変数」から取得することにします。
環境変数「ComSpec」は、CMD.exe のパスを示す環境変数です。
取得した環境変数を展開して有効なパスに変換する API が ExpandEnvironmentStrings です。
これを使って「%ComSpec%」という環境変数を「C:\Windows\System32\cmd.exe」に変換します。

２つ目は、管理者権限での実行です。
とても有名なので既にご存じかも知れませんが、ShellExecuteEx の lpVerb に 'runas' を指定して、プログラムを実行すると UAC が開いて管理者権限で実行できます。
これについては過去のデベロッパーキャンプでエンバカデロの高橋さんが説明(pdf)されています。

３つ目は、起動しても自分自身は見せずに CMD.exe だけを実行する方法です。
プログラムを一個起動するだけなので {$APPTYPE CONSOLE} で、コンソールアプリとして実装すれば良さそうに見えますが、そうするとコンソールが開いてしまいます。
そこで、今回は何も指定しない、つまり {$APPTYPE GUI} としてアプリケーションを作る事にします。
こうすることで、開く Window（TForm）が存在しないため、何も表示せずにアプリケーションを実行可能です。

これらを踏まえたコードが下記です。

program AdminCMD;
 
// 自分を表示したくないので指定しない
//{$APPTYPE CONSOLE}
 
uses
  Winapi.Windows, Winapi.ShellApi, System.SysUtils;
 
// 管理者権限で実行する
function RunAsAdmin(const iExeName, iParam: String): Boolean;
var
  SEI: TShellExecuteInfo;
begin
  Result := False;
 
  // runas は、Vista 以降のみ動作する
  if (CheckWin32Version(6)) then begin
    ZeroMemory(@SEI, SizeOf(SEI));
 
    with SEI do begin
      cbSize := SizeOf(SEI);
      Wnd := 0;
      fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
      lpVerb := 'runas';
      lpFile := PChar(iExeName);
      lpParameters := PChar(iParam);
      nShow := SW_SHOW;
    end;
 
    Result := ShellExecuteEx(@SEI);
  end;
end;
 
var
  CmdPath: String;
begin
  // 環境変数から CMD.exe のパスを取得する
  CmdPath := StringOfChar(#0, MAX_PATH);
  ExpandEnvironmentStrings(
    PChar('%ComSpec%'),
    PChar(CmdPath),
    Length(CmdPath));
 
  CmdPath := Trim(CmdPath);
 
  // 管理者権限で実行
  RunAsAdmin(CmdPath, '');
end.

このコードを実行すると……



UAC の確認ダイアログが出た後に



コマンドプロンプトが開きます。
使いどころを誤らなければ、便利なコマンドプロンプトだと思います。

IME が ATOK か見分ける

ごくごく希に IME をいじる時があります。
そして、MS-IME と ATOK で違う動作をさせたいなーという事が、すごっく希にあります。

そんなとき、Screen.Imes や Screen.DefaultIme で IME の名前を取れば、ATOK かそうでないかが見分けられます。

たとえば、次のような関数で ATOK かどうかを見分けられます。

function IsATOK: Boolean;
begin
  Result := (Screen.DefaultIme.IndexOf('ATOK') > -1);
end;

また、Screen.Imes.Objects[] プロパティには「入力ロケール識別子」（旧名：キーボードレイアウト）が入っています。 あるエディットコントロールでは、この識別子、また別の時には別の識別子、を指定して ActiveKeyboardLayout API を呼び出して、IME を指定したりすることもできます。

（Screen.DefaultKbLayout というデフォルトの入力ロケール識別子を返すプロパティもあります。）