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

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

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

お詫び

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

ダークモードの切り替えに追随する

と言いながら,Win32アプリで性懲りもなくWindows10のダークモードの切り替えに追随するアプリに挑戦したいと思います。
デスクトップを右クリックしてWindows10の個人用設定を選択すると設定ダイアログが表示されます。
Snap0001.png
設定ダイアログの左ペインの色を選び,色を選択するで設定を変更すると,ダークモードに変更できます。
Snap0002.png
詳しい手順についてはいiPentecさんのWindows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)を見ていただければと思います。

アプリーモードの白/黒の選択に追随して個人設定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 :=(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; // アクセントカラー
end.

isLightThemeSet()で白固定・黒固定・自動の3つの設定ができるようにしています。

このユニットを使ったアプリを作ります。
フォームのコードは以下の通りです。フォームに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 FormShow(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.FormShow(Sender: TObject);
begin
  ThemeRepaint;
end;

end.

Windows10のダークモードの変更に合わせて,VCLのテーマを変えるため,プロジェクトにテーマを追加します。
今回は'Windows10と'Windows10 Darkののカスタムスタイルを追加しました。
プロジェクトオプションからアプリケーション-表示で上記のカスタムスタイルをチェックします。また,アクセントカラーを表示するためのShape1を追加してください。
Snap0003.png

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

参考文献

Windows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips) - iPentec
VCL スタイル (Delphi XE2 以降) - DEKOのアヤシいお部屋。
クラシック デスクトップ アプリの Windows テーマ追従 - grabacr.nét PaaS (Patchouli as a Shachiku)
貴重な情報を提供してくださった皆様,ありがとうございます。感謝します。

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
ユーザーは見つかりませんでした