ダークモードの切り替えについて

Windows10のMay 2019 Updateで追加された機能で，デスクトップを右クリックして表示されるポップアップメニューから，個人用設定を選択すると設定ダイアログが表示されます。左側の色タブを選択し，色を選択するからダークを選ぶとダークモードに変わり，ライトを選ぶと通常のモード(ライトモード)になります。
アクセントカラーもこのダイアログで変更することができます。

Delphi11でVCLのスタイルを追加する

まずはDelphi11で追加されたWindows11のダークスタイルとライトスタイルをプロジェクトに適応してみましょう。

新規プロジェクトを作成する

Delphi11を起動し，Windwos VCLアプリケーションを新規作成します。

プロジェクトにスタイルを追加する

プロジェクトのオプションを開きます。

次に，表示を選択し，カスタムスタイルで，Windows11 Modern DarkとWindows11 Modern Lightをチェックし，デフォルトスタイルをWindows11 Modern Lightにします。

選択が終わったら，保存ボタンをクリックします。

フォームにスタイルを確認したいコンポーネントをのせる

フォームの編集をします。

RAD Studio 10.3.1の新しいVCLとFireMonkey向けスタイル Embarcadero Blogを参考にコンポーネントを配置してみました。

アクセントカラーを表示するためのShape1を追加しています。

ToolbarのToolButtonのキャプションを出すにはTToolBar.ShowCaptionsをTrueにしなくてはならなかったり，TStringGridのカラムの文字をのせるのに右クリックでデザイナを選べないので仕方なくプログラムで文字を入れたり(なので編集画面の画像で文字が出てません，，)，カテゴリボタンのスタイル設定が分からず，表示がいまいちだったりしています。もしかすると違うコンポーネントかも，，詳しい方ぜひ良い方法を教えてください！

実行してみる

設定で，デフォルトスタイルを指定しましたので，実行するとWindows11のスタイルが適用されます。

全てのコントロールに，Windows11風のスタイルが適用されています。ウインドウの角が丸くなっているのが新鮮ですね。よく考えたら，WindowsXPのデザインもそうだったような気がします。角の丸みはWindows11のものより若干小さいように見えますが，Windows10でも同じデザインが適用されるのは良いことのように思います。

ダークモードの変更に応じて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.

次に，このユニットを使うように書き換えます。
フォームに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.Menus, Vcl.ComCtrls, Vcl.ToolWin,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.CheckLst, Vcl.Grids, Vcl.CategoryButtons;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit1: TMenuItem;
    Help1: TMenuItem;
    demo1: TMenuItem;
    demo2: TMenuItem;
    demo3: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    PopupMenu1: TPopupMenu;
    menu11: TMenuItem;
    menu21: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    StatusBar1: TStatusBar;
    Button1: TButton;
    Label1: TLabel;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    CheckBox1: TCheckBox;
    TrackBar1: TTrackBar;
    ProgressBar1: TProgressBar;
    StringGrid1: TStringGrid;
    ListBox1: TListBox;
    CheckListBox1: TCheckListBox;
    RadioGroup1: TRadioGroup;
    CategoryButtons1: TCategoryButtons;
    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}

uses
  uTheme,
  Vcl.Themes,
  Vcl.Styles;

procedure TForm1.ThemeRepaint; // フォームのスタイルを更新
begin
  if isLightTheme then begin
    TStyleManager.TrySetStyle('Windows11 Modern Light');
  end else begin
    TStyleManager.TrySetStyle('Windows11 Modern 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.

スタイル名がWindows11 Modern DarkとWindows11 Modern Lightに変わっています。
WndProcをオーバーライドしてWM_DWMCOLORIZATIONCOLORCHANGEDとWM_SETTINGCHANGEを監視して，変更があればレジストリからダークテーマの情報をWPARAMから新しいアクセントカラーを取得して，フォームのカスタムスタイルを変更しています。

ライトモードでは以下のように表示されます。

ダークモードでは以下のように表示されます。

プログレスバーの色が緑なのがちょっと残念ですね。青だったらよかったんですが，，