Help us understand the problem. What is going on with this article?

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

本投稿はDelphi Advent Calendar 2019 #21 の記事です。

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

ダークモードについて

ダークモードはWindows10に追加された色の設定で黒を選んだ状態です。デスクトップを右クリックしてWindows10の個人用設定を選択すると設定ダイアログが表示されます。
Snap0001.png
設定ダイアログの左ペインの色を選び,色を選択するで設定を変更すると,ダークモードに変更できます。
Snap0002.png
詳しい手順についてはい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;
  d:byte;
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
以下のようにスタイルを2つ追加し識別子を入れます。

スタイル 識別子
Win10Modern.Style Win10
Win10ModernDark.Style Win10Dark

Snap0002.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のメッセージ処理が追加されているので,少し複雑になってしまったかもしれません。ユニットのほうに押し込むことも可能ではなかったかと思います。
もしかしたらすぐに動かなくなるかもしれませんが,皆様のお役に立てたらうれしいです。

参考文献

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

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした