本投稿はDelphi Advent Calendar 2019 #21 の記事です。
VCLでWindows10のダークモード(ダークテーマ)の切替に追随するアプリを作る に引き続きFMXで同様のプログラムを作ろうと思います。Windows 10 November 2019 及び Delphi 10.3.2での動作を確認しています。
#ダークモードについて
ダークモードはWindows10に追加された色の設定で黒を選んだ状態です。デスクトップを右クリックしてWindows10の個人用設定を選択すると設定ダイアログが表示されます。
設定ダイアログの左ペインの色を選び，色を選択するで設定を変更すると，ダークモードに変更できます。
詳しい手順についてはいiPentecさんのWindows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)を見ていただければと思います。
アプリーモードの白/黒の選択に追随して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を貼り付けて，アクセントカラーを表示しています。
さらに，切り替えるスタイルをリソースに読み込みます。プロジェクトメニューからリソースと画像を選びます。
以下のようにスタイルを２つ追加し識別子を入れます。
| スタイル | 識別子 |
|---|---|
| Win10Modern.Style | Win10 |
| Win10ModernDark.Style | Win10Dark |
スタイルは 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) - iPentec
- クラシック デスクトップ アプリの Windows テーマ追従 - grabacr.nét PaaS (Patchouli as a Shachiku)
- 簡単にUIの印象を変える方法 - Styleの適用 - FireMonkey と VCL [Japan] - Embarcadero Blogs
- Delphi 10.1 BerlinのFireMonkeyアプリケーションでスタイルをリソースから読み込んで適用する -山本隆の開発日誌
- FireMonkey と Windows Qiita - @pik
貴重な情報を提供してくださった皆様，ありがとうございます。感謝します。