2012年12月25日火曜日

痛 VCL Style


Delphi Advent Calendar 2012 12/25 の記事です。

タイトルにある通りのことをしてみたいと思ったわけです。
これは、Delphi Advent Calendar 2012 の 12/14 の Lyna さんの記事「IDEにおける背景変更機能の導入による開発効率への影響とその考察。」（痛IDE）に触発されてのことです。

VisualStudio の痛背景画像では開発環境しか変えられないけど、Delphi だったら Style 使えば簡単に「痛アプリ」が作れちゃうもんね！という思いから始めたわけですが、TForm だけ、かなり特殊じゃん……と気づかされました。

手始めに、こんなスタイルを作ってみました。



Metropolis UI の Blue スタイルにクラウディアを追加するという形で。

Images に画像を「追加」することができるのですが、うまくいきませんでした。
様々な例外が上がります。
また、上記のような一体化画像を作った際は「更新」ボタンを使って画像を更新しないと、酷い目に遭います。
Objects 以下のオブジェクトは全部、現在の画像を指しているので「削除」してから「追加」とすると、Objects 以下の全オブジェクトが例外を吐きます……。

それで、Objects/Form/Image/Client にクラウディアを設定してみました。



この結果何が起こるかというと……



思ってたのと違う！！いや合ってるけど！でも違う！
タイリング表示されました……
なんとか右下にクラウディアたんが佇んでくれないかと。
かといって TileStyle には、そんな都合のいい値はありません。



そもそも、tsTile 以外の値を設定すると、再描画が上手くされません。
これは、スタイルの描画方法に起因しています。
このような一部分が他と違うようなものを想定していないためです。

何時間か、弄っていたのですが、これでは拉致があかない！と、方法を改めることにしました。
TClaudiaFormStyleHooke を作る事にしたのです。
しかし、これも簡単にはいきませんでした。
何故かと言うと TCustomForm と TFormStyleHook が完全に癒着していて、TForm に他の StyleHook が設定できる想定がされていなかったためです。

しかし、最終的にはなんとかなりました。



結構苦労しましたが、使い方は簡単です。
uClaudiaFormStyleHook をプロジェクトファイルに uses するだけです。
※アプリケーションに VCL Style が設定されている必要があります。

program Project1;


 


uses


  Vcl.Forms,


  Vcl.Themes,


  Vcl.Styles,


  Unit1 in 'Unit1.pas' {Form1},


  uClaudiaFormStyleHook;


 


{$R *.res}


 


begin


  Application.Initialize;


  Application.MainFormOnTaskbar := True;


  TStyleManager.TrySetStyle('Auric');


  Application.CreateForm(TForm1, Form1);


  Application.Run;


end.

詳しい構造は、ソース内のコメントをご覧ください。

unit uClaudiaFormStyleHook;


 


interface


 


uses


  Winapi.Windows, Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.Themes,


  Vcl.Imaging.pngimage;


 


type


  // クラウディアたんを右下に表示する Style Hook


  TClaudiaFormStyleHook = class(TFormStyleHook)


  private


    FClaudia: TPngImage;


  protected


    procedure PaintBackground(Canvas: TCanvas); override;


  public


    constructor Create(iControl: TWinControl); override;


    destructor Destroy; override;


  end;


 


implementation


 


uses


  System.Classes, System.SysUtils;


 


{ TClaudiaFormStyleHook }


 


constructor TClaudiaFormStyleHook.Create(iControl: TWinControl);


begin


  inherited;


 


  // PNG Image を生成


  FClaudia := TPngImage.Create;


 


  // クラウディアの画像を読み出す


  FClaudia.LoadFromFile(ExtractFilePath(Application.ExeName) + '\Claudia.png');


end;


 


destructor TClaudiaFormStyleHook.Destroy;


begin


  // PNG Image を破棄


  FClaudia.Free;


 


  inherited;


end;


 


// WM_ERASEBKGND が来たときに呼ばれるメソッド


procedure TClaudiaFormStyleHook.PaintBackground(Canvas: TCanvas);


var


  FormCanvas: TCanvas;


  Back: TBitmap;


begin


  // まず親の PaintBackground を呼び、このフォームに乗っている


  // 子コントロール分の背景を描画する


  inherited;


 


  // 背景用 Bitmap を作る


  Back := TBitmap.Create;


  try


    with Back, Canvas do begin


      // 大きさは、フォームのクライアントエリアと同じ


      SetSize(Control.Width, Control.Height);


 


      // 背景色で塗りつぶす


      Brush.Color := StyleServices.GetStyleColor(scWindow);


      FillRect(Rect(0, 0, Width, Height));


 


      // クラウディアを右下に描画する


      Draw(Width - FClaudia.Width, Height - FClaudia.Height, FClaudia);


    end;


 


    // フォームに描画するための Canvas を作る


    // 引数の Canvas は、TBitmap の Canvas でしかないため


    // Canvas に Draw しても描画されない


    FormCanvas := TCanvas.Create;


    try


      // デバイスコンテキストを取得


      FormCanvas.Handle := GetDC(Control.Handle);


      try


        // 背景用 Bitmap を描画する


        FormCanvas.Draw(0, 0, Back);


      finally


        ReleaseDC(Control.Handle, FormCanvas.Handle);


      end;


    finally


      FormCanvas.Free;


    end;


  finally


    Back.Free;


  end;


end;


 


initialization


begin


  // まず TFormStyleHook を TCustomForm から外さないと


  // TClaudiaFormStyleHook は呼ばれない


  TCustomStyleEngine.UnregisterStyleHook(TCustomForm, TFormStyleHook);


 


  // TClaudiaFormStyleHook を TCustomForm の StyleHook として設定


  TCustomStyleEngine.RegisterStyleHook(TCustomForm, TClaudiaFormStyleHook);


end;


 


finalization


begin


  // TCustomForm はアプリケーションが終わり破棄されるとき TFormStyleHook を


  // UnregisterStyleHook しようとする。


  // そのため、ここで StyleHook に TFormStyleHook を登録してやる。


  // 登録しないと、例外が発生する


  TCustomStyleEngine.RegisterStyleHook(TCustomForm, TFormStyleHook);


end;


 


end.

少し時間が掛かってしまいましたが、Delphi は Style という手法を手に入れたため、uses するだけで簡単に背景を変更できます。
他の環境では、WM_ERASEBKGND を地道に変更したりと、Delphi のように簡単には行かないでしょう。

というわけで、今回は VCL スタイルについて、痛StyleHook を作ってみました。

FireMonkey のスタイルでも同じ物を作ろうと思ったのですが、上手く行きませんでした。
これは、僕がまだ FireMonkey を使いこなしていないためです。
他の方がやってくれるかも知れません……！

ということで、この記事を、Delphi Advent Calendar 2012 のトリとさせていただきます。
２５日間、記事を書いてくださった皆さん、記事をご覧いただいた皆さん、お付き合いくださりありがとうございました！
また、来年もやりたいです！

それでは、皆さん、良いお年を！
投稿者 時刻:
ラベル: ,

2 件のコメント:

  1. Unknown2012年12月26日 9:35

    楽しい企画をありがとうございました！
    よいおとしを。

    返信削除
    返信
    1. Unknown2012年12月26日 13:05

      こちらこそ、ご覧頂きありがとうございました！
      楽しんで頂けたのなら幸いです。
      良いお年を！

      削除

登録: コメントの投稿 (Atom)