Issue 2356 – Dark theme for queue column headers

https://winscp.net/tracker/2356

Source commit: 6a498457ecbfd9bb3a4f259a45ed43aba3f04866

source/forms/CustomScpExplorer.cpp

@@ -9502,6 +9502,7 @@ void __fastcall TCustomScpExplorerForm::UpdateControls()
     }
 
     SessionsPageControl->TabTheme = UseDarkTheme ? CurrentTheme : NULL;
+    QueueView3->DarkMode = UseDarkTheme;
 
     UnicodeString CurrentHiContrastThemeName = (FHiContrastTheme != NULL) ? FHiContrastTheme->Name : EmptyStr;
     bool HiContrast = WinConfiguration->HiContrast;
@@ -9894,6 +9895,7 @@ void __fastcall TCustomScpExplorerForm::ThemeChanged()
   UpdateControls();
   // Should be called for all controls
   RemoteDirView->Perform(WM_THEMECHANGED, 0, 0);
+  QueueView3->Perform(WM_THEMECHANGED, 0, 0);
 }
 //---------------------------------------------------------------------------
 void __fastcall TCustomScpExplorerForm::WMSettingChange(TMessage & Message)

source/forms/CustomScpExplorer.dfm

@@ -215,12 +215,25 @@ object CustomScpExplorerForm: TCustomScpExplorerForm
       ResizeStyle = rsUpdate
       OnCanResize = QueueFileListSplitterCanResize
     end
-    object QueueView3: TListView
+    object QueueView3: TIEListView
       Left = 0
       Top = 47
       Width = 620
       Height = 70
+      ShowColumnIcon = False
       Align = alClient
+      ColumnClick = False
+      DoubleBuffered = True
+      ReadOnly = True
+      RowSelect = True
+      ParentDoubleBuffered = False
+      PopupMenu = NonVisualDataModule.QueuePopup
+      TabOrder = 0
+      OnChange = QueueView3Change
+      OnDeletion = QueueView3Deletion
+      OnEnter = QueueView3Enter
+      OnExit = QueueView3Exit
+      NortonLike = nlOff
       Columns = <
         item
           Caption = 'Operation'
@@ -261,23 +274,13 @@ object CustomScpExplorerForm: TCustomScpExplorerForm
           MinWidth = 20
           Width = 80
         end>
-      ColumnClick = False
-      DoubleBuffered = True
       DragMode = dmAutomatic
-      ReadOnly = True
-      RowSelect = True
-      ParentDoubleBuffered = False
-      PopupMenu = NonVisualDataModule.QueuePopup
+      MultiSelect = False
       SmallImages = GlyphsModule.QueueImages
       StateImages = GlyphsModule.QueueImages
-      TabOrder = 0
       ViewStyle = vsReport
-      OnChange = QueueView3Change
       OnContextPopup = QueueView3ContextPopup
-      OnDeletion = QueueView3Deletion
       OnEndDrag = QueueView3EndDrag
-      OnEnter = QueueView3Enter
-      OnExit = QueueView3Exit
       OnDragDrop = QueueView3DragDrop
       OnDragOver = QueueView3DragOver
       OnSelectItem = QueueView3SelectItem

source/forms/CustomScpExplorer.h

@@ -75,7 +75,7 @@ __published:
   TUnixDirView *RemoteDirView;
   TPanel *RemoteDirPanel;
   TTBXDock *TopDock;
-  TListView *QueueView3;
+  TIEListView *QueueView3;
   TPanel *QueuePanel;
   TSplitter *QueueSplitter;
   TTBXToolbar *QueueToolbar;

source/packages/filemng/CustomDirView.pas

@@ -172,7 +172,6 @@ type
     FMask: string;
     FNaturalOrderNumericalSorting: Boolean;
     FAlwaysSortDirectoriesByName: Boolean;
-    FDarkMode: Boolean;
     FScrollOnDragOver: TListViewScrollOnDragOver;
     FStatusFileInfo: TStatusFileInfo;
     FOnBusy: TDirViewBusy;
@@ -182,7 +181,6 @@ type
     FRecreatingWnd: Integer;
 
     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
-    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
     procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
@@ -333,13 +331,11 @@ type
     procedure SetMask(Value: string); virtual;
     procedure SetNaturalOrderNumericalSorting(Value: Boolean);
     procedure SetAlwaysSortDirectoriesByName(Value: Boolean);
-    procedure SetDarkMode(Value: Boolean);
     procedure ScrollOnDragOverBeforeUpdate(ObjectToValidate: TObject);
     procedure ScrollOnDragOverAfterUpdate;
     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;
@@ -355,7 +351,6 @@ type
     function NeedImageList(Size: TImageListSize; Recreate: Boolean; var OverlayImages: TImageList): TImageList;
     procedure NeedImageLists(Recreate: Boolean);
     procedure FreeImageLists;
