Using native Windows dark theme for edits, memos, checkboxes and comboboxes

Buttons done in c1ccbe1e

Might also revert the combobox Style changes in TLoginDialog from a90827e6, if they have some negative side effects.
The dark mode now works without the change, if system theme is dark.

Part of Issue 1696.

Source commit: 2ce0e4b4c87878113010a06de4d51e1caf20df86

source/forms/MessageDlg.cpp

@@ -73,7 +73,7 @@ void __fastcall TMessageButton::WMGetDlgCode(TWMGetDlgCode & Message)
 void __fastcall TMessageButton::CreateWnd()
 {
   TButton::CreateWnd();
-  SetButtonTheme(this);
+  SetExplorerTheme(this);
 }
 //---------------------------------------------------------------------------
 __fastcall TMessageForm::TMessageForm(TComponent * AOwner) : TForm(AOwner)
@@ -816,6 +816,7 @@ TForm * __fastcall TMessageForm::Create(const UnicodeString & Msg,
   HFONT InstructionFont;
   GetInstrutionsTheme(MainInstructionColor, MainInstructionFont, InstructionFont);
 
+  // There is probably some theme we can load the load dark mode color from
   if (UseDarkModeForControl(Result))
   {
     MainInstructionColor = GetLinkColor(Result);
@@ -1159,7 +1160,7 @@ TForm * __fastcall TMessageForm::Create(const UnicodeString & Msg,
     {
       DebugAssert(MoreMessagesUrl.IsEmpty());
 
-      TMemo * MessageMemo = new TMemo(Panel);
+      TMemo * MessageMemo = CreateMemo(Panel);
       MoreMessagesControl = MessageMemo;
       MessageMemo->Name = L"MessageMemo";
       MessageMemo->Parent = Panel;

source/packages/my/PasTools.pas

@@ -83,6 +83,7 @@ function FindFirstEx(
 function SupportsDarkMode: Boolean;
 procedure AllowDarkModeForWindow(Control: TWinControl; Allow: Boolean); overload;
 procedure AllowDarkModeForWindow(Handle: THandle; Allow: Boolean); overload;
+procedure SetDarkModeTheme(Control: TWinControl; SubAppName: string);
 procedure RefreshColorMode;
 procedure ResetSysDarkTheme;
 function GetSysDarkTheme: Boolean;
@@ -156,7 +157,7 @@ type
 implementation
 
 uses
-  StdCtrls, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry;
+  StdCtrls, MultiMon, ShellAPI, Generics.Collections, CommCtrl, ImgList, Registry, UxTheme;
 
 const
   DDExpandDelay = 15000000;
@@ -1135,6 +1136,15 @@ begin
   end;
 end;
 
+procedure SetDarkModeTheme(Control: TWinControl; SubAppName: string);
+begin
+  // See https://gist.github.com/ericoporto/1745f4b912e22f9eabfce2c7166d979b#button
+  Assert(Control.HandleAllocated);
+  SetWindowTheme(Control.Handle, PChar(SubAppName), nil);
+  AllowDarkModeForWindow(Control, True);
+  SendMessage(Control.Handle, WM_THEMECHANGED, 0, 0);
+end;
+
 procedure RefreshColorMode;
 begin
   if SupportsDarkMode then

source/packages/my/UpDownEdit.pas

@@ -28,6 +28,7 @@ type
     FValueType: TValueType;
     FArrowKeys: Boolean;
     FButtonsVisible: Boolean;
+    FDarkMode: Boolean;
     FOnTopClick: TNotifyEvent;
     FOnBottomClick: TNotifyEvent;
     FUpDown: TCustomUpDown;
@@ -54,6 +55,7 @@ type
     procedure SetEditRect;
     procedure SetAlignment(Value: TAlignment);
     procedure SetButtonsVisible(Value: Boolean);
+    procedure SetDarkMode(Value: Boolean);
     procedure WMSize(var Message: TWMSize); message WM_SIZE;
     procedure CMEnter(var Message: TMessage); message CM_ENTER;
     procedure CMExit(var Message: TCMExit); message CM_EXIT;
@@ -90,6 +92,7 @@ type
     property ValueType: TValueType read FValueType write SetValueType default vtInt;
     property Value: Extended read GetValue write SetValue stored IsValueStored;
     property ButtonsVisible: Boolean read FButtonsVisible write SetButtonsVisible default True;
+    property DarkMode: Boolean read FDarkMode write SetDarkMode default False;
     property AutoSelect;
     property AutoSize;
     property BorderStyle;
@@ -163,6 +166,8 @@ type
     procedure WMHScroll(var Message: TWMHScroll); message CN_HSCROLL;
     procedure WMVScroll(var Message: TWMVScroll); message CN_VSCROLL;
     procedure WMSize(var Message: TWMSize); message WM_SIZE;
+  protected
+    procedure CreateWnd; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -185,6 +190,22 @@ begin
   inherited Destroy;
 end;
 
+procedure TEmbededUpDown.CreateWnd;
+var
+  UpDownEdit: TUpDownEdit;
+begin
+  inherited;
+  UpDownEdit := Owner as TUpDownEdit;
+  if Assigned(UpDownEdit) then
+  begin
+    // Theme style for "Spin" found using msstylEditor in aero.msstyles
+    if UpDownEdit.DarkMode then
+      SetDarkModeTheme(Self, 'Explorer');
+    // edit rect is reset while changing the theme, calling always for consistency
+    UpDownEdit.SetEditRect;
+  end;
+end;
+
 procedure TEmbededUpDown.ScrollMessage(var Message: TWMVScroll);
 begin
   if Message.ScrollCode = SB_THUMBPOSITION then begin
@@ -233,6 +254,7 @@ begin
   FEditorEnabled := True;
   FArrowKeys := True;
   FButtonsVisible := True;
+  FDarkMode := False;
   RecreateButton;
 end;
 
@@ -380,6 +402,8 @@ begin
   ResizeButton; // now we know the scaling factor
   SetEditRect;
   SetValue(Value);
+  if DarkMode then
+    SetDarkModeTheme(Self, 'CFD');
 end;
 
 procedure TUpDownEdit.SetEditRect;
@@ -663,5 +687,14 @@ begin
   end;
 end;
 
+procedure TUpDownEdit.SetDarkMode(Value: Boolean);
+begin
+  if DarkMode <> Value then
+  begin
+    FDarkMode := Value;
+    RecreateWnd;
+  end;
+end;
+
 initialization
 end.

source/windows/GUITools.cpp

@@ -28,6 +28,7 @@
 #include <DateUtils.hpp>
 #include <IOUtils.hpp>
 #include <Queue.h>
+#include <Vcl.Themes.hpp>
 
 #include "Animations96.h"
 #include "Animations120.h"
@@ -2463,6 +2464,136 @@ bool __fastcall TDarkUxThemeStyle::DoDrawText(
 }
 //---------------------------------------------------------------------------
 //---------------------------------------------------------------------------
+// For controls that need both custom VCL theme style and custom Windows theme.
+// Currently the checkbox (custom VCL theme for light caption and custom Windows theme for dark more checkbox bitmaps).
+// Current this handles only "button" theme.
+// It's a singleton and can be used only for controls that share the same Windows theme (curently used with "explorer").
+class TDarkExplorerUxThemeStyle : public TDarkUxThemeStyle
+{
+public:
+  virtual __fastcall TDarkExplorerUxThemeStyle();
+  virtual __fastcall ~TDarkExplorerUxThemeStyle();
+  HWND ControlHandle;
+  static const UnicodeString ThemeName;
+
+protected:
+  virtual NativeUInt __fastcall GetTheme(TThemedElement Element);
+  virtual NativeUInt __fastcall GetThemeForDPI(TThemedElement Element, int DPI);
+  virtual void __fastcall UpdateThemes();
+
+protected:
+  typedef std::map<int, NativeUInt> TThemes;
+  TThemes FThemes;
+  bool FInitialized;
+
+  bool DoGetTheme(TThemedElement Element, int DPI, NativeUInt & Result);
+  void Clear();
+};
+//---------------------------------------------------------------------------
+const UnicodeString TDarkExplorerUxThemeStyle::ThemeName = L"explorer";
+//---------------------------------------------------------------------------
+__fastcall TDarkExplorerUxThemeStyle::TDarkExplorerUxThemeStyle()
+{
+  ControlHandle = NULL;
+  FInitialized = true;
+}
+//---------------------------------------------------------------------------
+__fastcall TDarkExplorerUxThemeStyle::~TDarkExplorerUxThemeStyle()
+{
+  Clear();
+}
+//---------------------------------------------------------------------------
+NativeUInt __fastcall TDarkExplorerUxThemeStyle::GetTheme(TThemedElement Element)
+{
+  NativeUInt Result;
+  if (!DoGetTheme(Element, 0, Result))
+  {
+    Result = TDarkUxThemeStyle::GetTheme(Element);
+  }
+  return Result;
+}
+//---------------------------------------------------------------------------
+NativeUInt __fastcall TDarkExplorerUxThemeStyle::GetThemeForDPI(TThemedElement Element, int DPI)
+{
+  NativeUInt Result;
+  if (!DoGetTheme(Element, DPI, Result))
+  {
+    Result = TDarkUxThemeStyle::GetThemeForDPI(Element, DPI);
+  }
+  return Result;
+}
+//---------------------------------------------------------------------------
+bool TDarkExplorerUxThemeStyle::DoGetTheme(TThemedElement Element, int DPI, NativeUInt & Result)
+{
+  bool Handle = DebugAlwaysTrue(ControlHandle != 0) && DebugAlwaysTrue(Element == teButton);
+  if (Handle)
+  {
+    if (DPI == 0)
+    {
+      DPI = Screen->PixelsPerInch;
+    }
+
+    TThemes::const_iterator ITheme = FThemes.find(DPI);
+    if (ITheme != FThemes.end())
+    {
+      Result = ITheme->second;
+    }
+    else
+    {
+      if (!UseThemes())
+      {
+        Result = 0;
+      }
+      else
+      {
+        HTHEME Theme;
+        const wchar_t * ClassName = L"button";
+        if (!IsWin10() || !IsWin10Build(15063) || (DPI == Screen->PixelsPerInch))
+        {
+          Theme = OpenThemeData(ControlHandle, ClassName);
+        }
+        else
+        {
+          Theme = OpenThemeDataForDpi(ControlHandle, ClassName, DPI);
+        }
+        Result = reinterpret_cast<NativeUInt>(Theme);
+      }
+
+      FThemes.insert(std::make_pair(DPI, Result));
+    }
+  }
+  return Result;
+}
+//---------------------------------------------------------------------------
+void TDarkExplorerUxThemeStyle::Clear()
+{
+  TThemes Themes;
+  // TUxThemeStyle.UnloadThemeData implementation (FThemeDataUnLoading) imply
+  // that GetTheme might be called while unloading, so protecting against that
+  FThemes.swap(Themes);
+
+  TThemes::iterator I = Themes.begin();
+  while (I != Themes.end())
+  {
+    CloseThemeData(reinterpret_cast<HTHEME>(I->second));
+    ++I;
+  }
+}
+//---------------------------------------------------------------------------
+void __fastcall TDarkExplorerUxThemeStyle::UpdateThemes()
+{
+  TDarkUxThemeStyle::UpdateThemes();
+  // This is only ever called from the constructor, where FThemes is not initialized yet.
+  // It's not called for theme updates, as it is called only for the detault global app theme instance.
+  if (DebugAlwaysFalse(FInitialized))
+  {
+    Clear();
+  }
+}
+//---------------------------------------------------------------------------
+std::unique_ptr<TDarkExplorerUxThemeStyle> DarkExplorerUxThemeStyle;
+//---------------------------------------------------------------------------
+//---------------------------------------------------------------------------
 // Based on:
 // https://stackoverflow.com/q/6912424/850848
 // https://stackoverflow.com/q/4685863/850848
@@ -2540,6 +2671,19 @@ bool HandleMessageByDarkStyleHook(TMessage & Msg, TWinControl * Control, std::un
   return Result;
 }
 //---------------------------------------------------------------------------
+void SetColorModeTheme(TWinControl * Control, const UnicodeString & DarkSubAppName)
+{
+  if (UseDarkModeForControl(Control))
+  {
+    SetDarkModeTheme(Control, DarkSubAppName);
+  }
+}
+//---------------------------------------------------------------------------
+void SetExplorerTheme(TWinControl * Button)
+{
+  SetColorModeTheme(Button, TDarkExplorerUxThemeStyle::ThemeName);
+}
+//---------------------------------------------------------------------------
 //---------------------------------------------------------------------------
 class TDarkGroupBoxStyleHook : public TGroupBoxStyleHook
 {
@@ -2606,6 +2750,7 @@ public:
   __fastcall virtual TCheckBoxEx(TComponent * AOwner);
 protected:
   virtual void __fastcall WndProc(TMessage & Msg);
+  virtual void __fastcall CreateWnd();
 private:
   std::unique_ptr<TDarkCheckBoxStyleHook> FStyleHook;
 };
@@ -2629,14 +2774,27 @@ void __fastcall TDarkCheckBoxStyleHook::PaintBackground(TCanvas * Canvas)
 //---------------------------------------------------------------------------
 TCustomStyleServices * __fastcall TDarkCheckBoxStyleHook::StyleServices()
 {
-  return TDarkUxThemeStyle::Instance();
+  if (DarkExplorerUxThemeStyle.get() == NULL)
+  {
+    DarkExplorerUxThemeStyle.reset(new TDarkExplorerUxThemeStyle());
+  }
+  // Handle is safer than a pointer
+  DarkExplorerUxThemeStyle->ControlHandle = Control->HandleAllocated() ? Control->Handle : 0;
+  return DarkExplorerUxThemeStyle.get();
 }
 //---------------------------------------------------------------------------
+//---------------------------------------------------------------------------
 __fastcall TCheckBoxEx::TCheckBoxEx(TComponent * AOwner) :
   TCheckBox(AOwner)
 {
 }
 //---------------------------------------------------------------------------
+void __fastcall TCheckBoxEx::CreateWnd()
+{
+  TCheckBox::CreateWnd();
+  SetColorModeTheme(this, TDarkExplorerUxThemeStyle::ThemeName);
+}
+//---------------------------------------------------------------------------
 void __fastcall TCheckBoxEx::WndProc(TMessage & Msg)
 {
   if (!HandleMessageByDarkStyleHook(Msg, this, FStyleHook))
@@ -2646,17 +2804,6 @@ void __fastcall TCheckBoxEx::WndProc(TMessage & Msg)
 }
 //---------------------------------------------------------------------------
 //---------------------------------------------------------------------------
-void SetButtonTheme(TButton * Button)
-{
-  if (UseDarkModeForControl(Button))
-  {
-    // See https://gist.github.com/ericoporto/1745f4b912e22f9eabfce2c7166d979b#button
-    SetWindowTheme(Button->Handle, L"Explorer", NULL);
-    AllowDarkModeForWindow(Button, true);
-    SendMessage(Button->Handle, WM_THEMECHANGED, 0, 0);
-  }
-}
-//---------------------------------------------------------------------------
 class TButtonEx : public TButton
 {
 public:
@@ -2673,7 +2820,7 @@ __fastcall TButtonEx::TButtonEx(TComponent * AOwner) :
 void __fastcall TButtonEx::CreateWnd()
 {
   TButton::CreateWnd();
-  SetButtonTheme(this);
+  SetExplorerTheme(this);
 }
 //---------------------------------------------------------------------------
 TButton * CreateButton(TComponent * AOwner)
@@ -2682,6 +2829,71 @@ TButton * CreateButton(TComponent * AOwner)
 }
 //---------------------------------------------------------------------------
 //---------------------------------------------------------------------------
+class TComboBoxEx : public TUIStateAwareComboBox
+{
+public:
+  __fastcall virtual TComboBoxEx(TComponent * AOwner);
+protected:
+  virtual void __fastcall CreateWnd();
+};
+//---------------------------------------------------------------------------
+__fastcall ::TComboBoxEx::TComboBoxEx(TComponent * AOwner) :
+  TUIStateAwareComboBox(AOwner)
+{
+}
+//---------------------------------------------------------------------------
+void __fastcall ::TComboBoxEx::CreateWnd()
+{
+  TUIStateAwareComboBox::CreateWnd();
+  SetColorModeTheme(this, L"CFD");
+}
+//---------------------------------------------------------------------------
+//---------------------------------------------------------------------------
+class TEditEx : public TEdit
+{
+public:
+  __fastcall virtual TEditEx(TComponent * AOwner);
+protected:
+  virtual void __fastcall CreateWnd();
+};
+//---------------------------------------------------------------------------
+__fastcall TEditEx::TEditEx(TComponent * AOwner) :
+  TEdit(AOwner)
+{
+}
+//---------------------------------------------------------------------------
+void __fastcall TEditEx::CreateWnd()
+{
+  TEdit::CreateWnd();
+  SetColorModeTheme(this, L"CFD");
+}
+//---------------------------------------------------------------------------
+//---------------------------------------------------------------------------
+class TMemoEx : public TMemo
+{
+public:
+  __fastcall virtual TMemoEx(TComponent * AOwner);
+protected:
+  virtual void __fastcall CreateWnd();
+};
+//---------------------------------------------------------------------------
+__fastcall TMemoEx::TMemoEx(TComponent * AOwner) :
+  TMemo(AOwner)
+{
+}
+//---------------------------------------------------------------------------
+void __fastcall TMemoEx::CreateWnd()
+{
+  TMemo::CreateWnd();
+  SetColorModeTheme(this, L"CFD");
+}
+//---------------------------------------------------------------------------
+TMemo * CreateMemo(TComponent * AOwner)
+{
+  return new TMemoEx(AOwner);
+}
+//---------------------------------------------------------------------------
+//---------------------------------------------------------------------------
 void __fastcall FindComponentClass(
   void *, TReader *, const UnicodeString DebugUsedArg(ClassName), TComponentClass & ComponentClass)
 {
@@ -2691,7 +2903,7 @@ void __fastcall FindComponentClass(
   }
   else if (ComponentClass == __classid(TComboBox))
   {
-    ComponentClass = __classid(TUIStateAwareComboBox);
+    ComponentClass = __classid(::TComboBoxEx);
   }
   else if (ComponentClass == __classid(TGroupBox))
   {
@@ -2705,6 +2917,14 @@ void __fastcall FindComponentClass(
   {
     ComponentClass = __classid(TButtonEx);
   }
+  else if (ComponentClass == __classid(TEdit))
+  {
+    ComponentClass = __classid(TEditEx);
+  }
+  else if (ComponentClass == __classid(TMemo))
+  {
+    ComponentClass = __classid(TMemoEx);
+  }
 }
 //---------------------------------------------------------------------------
 bool CanShowTimeEstimate(TDateTime StartTime)

source/windows/GUITools.h

@@ -41,8 +41,9 @@ TPanel * CreateBlankPanel(TComponent * Owner);
 TPanel * CreateLabelPanel(TPanel * Parent, const UnicodeString & Label);
 TLabel * CreateLabel(TComponent * AOwner);
 TCheckBox * CreateCheckBox(TComponent * AOwner);
-void SetButtonTheme(TButton * Button);
+void SetExplorerTheme(TWinControl * Control);
 TButton * CreateButton(TComponent * AOwner);
+TMemo * CreateMemo(TComponent * AOwner);
 void __fastcall SelectScaledImageList(TImageList * ImageList);
 void __fastcall CopyImageList(TImageList * TargetList, TImageList * SourceList);
 void __fastcall LoadDialogImage(TImage * Image, const UnicodeString & ImageName);

source/windows/VCLCommon.cpp

@@ -23,6 +23,7 @@
 #include <TB2ExtItems.hpp>
 #include <TBXExtItems.hpp>
 #include <IEListView.hpp>
+#include <UpDownEdit.hpp>
 #include <WinApi.h>
 #include <vssym32.h>
 //---------------------------------------------------------------------------
@@ -1101,47 +1102,50 @@ TColor GetControlColor(TControl * Control)
 //---------------------------------------------------------------------------
 void ApplyDarkModeOnControl(TControl * Control)
 {
-  TPublicControl * PublicControl = static_cast<TPublicControl *>(Control);
-
-  TColor BtnFaceColor = GetBtnFaceColor();
-  TColor WindowColor = GetWindowColor();
-  if (dynamic_cast<TForm *>(Control) != NULL)
+  TWinControl * WinControl = dynamic_cast<TWinControl *>(Control);
+  if (WinControl != NULL)
   {
-    DebugAssert((PublicControl->Color == clBtnFace) || (PublicControl->Color == BtnFaceColor));
-    PublicControl->Color = BtnFaceColor;
-    PublicControl->Font->Color = GetWindowTextColor(PublicControl->Color);
-  }
+    TPublicControl * PublicControl = static_cast<TPublicControl *>(Control);
 
-  if (dynamic_cast<TPanel *>(Control) != NULL)
-  {
-    DebugAssert(!PublicControl->ParentColor);
-    if ((PublicControl->Color == clWindow) || (PublicControl->Color == WindowColor))
+    TColor BtnFaceColor = GetBtnFaceColor();
+    TColor WindowColor = GetWindowColor();
+
+    if (IsWindowColorControl(Control))
     {
+      DebugAssert((PublicControl->Color == clWindow) || (PublicControl->Color == WindowColor));
+      DebugAssert(!PublicControl->ParentColor);
       PublicControl->Color = WindowColor;
     }
-    else
+
+    if (dynamic_cast<TForm *>(Control) != NULL)
     {
       DebugAssert((PublicControl->Color == clBtnFace) || (PublicControl->Color == BtnFaceColor));
       PublicControl->Color = BtnFaceColor;
+      PublicControl->Font->Color = GetWindowTextColor(PublicControl->Color);
     }
-  }
-
-  if (IsWindowColorControl(Control))
-  {
-    DebugAssert((PublicControl->Color == clWindow) || (PublicControl->Color == WindowColor));
-    DebugAssert(!PublicControl->ParentColor);
-    PublicControl->Color = WindowColor;
-  }
-
-  TWinControl * WinControl = dynamic_cast<TWinControl *>(Control);
-  if (WinControl != NULL)
-  {
-    if (dynamic_cast<TTreeView *>(WinControl) != NULL)
+    else if (dynamic_cast<TPanel *>(Control) != NULL)
+    {
+      DebugAssert(!PublicControl->ParentColor);
+      if ((PublicControl->Color == clWindow) || (PublicControl->Color == WindowColor))
+      {
+        PublicControl->Color = WindowColor;
+      }
+      else
+      {
+        DebugAssert((PublicControl->Color == clBtnFace) || (PublicControl->Color == BtnFaceColor));
+        PublicControl->Color = BtnFaceColor;
+      }
+    }
+    else if (dynamic_cast<TTreeView *>(WinControl) != NULL)
     {
       // for dark scrollbars
       WinControl->HandleNeeded();
       AllowDarkModeForWindow(WinControl, true);
     }
+    else if (dynamic_cast<TUpDownEdit *>(WinControl) != NULL)
+    {
+      dynamic_cast<TUpDownEdit *>(WinControl)->DarkMode = true;
+    }
 
     for (int Index = 0; Index < WinControl->ControlCount; Index++)
     {