本投稿はDelphi Advent Calendar 2019 #14 の記事です。
#お詫び
まず最初にお詫びを，，
昨年のアドベントカレンダーに書いたDelphi VCLでFluent Designに挑戦(その1) - Arcylic Form (アクリル フォーム)ですが，Windows 10 November 2019 Update(1909)で使い物にならなくなってしまいました。動くには動くのですが，ウインドウの移動が亀のようにのろくなってしまいます。非公開のAPIを使ったツケです。申し訳ないです。現在何とかかわす方法を考えているところです。
#ダークモードの切り替えに追随する
と言いながら，Win32アプリで性懲りもなくWindows10のダークモードの切り替えに追随するアプリに挑戦したいと思います。
デスクトップを右クリックしてWindows10の個人用設定を選択すると設定ダイアログが表示されます。
設定ダイアログの左ペインの色を選び，色を選択するで設定を変更すると，ダークモードに変更できます。
詳しい手順については iPentec さんのWindows 10 でUIをダークテーマ (ダークモード) に変更する (Windows 10 Tips)を見ていただければと思います。
アプリーモードの白/黒の選択に追随して個人設定VCLのテーマを入れ替えるというものです。
ついでにアクセントカラーも拾っています。機能をユニットにまとめました。
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.
isLightThemeSet()で白固定・黒固定・自動の３つの設定ができるようにしています。
このユニットを使ったアプリを作ります。
フォームのコードは以下の通りです。フォームにShape1を貼り付けて，アクセントカラーを表示しています。
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 FormCreate(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.FormCreate(Sender: TObject);
begin
ThemeRepaint;
end;
end.
Windows10のダークモードの変更に合わせて，VCLのテーマを変えるため，プロジェクトにテーマを追加します。
今回は'Windows10と'Windows10 Darkののカスタムスタイルを追加しました。
プロジェクトのオプションからアプリケーション－表示で上記のカスタムスタイルをチェックします。また，アクセントカラーを表示するためのShape1を追加してください。
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)
貴重な情報を提供してくださった皆様，ありがとうございます。感謝します。
#Delphi 11 (Alexandria) 対応
-アクセントカラーの取得で変数の演算で範囲外のエラーが出たので修正しました。
-OnFormShowでテーマの変更処理を入れると，Showイベント中にVisibleを変更できないといわれましたので，OnFormCreateで処理するように変更しています。