-    procedure UpdateDarkMode;
     procedure DoUpdateStatusBar(Force: Boolean = False);
     procedure DoCustomDrawItem(Item: TListItem; Stage: TCustomDrawStage);
     procedure ItemCalculatedSizeUpdated(Item: TListItem; OldSize, NewSize: Int64);
@@ -457,7 +452,6 @@ type
     property Mask: string read FMask write SetMask;
     property NaturalOrderNumericalSorting: Boolean read FNaturalOrderNumericalSorting write SetNaturalOrderNumericalSorting;
     property AlwaysSortDirectoriesByName: Boolean read FAlwaysSortDirectoriesByName write SetAlwaysSortDirectoriesByName;
-    property DarkMode: Boolean read FDarkMode write SetDarkMode;
     property DirViewStyle: TDirViewStyle read GetDirViewStyle write SetDirViewStyle;
 
     property OnContextPopup;
@@ -571,7 +565,7 @@ const
 implementation
 
 uses
-  Math, DirViewColProperties, UITypes, Types, OperationWithTimeout, Winapi.UxTheme, Vcl.Themes, System.IOUtils;
+  Math, DirViewColProperties, UITypes, Types, OperationWithTimeout, System.IOUtils;
 
 const
   ResDirUp = 'DIRUP%2.2d';
@@ -886,7 +880,6 @@ begin
   FMask := '';
   FNaturalOrderNumericalSorting := True;
   FAlwaysSortDirectoriesByName := False;
-  FDarkMode := False;
 
   FOnHistoryChange := nil;
   FOnPathChange := nil;
@@ -950,37 +943,6 @@ begin
   end;
 end;
 
-procedure TCustomDirView.WMNotify(var Msg: TWMNotify);
-begin
-  // This all is to make header text white in dark mode.
-  if Msg.NMHdr.code = NM_CUSTOMDRAW then
-  begin
-    if DarkMode and SupportsDarkMode and
-       GetSysDarkTheme and // When system app theme is light, headers are not dark
-       (FHeaderHandle <> 0) and (Msg.NMHdr^.hWndFrom = FHeaderHandle) 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.DrawThumbnail(Item: TListItem; DC: HDC);
 var
   Rect: TRect;
@@ -1332,31 +1294,6 @@ 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;
@@ -1365,19 +1302,6 @@ begin
     PopupMenu.Autopopup := False;
   FDragDropFilesEx.DragDropControl := Self;
 
-  if SupportsDarkMode then
-  begin
-    // This enables dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme.
-    // The 'ItemsView' has better (Explorer-like) dark mode selection color, but on the other hand it does not have dark scrollbars.
-    // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ.
-    // The 'DarkMode_Explorer' uses the standard selection color (bright blue).
-
-    // Enables dark headers:
-    SetWindowTheme(FHeaderHandle, 'ItemsView', nil);
-
-    if DarkMode then UpdateDarkMode;
-  end;
-
   NeedImageLists(False);
 end;
 
@@ -3587,17 +3511,6 @@ begin
   end;
 end;
 
-procedure TCustomDirView.SetDarkMode(Value: Boolean);
-begin
-  if DarkMode <> Value then
-  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 UpdateDarkMode;
-  end;
-end;
-
 // WM_SETFOCUS works even when focus is moved to another window/app,
 // while .Enter works only when focus is moved to other control of the same window.
 procedure TCustomDirView.WMSetFocus(var Message: TWMSetFocus);

source/packages/my/IEListView.pas

@@ -97,9 +97,6 @@ type
     property ParentForm: TCustomForm read FParentForm;
     {Set the sort column of the listview}
     property SortColumn: Integer read FSortColumn write SetSortColumn;
