VCLでWindows10のダークモード(ダークテーマ)の切替に追随するアプリを作る

本投稿は[Delphi Advent Calendar 2019 #14](https://qiita.com/advent-calendar/2019/delphi) の記事です。

#お詫び
まず最初にお詫びを，，
昨年のアドベントカレンダーに書いた[Delphi VCLでFluent Designに挑戦(その1) - Arcylic Form (アクリル フォーム)](https://qiita.com/p_kato/items/eb8c2d166506b7944b9a)ですが，Windows 10 November 2019 Update(1909)で使い物にならなくなってしまいました。動くには動くのですが，ウインドウの移動が亀のようにのろくなってしまいます。非公開のAPIを使ったツケです。申し訳ないです。現在何とかかわす方法を考えているところです。

#ダークモードの切り替えに追随する
と言いながら，Win32アプリで性懲りもなくWindows10のダークモードの切り替えに追随するアプリに挑戦したいと思います。
デスクトップを右クリックしてWindows10の個人用設定を選択すると設定ダイアログが表示されます。
![Snap0001.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/ce49b0f0-8649-b49d-d034-d9bd82ce377f.png)
設定ダイアログの左ペインの色を選び，**色を選択する**で設定を変更すると，ダークモードに変更できます。
![Snap0002.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/0a9cd529-0f36-3184-cc6b-0e99103e82d5.png)
詳しい手順については iPentec さんの[Windows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)](https://www.ipentec.com/document/windows-windows-10-change-dark-theme)を見ていただければと思います。

アプリーモードの白/黒の選択に追随して個人設定VCLのテーマを入れ替えるというものです。
ついでにアクセントカラーも拾っています。機能をユニットにまとめました。

```uTheme.pas
unit uTheme;

interface

uses
  Winapi.Messages;

type
  TisATF=(fdAuto,fdTrue,fdFalse);           // 自動と強制設定を管理する

type
  TColorF=record
  case Cardinal of
    0: (C: Cardinal);
    1: (R, G, B, A: System.Byte);
  end;

var
  isWindows10:boolean; // Windows10か？
  AccentColor:TColorF; // アクセントカラー

function isLightTheme:boolean;              // LightThemeかDarkThemeか
procedure isLightThemeSet(AisATF:TisATF);
procedure isLightThemeUpdate;

function ThemetFormWndProc(var Message: TMessage):boolean; // テーマ更新の監視

implementation

uses
  System.SysUtils,
  System.Win.Registry,
  Winapi.Windows;

procedure isWindows10Set; // Windows10か？
begin
  isWindows10:=CheckWin32Version(10, 0);
end;

function SysAccentColor:TColorF; // アクセントカラー
var
 Registry: TRegistry;
begin
   Result.C:=$00000000;
   Registry := TRegistry.Create(KEY_READ);
   try
     Registry.RootKey := HKEY_CURRENT_USER;
     Registry.OpenKey('Software\Microsoft\Windows\DWM', False);
     Result.C :=Cardinal((Registry.ReadInteger('AccentColor')) or $FF000000);
   finally
     Registry.Free;
   end;
end;

procedure SysAccentColorUpdate(wParam:NativeUInt);
var
  d:TColorF;
begin
  d.C:=wParam or $FF000000;
  AccentColor.R:=d.B;
  AccentColor.G:=d.G;
  AccentColor.B:=d.R;
  AccentColor.A:=$FF;
end;

function isSysLightTheme:boolean; // テーマは Light / Dark か？
var
 Registry: TRegistry;
begin
  Result:=True;
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey:= HKEY_CURRENT_USER;
    if Registry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Themes\Personalize', False) then begin
      Result := (Registry.ReadInteger('AppsUseLightTheme')=1);
    end;
  finally
    Registry.Free;
  end;
end;

var
  FisLightTheme:integer=1;

function isLightTheme:boolean;
begin
  Result:=((FisLightTheme and 1)=1)or(not isWindows10); // Windows7は常にLightTheme
end;

procedure isLightThemeAutoSet;
begin
  if isSysLightTheme then begin
    FisLightTheme:=1;
  end else begin
    FisLightTheme:=0;
  end;
end;

procedure isLightThemeSet(AisATF:TisATF); // テーマをセットする
begin
  case AisATF of
    fdAuto: isLightThemeAutoSet;
    fdTrue: FisLightTheme:=3;
   fdFalse: FisLightTheme:=2;
  end;
end;

procedure isLightThemeUpdate; // 自動更新なら更新する
begin
  if (FisLightTheme and 2)=0 then isLightThemeAutoSet;
end;

function AccentColorWndProc(var Message: TMessage):boolean; // アクセントカラーの監視
// 親フォームのWndProcで監視する
var
  ba:boolean;
begin
  ba:=Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED;
  if ba then begin
    SysAccentColorUpdate(Message.WParam);  // アクセントカラーの変更
  end;
  Result:=ba;
end;

function ThemetFormWndProc(var Message: TMessage):boolean; // テーマ更新の監視
// 親フォームのWndProcで監視する
var
  ba,bt:boolean;
begin
  ba:=AccentColorWndProc(Message); // アクセントカラーの監視
  bt:=Message.Msg = WM_SETTINGCHANGE;
  if bt then begin
    isLightThemeUpdate; // テーマ カラーの変更
  end;
  Result:=ba or bt;
end;

initialization
  isWindows10Set; // isWindwos10をセット
  AccentColor:=SysAccentColor; // アクセントカラー
  isLightThemeSet(fdAuto);     // デフォルトは自動
end.
```
isLightThemeSet()で白固定・黒固定・自動の３つの設定ができるようにしています。

このユニットを使ったアプリを作ります。
フォームのコードは以下の通りです。フォームにShape1を貼り付けて，アクセントカラーを表示しています。

```Unit1.pas
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Shape1: TShape;
    procedure FormCreate(Sender: TObject);
   private
    { Private 宣言 }
    procedure ThemeRepaint;
    procedure WndProc(var Message: TMessage);override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

uses
  uTheme,
  Vcl.Themes,
  Vcl.Styles;

procedure TForm1.ThemeRepaint; // フォームのスタイルを更新
begin
  if isLightTheme then begin
    TStyleManager.TrySetStyle('Windows10');
  end else begin
    TStyleManager.TrySetStyle('Windows10 Dark');
  end;
  Shape1.Brush.Color:=TColor(AccentColor.C and $00FFFFFF);
  Repaint;
end;

procedure TForm1.WndProc(var Message: TMessage); // ダークモードを監視
begin
  if ThemetFormWndProc(Message) then begin
    ThemeRepaint;
  end;
  inherited WndProc(Message);
end;

//

procedure TForm1.FormCreate(Sender: TObject);
begin
  ThemeRepaint;
end;

end.
```

Windows10のダークモードの変更に合わせて，VCLのテーマを変えるため，プロジェクトにテーマを追加します。
今回は'Windows10と'Windows10 Darkののカスタムスタイルを追加しました。
**プロジェクト**の**オプション**から**アプリケーション－表示**で上記のカスタムスタイルをチェックします。また，アクセントカラーを表示するためのShape1を追加してください。
![Snap0003.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/4c70185a-1c2d-23f7-ec8f-4e81ff3f3251.png)

WndProcをオーバーライドしてWM_DWMCOLORIZATIONCOLORCHANGEDとWM_SETTINGCHANGEを監視して，変更があればレジストリからダークテーマの情報をWPARAMから新しいアクセントカラーを取得して，フォームのカスタムスタイルを変更しています。
もしかしたらすぐに動かなくなるかもしれませんが，皆様のお役に立てたらうれしいです。

#参考文献
[Windows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)](https://www.ipentec.com/document/windows-windows-10-change-dark-theme) - iPentec
[VCL スタイル (Delphi XE2 以降)](https://ht-deko.com/tech074.html) - DEKOのアヤシいお部屋。
[クラシック デスクトップ アプリの Windows テーマ追従](http://grabacr.net/archives/6671) - grabacr.nét PaaS (Patchouli as a Shachiku)
貴重な情報を提供してくださった皆様，ありがとうございます。感謝します。

#Delphi 11 (Alexandria) 対応
-アクセントカラーの取得で変数の演算で範囲外のエラーが出たので修正しました。
-OnFormShowでテーマの変更処理を入れると，Showイベント中にVisibleを変更できないといわれましたので，OnFormCreateで処理するように変更しています。