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 というデフォルトの入力ロケール識別子を返すプロパティもあります。）