-    {Show the sorting symbol in the listview's header:}
-    property ShowColumnIcon: Boolean
-      read FShowColumnIcon write SetShowColumnIcon default True;
     {Sortorder of actual sort column}
     property SortAscending: Boolean
       read FSortAscending write SetSortAscending default True;
@@ -113,6 +110,9 @@ type
       read  FOnHeaderEndTrack write FOnHeaderEndTrack;
     property OnRecreate: TNotifyEvent
       read  FOnRecreate write FOnRecreate;
+    {Show the sorting symbol in the listview's header:}
+    property ShowColumnIcon: Boolean
+      read FShowColumnIcon write SetShowColumnIcon default True;
 
     property Align;
     property AllocBy;

source/packages/my/NortonLikeListView.pas

@@ -33,13 +33,14 @@ type
     FLButtonDownShiftState: TShiftState;
     FLButtonDownPos: TPoint;
     FLastSelectMethod: TSelectMethod;
+    FDarkMode: Boolean;
     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
     procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
     procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
     procedure WMChar(var Message: TWMChar); message WM_CHAR;
-    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
+    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
     procedure LVMEditLabel(var Message: TMessage); message LVM_EDITLABEL;
     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
@@ -50,6 +51,8 @@ type
     procedure ItemSelected(Item: TListItem; Index: Integer);
     procedure ItemUnselected(Item: TListItem; Index: Integer);
     procedure SelectAll(Mode: TSelectMode; Exclude: TListItem); reintroduce; overload;
+    procedure WMThemeChanged(var Msg: TMessage); message WM_THEMECHANGED;
+    procedure SetDarkMode(Value: Boolean);
   protected
     { Protected declarations }
     FClearingItems: Boolean;
@@ -81,6 +84,7 @@ type
     procedure SetItemSelectedByIndex(Index: Integer; Select: Boolean);
     function GetItemSelectedByIndex(Index: Integer): Boolean;
     procedure MakeTopItem(Item: TListItem);
+    procedure UpdateDarkMode;
   public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
@@ -102,12 +106,13 @@ type
     property MarkedFile: TListItem read GetMarkedFile;
     property Valid: Boolean read GetValid;
     property LastSelectMethod: TSelectMethod read FLastSelectMethod;
+    property DarkMode: Boolean read FDarkMode write SetDarkMode;
   end;
 
 implementation
 
 uses
-  PasTools, Types;
+  PasTools, Types, Winapi.UxTheme;
 
   { TCustomNortonLikeListView }
 
@@ -144,6 +149,7 @@ begin
   // Not sure about Vista
   FForceUpdateOnItemUnfocus := IsWin7;
   FNextCharToIgnore := 0;
+  FDarkMode := False;
 end;
 
 destructor TCustomNortonLikeListView.Destroy;
@@ -334,13 +340,13 @@ begin
   end;
 end;
 
-procedure TCustomNortonLikeListView.WMNotify(var Message: TWMNotify);
+procedure TCustomNortonLikeListView.WMNotify(var Msg: TWMNotify);
 var
   HDNotify: PHDNotify;
 begin
-  if (FHeaderHandle <> 0) and (Message.NMHdr^.hWndFrom = FHeaderHandle) then
+  if (FHeaderHandle <> 0) and (Msg.NMHdr^.hWndFrom = FHeaderHandle) then
   begin
-    HDNotify := PHDNotify(Message.NMHdr);
+    HDNotify := PHDNotify(Msg.NMHdr);
     // Disallow resizing of "invisible" (width=0) columns.
     // (We probably get only Unicode versions of the messages here as
     // controls are created as Unicode by VCL)
@@ -348,7 +354,7 @@ begin
       HDN_BEGINTRACKA, HDN_TRACKA, HDN_BEGINTRACKW, HDN_TRACKW:
         if not ColProperties.Visible[HDNotify.Item] then
         begin
-          Message.Result := 1;
+          Msg.Result := 1;
           Exit;
         end;
       // We won't get here when user tries to resize the column by mouse,
@@ -365,15 +371,73 @@ begin
            (HDNotify.PItem.cxy <> 0) and
            (not ColProperties.Visible[HDNotify.Item]) then
         begin
-          Message.Result := 1;
+          Msg.Result := 1;
           Exit;
         end;
+
+      // This all is to make header text white in dark mode.
+      NM_CUSTOMDRAW:
+        if DarkMode and SupportsDarkMode and
+           GetSysDarkTheme then // When system app theme is light, headers are not dark
+        begin
+          with PNMLVCustomDraw(Msg.NMHdr)^ do
+          begin
+            if nmcd.dwDrawStage = CDDS_PREPAINT then
+            begin
+              inherited;
+              Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
+              Exit;
+            end
+              else
+            if nmcd.dwDrawStage = CDDS_ITEMPREPAINT then
+            begin
+              SetTextColor(nmcd.hdc, ColorToRGB(Font.Color));
+              Msg.Result := CDRF_DODEFAULT;
+            end;
+          end;
+        end
     end;
   end;
 
   inherited;
 end;
 
+procedure TCustomNortonLikeListView.WMThemeChanged(var Msg: TMessage);
+begin
+  if SupportsDarkMode then // To reduce impact
+  begin
+    UpdateDarkMode;
+    RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
+  end;
+
+  inherited;
+end;
+
+procedure TCustomNortonLikeListView.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 TCustomNortonLikeListView.SetDarkMode(Value: Boolean);
+begin
+  if DarkMode <> Value then
+  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 UpdateDarkMode;
+  end;
+end;
+
 procedure TCustomNortonLikeListView.DDBeforeDrag;
 begin
   FDontSelectItem := False;
@@ -1038,6 +1102,19 @@ begin
     FHeaderHandle := ListView_GetHeader(Handle);
 
     ColProperties.ListViewWndCreated;
+
+    if SupportsDarkMode then
+    begin
+      // This enables dark mode - List view itself supports dark mode somewhat even in the our 'Explorer' theme.
+      // The 'ItemsView' has better (Explorer-like) dark mode selection color, but on the other hand it does not have dark scrollbars.
+      // win32-darkmode has ugly fix for that (FixDarkScrollBar), which we do not want to employ.
+      // The 'DarkMode_Explorer' uses the standard selection color (bright blue).
+
+      // Enables dark headers:
+      SetWindowTheme(FHeaderHandle, 'ItemsView', nil);
+
+      if DarkMode then UpdateDarkMode;
+    end;
   finally
   end;
 end;

source/windows/QueueController.cpp

@@ -13,9 +13,9 @@
 //---------------------------------------------------------------------------
 #pragma package(smart_init)
 //---------------------------------------------------------------------------
-__fastcall TQueueController::TQueueController(TListView * ListView)
+__fastcall TQueueController::TQueueController(TCustomListView * ListView)
 {
-  FListView = ListView;
+  FListView = static_cast<TListView *>(ListView);
   DebugAssert(FListView != NULL);
   DebugAssert(FListView->OnDblClick == NULL);
   FListView->OnDblClick = QueueViewDblClick;

source/windows/QueueController.h

@@ -14,7 +14,7 @@ class TTerminalQueueStatus;
 class TQueueController
 {
 public:
-  __fastcall TQueueController(TListView * ListView);
+  __fastcall TQueueController(TCustomListView * ListView);
   virtual __fastcall ~TQueueController();
 
   TQueueOperation __fastcall DefaultOperation();

source/windows/Tools.cpp

@@ -161,12 +161,13 @@ void __fastcall CenterFormOn(TForm * Form, TControl * CenterOn)
   Form->Top = ScreenPoint.y + (CenterOn->Height / 2) - (Form->Height / 2);
 }
 //---------------------------------------------------------------------------
-UnicodeString __fastcall GetListViewStr(TListView * ListView)
+UnicodeString __fastcall GetListViewStr(TCustomListView * ListView)
 {
   UnicodeString Result;
-  for (int Index = 0; Index < ListView->Columns->Count; Index++)
+  TListView * AListView = static_cast<TListView *>(ListView);
+  for (int Index = 0; Index < AListView->Columns->Count; Index++)
   {
-    AddToList(Result, IntToStr(ListView->Column[Index]->Width), L",");
+    AddToList(Result, IntToStr(AListView->Column[Index]->Width), L",");
   }
   // WORKAROUND
   // Adding an additional comma after the list,
@@ -178,17 +179,18 @@ UnicodeString __fastcall GetListViewStr(TListView * ListView)
   return Result;
 }
 //---------------------------------------------------------------------------
-void __fastcall LoadListViewStr(TListView * ListView, UnicodeString ALayoutStr)
+void __fastcall LoadListViewStr(TCustomListView * ListView, UnicodeString ALayoutStr)
 {
   UnicodeString LayoutStr = CutToChar(ALayoutStr, L';', true);
   int PixelsPerInch = LoadPixelsPerInch(CutToChar(ALayoutStr, L';', true), ListView);
   int Index = 0;
-  while (!LayoutStr.IsEmpty() && (Index < ListView->Columns->Count))
+  TListView * AListView = static_cast<TListView *>(ListView);
+  while (!LayoutStr.IsEmpty() && (Index < AListView->Columns->Count))
   {
     int Width;
     if (TryStrToInt(CutToChar(LayoutStr, L',', true), Width))
     {
-      ListView->Column[Index]->Width = LoadDimension(Width, PixelsPerInch, ListView);
+      AListView->Column[Index]->Width = LoadDimension(Width, PixelsPerInch, ListView);
     }
     Index++;
   }

source/windows/Tools.h

@@ -27,8 +27,8 @@ IShellLink * __fastcall CreateDesktopSessionShortCut(
   const UnicodeString & SessionName, UnicodeString Name,
   const UnicodeString & AdditionalParams,
   int SpecialFolder = -1, int IconIndex = SITE_ICON, bool Return = false);
-UnicodeString __fastcall GetListViewStr(TListView * ListView);
-void __fastcall LoadListViewStr(TListView * ListView, UnicodeString LayoutStr);
+UnicodeString __fastcall GetListViewStr(TCustomListView * ListView);
+void __fastcall LoadListViewStr(TCustomListView * ListView, UnicodeString LayoutStr);
 void RestoreForm(const UnicodeString & Data, TForm * Form, bool PositionOnly = false, const UnicodeString & DefaultData = EmptyStr);
 UnicodeString __fastcall StoreForm(TForm * Form);
 void __fastcall RestoreFormSize(UnicodeString Data, TForm * Form);