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

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

[VCLでWindows10のダークモード(ダークテーマ)の切替に追随するアプリを作る](https://qiita.com/p_kato/items/88411578b7091ab1fcd0) に引き続きFMXで同様のプログラムを作ろうと思います。Windows 10 November 2019 及び Delphi 10.3.2での動作を確認しています。

#ダークモードについて
ダークモードは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)を見ていただければと思います。

アプリーモードの白/黒の選択に追随してFMXのテーマを入れ替えます。
ついでにアクセントカラーも拾っています。機能をユニットにほぼまとめました。イベント処理はFMXではWindows固有のものとして切り出したほうが良いと思いFormのUnitに残しています。

```uThemeFMX.pas
unit uThemeFMX;

interface

uses
  FMX.Forms, FMX.Platform.Win,
  Winapi.Windows,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);

function ThemetFormWndProc(var uMsg:DWORD;var wParam:WPARAM):boolean; // テーマ更新の監視

implementation

uses
  System.SysUtils,
  System.Win.Registry;


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

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

procedure SysAccentColorUpdate(wParam:NativeUInt);
var
  d:TColorF;
begin
  d.C:=wParam or $FF000000;
  AccentColor.R:=d.R;
  AccentColor.G:=d.G;
  AccentColor.B:=d.B;
  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 uMsg:DWORD;wParam:WPARAM):boolean; // アクセントカラーの監視
var
  ba:boolean;
begin
  ba:=uMsg = WM_DWMCOLORIZATIONCOLORCHANGED;
  if ba then begin
    SysAccentColorUpdate(wParam);  // アクセントカラーの変更
  end;
  Result:=ba;
end;

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

initialization
  isWindows10Set; // isWindwos10をセット
  AccentColor:=SysAccentColor; // アクセントカラー
  isLightThemeUpdate; // テーマ カラーの変更
end.
```
このユニットを使ったアプリを作ります。
フォームのコードは以下の通りです。フォームにRectangle1を貼り付けて，アクセントカラーを表示しています。

さらに，切り替えるスタイルをリソースに読み込みます。**プロジェクト**メニューから**リソースと画像**を選びます。
![Snap0001.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/bda39a3a-fbe9-d926-a8e9-302f5d4bee2d.png)
以下のようにスタイルを２つ追加し識別子を入れます。

| スタイル                 | 識別子       |
|:-----------------------:|:-----------:|
|**Win10Modern.Style**    |**Win10**    |
|**Win10ModernDark.Style**|**Win10Dark**|

![Snap0002.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/206bb2f5-7c07-2a60-e9af-94b2dcf68900.png)

スタイルは **C:\Users\Public\Documents\Embarcadero\Studio\20.0\Styles** にあります。パブリックドキュメントのEmbarcaderoの中になります。

```unit1.pas
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Rectangle1: TRectangle;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
    procedure ThemeUpdate;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  FMX.Styles, FMX.Platform.Win,
  Winapi.Windows,
  uThemeFMX;

var
  WndProc:Pointer;

procedure ThemeUpdate(AForm:TForm1);
begin
  AForm.ThemeUpdate;
end;

function ThemeWndProc( hWnd: HWND; uMsg: DWORD; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if ThemetFormWndProc(uMsg,wParam) then begin
    ThemeUpdate(Form1);
  end;
  Result := CallWindowProc(WndProc, hWnd, uMsg, wParam, lParam);
end;

function AddThemeWndProc(const AForm: TCommonCustomForm): Boolean;
var
  Wnd: HWND;
begin
  Wnd := FormToHWND(AForm);
  WndProc := Pointer(SetWindowLong(Wnd, GWL_WNDPROC, Integer(@ThemeWndProc)));
  Exit(WndProc <> nil);
end;

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

procedure TForm1.FormShow(Sender: TObject);
begin
  ThemeUpdate;
end;

procedure TForm1.ThemeUpdate;
var
  FMXStyle: TFmxObject;
begin
  if isLightTheme then begin
    FMXStyle:= TStyleStreaming.LoadFromResource(HInstance,'Win10',RT_RCDATA);
  end else begin
    FMXStyle:= TStyleStreaming.LoadFromResource(HInstance,'Win10Dark',RT_RCDATA);
  end;
  TStyleManager.SetStyle(FMXStyle);
  Rectangle1.Fill.Color:=AccentColor.C;
  Invalidate;
end;

end.
```

Windows10のダークモードの変更に合わせて，FMXのテーマを変更するため，リソースに配置したスタイルを呼び出すようにしています。
VCLでは簡単だったWindowsのメッセージ処理が追加されているので，少し複雑になってしまったかもしれません。ユニットのほうに押し込むことも可能ではなかったかと思います。
もしかしたらすぐに動かなくなるかもしれませんが，皆様のお役に立てたらうれしいです。

# 参考文献

- [Windows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)](https://www.ipentec.com/document/windows-windows-10-change-dark-theme) - iPentec
- [クラシック デスクトップ アプリの Windows テーマ追従](http://grabacr.net/archives/6671) - grabacr.nét PaaS (Patchouli as a Shachiku)
- [簡単にUIの印象を変える方法 - Styleの適用 - FireMonkey と VCL [Japan]](https://community.idera.com/developer-tools/b/blog/posts/ui---style---firemonkey-vcl-japan) - Embarcadero Blogs
- [Delphi 10.1 BerlinのFireMonkeyアプリケーションでスタイルをリソースから読み込んで適用する](https://www.gesource.jp/weblog/?p=7556) -山本隆の開発日誌
- [FireMonkey と Windows](https://qiita.com/pik/items/b184f5ffb34576ed15dc) Qiita - @pik


貴重な情報を提供してくださった皆様，ありがとうございます。感謝します。