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 を設定できない。