Bug 1776: Dark theme for column headers

https://winscp.net/tracker/1776

Source commit: 9497cce3de1649f384bc9a01f9378693581862d7

source/forms/CustomScpExplorer.cpp

@@ -8911,14 +8911,25 @@ void __fastcall TCustomScpExplorerForm::QueueSplitterDblClick(TObject * /*Sender
   PostComponentHide(fcQueueView);
 }
 //---------------------------------------------------------------------------
-void __fastcall TCustomScpExplorerForm::WMWinIniChange(TMessage & Message)
+void __fastcall TCustomScpExplorerForm::ThemeChanged()
+{
+  // We hoped this will refresh scrollbar colors, but it does not have any effect here.
+  RefreshColorMode();
+  WinConfiguration->ResetSysDarkTheme();
+  ConfigurationChanged();
+  ConfigureInterface();
+  // Should be called for all controls
+  RemoteDirView->Perform(WM_THEMECHANGED, 0, 0);
+}
+//---------------------------------------------------------------------------
+void __fastcall TCustomScpExplorerForm::WMSettingChange(TMessage & Message)
 {
   // Do not handle, when shutting down anyway (maybe also when not setup completelly yet?)
-  if (!FInvalid)
+  if (!FInvalid &&
+      (Message.LParam != 0) &&
+      (wcscmp(reinterpret_cast<LPCWCH>(Message.LParam), L"ImmersiveColorSet") == 0))
   {
-    WinConfiguration->ResetSysDarkTheme();
-    ConfigurationChanged();
-    ConfigureInterface();
+    ThemeChanged();
   }
   TForm::Dispatch(&Message);
 }
@@ -9007,8 +9018,8 @@ void __fastcall TCustomScpExplorerForm::Dispatch(void * Message)
       CMDpiChanged(*M);
       break;
 
-    case WM_WININICHANGE:
-      WMWinIniChange(*M);
+    case WM_SETTINGCHANGE:
+      WMSettingChange(*M);
       break;
 
     case CM_DIALOGKEY:
@@ -9554,6 +9565,9 @@ TDragDropFilesEx * __fastcall TCustomScpExplorerForm::CreateDragDropFilesEx()
 void __fastcall TCustomScpExplorerForm::CreateWnd()
 {
   TForm::CreateWnd();
+
+  // win32-darkmode calls AllowDarkModeForWindow(this, true) here, but it does not seem to have any effect
+
   if (FSessionsDragDropFilesEx == NULL)
   {
     FSessionsDragDropFilesEx = CreateDragDropFilesEx();

source/forms/CustomScpExplorer.h

@@ -679,7 +679,7 @@ protected:
   virtual void __fastcall FileColorsChanged();
   TColor __fastcall PanelColor();
   TColor __fastcall DisabledPanelColor();
-  void __fastcall WMWinIniChange(TMessage & Message);
+  void __fastcall WMSettingChange(TMessage & Message);
   void __fastcall ResetIncrementalSearch();
   void __fastcall IncrementalSearch(const UnicodeString & Text, bool SkipCurrent, bool Reverse);
   TListItem * __fastcall GetNextFile(TListItem * Item, bool Reverse);
@@ -688,6 +688,7 @@ protected:
   DYNAMIC void __fastcall Deactivate();
   void __fastcall CenterReconnectToolbar();
   void __fastcall DoOpenFolderOrWorkspace(const UnicodeString & Name, bool ConnectFirstTerminal);
+  virtual void __fastcall ThemeChanged();
 
 public:
   virtual __fastcall ~TCustomScpExplorerForm();

source/forms/ScpCommander.cpp

@@ -2306,3 +2306,9 @@ void __fastcall TScpCommanderForm::BrowseFile()
   WinConfiguration->ScpCommander = ScpCommander;
 }
 //---------------------------------------------------------------------------
+void __fastcall TScpCommanderForm::ThemeChanged()
+{
+  TCustomScpExplorerForm::ThemeChanged();
+  LocalDirView->Perform(WM_THEMECHANGED, 0, 0);
+}
+//---------------------------------------------------------------------------

source/forms/ScpCommander.h

@@ -598,6 +598,7 @@ protected:
   virtual void __fastcall StartingDisconnected();
   virtual void __fastcall UpdateImages();
   virtual void __fastcall FileColorsChanged();
+  virtual void __fastcall ThemeChanged();
 
 public:
   __fastcall TScpCommanderForm(TComponent* Owner);

source/packages/filemng/CustomDirView.pas

@@ -174,6 +174,7 @@ type
     FOnChangeFocus: TDirViewChangeFocusEvent;
 
     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
+    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
     procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
@@ -318,6 +319,7 @@ type
     procedure DoHistoryGo(Index: Integer);
     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
+    procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
     procedure EnsureSelectionRedrawn;
     function HiddenCount: Integer; virtual; abstract;
     function FilteredCount: Integer; virtual; abstract;
@@ -332,6 +334,7 @@ type
     procedure Load(DoFocusSomething: Boolean); virtual;
     procedure NeedImageLists(Recreate: Boolean);
     procedure FreeImageLists;
+    procedure UpdateDarkMode;
     procedure DoUpdateStatusBar(Force: Boolean = False);
     procedure DoCustomDrawItem(Item: TListItem; Stage: TCustomDrawStage);
     property ImageList16: TImageList read FImageList16;
@@ -537,7 +540,7 @@ var
 implementation
 
 uses
-  Math, DirViewColProperties, UITypes, Types, OperationWithTimeout;
+  Math, DirViewColProperties, UITypes, Types, OperationWithTimeout, Winapi.UxTheme, Vcl.Themes;
 
 const
   Space = ' ';
@@ -913,6 +916,35 @@ begin
   end;
 end;
 
+procedure TCustomDirView.WMNotify(var Msg: TWMNotify);
+begin
+  // This all is to make header text white in dark mode
+  if DarkMode and SupportsDarkMode and (FHeaderHandle <> 0) and (Msg.NMHdr^.hWndFrom = FHeaderHandle) then
+  begin
+    if Msg.NMHdr.code = NM_CUSTOMDRAW then
+    begin
+      with PNMLVCustomDraw(Msg.NMHdr)^ do
+      begin
+        if nmcd.dwDrawStage = CDDS_PREPAINT then
+        begin
+          inherited;
+          Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
+        end
+          else
+        if nmcd.dwDrawStage = CDDS_ITEMPREPAINT then
+        begin
+          SetTextColor(nmcd.hdc, ColorToRGB(Font.Color));
+          Msg.Result := CDRF_DODEFAULT;
+          inherited;
+        end
+          else inherited;
+      end;
+    end
+      else inherited;
+  end
+    else inherited;
+end;
+
 procedure TCustomDirView.CNNotify(var Message: TWMNotify);
 
   procedure DrawOverlayImage(DC: HDC; Image: Integer);
@@ -1180,6 +1212,31 @@ begin
   LargeImages := nil;
 end;
 
+procedure TCustomDirView.WMThemeChanged(var Message: TMessage);
+begin
+  if SupportsDarkMode then // To reduce impact
+  begin
+    UpdateDarkMode;
+    RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
+  end;
+
+  inherited;
+end;
+
+procedure TCustomDirView.UpdateDarkMode;
+begin
+  if SupportsDarkMode then // To reduce impact
+  begin
+    AllowDarkModeForWindow(Self, DarkMode);
+
+    if FHeaderHandle <> 0 then
+    begin
+      AllowDarkModeForWindow(FHeaderHandle, DarkMode);
+      SendMessage(FHeaderHandle, WM_THEMECHANGED, 0, 0);
+    end;
+  end;
+end;
+
 procedure TCustomDirView.CreateWnd;
 begin
   inherited;
@@ -1188,7 +1245,14 @@ begin
     PopupMenu.Autopopup := False;
   FDragDropFilesEx.DragDropControl := Self;
 
-  if DarkMode then AllowDarkModeForWindow(Self, DarkMode);
+  if SupportsDarkMode then
+  begin
+    // This enabled dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme.
+    // The 'ItemsView' has better dark mode selection color, but on the other hand is does not have dark scrollbars.
+    // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ.
+    SetWindowTheme(FHeaderHandle, 'ItemsView', nil);
+    if DarkMode then UpdateDarkMode;
+  end;
 
   NeedImageLists(False);
 end;
@@ -3254,7 +3318,7 @@ begin
     FDarkMode := Value;
     // Call only when switching to dark more and when switching back to the light mode.
     // But not for initial light mode - To reduce an impact of calling an undocumented function.
-    if HandleAllocated then AllowDarkModeForWindow(Self, DarkMode);
+    if HandleAllocated then UpdateDarkMode;
   end;
 end;
 

source/packages/my/PasTools.pas

@@ -81,7 +81,9 @@ procedure ForceColorChange(Control: TWinControl);
 function IsUncPath(Path: string): Boolean;
 
 function SupportsDarkMode: Boolean;
-procedure AllowDarkModeForWindow(Control: TWinControl; Allow: Boolean);
+procedure AllowDarkModeForWindow(Control: TWinControl; Allow: Boolean); overload;
+procedure AllowDarkModeForWindow(Handle: THandle; Allow: Boolean); overload;
+procedure RefreshColorMode;
 
 type
   TApiPathEvent = function(Path: string): string;
@@ -985,30 +987,16 @@ begin
   Result := (Copy(Path, 1, 2) = '\\') or (Copy(Path, 1, 2) = '//');
 end;
 
+type TPreferredAppMode = (pamDefault, pamAllowDark, pamForceDark, pamForceLight, pamMax);
+
 var
-  AllowDarkModeForWindowLoaded: Boolean = False;
   AAllowDarkModeForWindow: function(hWnd: HWND; Allow: BOOL): BOOL; stdcall;
+  ARefreshImmersiveColorPolicyState: procedure; stdcall;
+  ASetPreferredAppMode: function(AppMode: TPreferredAppMode): TPreferredAppMode; stdcall;
 
 function SupportsDarkMode: Boolean;
-var
-  OSVersionInfo: TOSVersionInfoEx;
-  UxThemeLib: HMODULE;
 begin
-  if not AllowDarkModeForWindowLoaded then
-  begin
-    OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
-    if GetVersionEx(OSVersionInfo) and (OSVersionInfo.dwBuildNumber >= 17763) then
-    begin
-      UxThemeLib := GetModuleHandle('UxTheme');
-      if UxThemeLib <> 0 then
-      begin
-        AAllowDarkModeForWindow := GetProcAddress(UxThemeLib, MakeIntResource(133));
-      end;
-    end;
-    AllowDarkModeForWindowLoaded := True;
-  end;
-
-  Result := Assigned(AAllowDarkModeForWindow);
+  Result := Assigned(AAllowDarkModeForWindow) and Assigned(ARefreshImmersiveColorPolicyState);
 end;
 
 procedure AllowDarkModeForWindow(Control: TWinControl; Allow: Boolean);
@@ -1020,8 +1008,25 @@ begin
   end;
 end;
 
+procedure AllowDarkModeForWindow(Handle: THandle; Allow: Boolean);
+begin
+  if SupportsDarkMode then
+  begin
+    AAllowDarkModeForWindow(Handle, Allow);
+  end;
+end;
+
+procedure RefreshColorMode;
+begin
+  if SupportsDarkMode then
+  begin
+    ARefreshImmersiveColorPolicyState;
+  end;
+end;
+
 var
   Lib: THandle;
+  OSVersionInfo: TOSVersionInfoEx;
 initialization
   Lib := LoadLibrary('shcore');
   if Lib <> 0 then
@@ -1036,6 +1041,36 @@ initialization
     SystemParametersInfoForDpi := GetProcAddress(Lib, 'SystemParametersInfoForDpi');
   end;
 
+  AAllowDarkModeForWindow := nil;
+  ARefreshImmersiveColorPolicyState := nil;
+  ASetPreferredAppMode := nil;
+
+  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
+  if GetVersionEx(OSVersionInfo) and (OSVersionInfo.dwBuildNumber >= 17763) then
+  begin
+    Lib := GetModuleHandle('uxtheme');
+    if Lib <> 0 then
+    begin
+      AAllowDarkModeForWindow := GetProcAddress(Lib, MakeIntResource(133));
+      ARefreshImmersiveColorPolicyState := GetProcAddress(Lib, MakeIntResource(104));
+      if OSVersionInfo.dwBuildNumber >= 18334 then
+      begin
+        ASetPreferredAppMode := GetProcAddress(Lib, MakeIntResource(135));
+      end;
+
+      if SupportsDarkMode then
+      begin
+        // Both SetPreferredAppMode and RefreshImmersiveColorPolicyState is needed for
+        // dark list view headers and dark list view and tree view scrollbars
+        if Assigned(ASetPreferredAppMode) then
+        begin
+          ASetPreferredAppMode(pamAllowDark);
+        end;
+        ARefreshImmersiveColorPolicyState;
+      end;
+    end;
+  end;
+
 finalization
   // No need to release individual image lists as they are owned by Application object.
   FreeAndNil(ShellImageLists);