It could be nice to have native Windows 10/11's dark mode context menues.

[vhanla]

I'm trying to use the Windows 10/11's dark mode context menu in CudaText, for that I'm using the undocumented API:

TPreferredAppMode = (dmDefault, dmAllowDark, dmForceDark, dmForceLight, dmMax);
...
  function SetPreferredAppMode(mode: TPreferredAppMode): BOOL; stdcall;
    external 'uxtheme.dll' index 135;

Which works, as shown in the picture:

As there is noticed in the picture above, the System's (TitleBar's) context menu shows using the system's dark mode but the CudaText's contextual doesn't, it shows in white (light mode).
But if you noticed in this picture, it shows dark with thick white lines, that's because I overrided the TPopupMenu Create constructor and applied the darkmode as well, that's why it uses the system's dark mode, however those white lines still remains there. I tried disabling win32menustyler completely, and it didn't work either. Normally it should work even with that Windows 11's rounded corners as it is using in the titlebar's context menu.

Where can I disable that? I guess it is not FPC's

[edit]
Never mind, it seems it is FPC's TPopupMenu, which is different in Delphi (even older ones).

It could be nice to have those native Windows 10 and Windows 11's dark mode. IMHO.

[Alexey-T]

okay idea, but better discuss this on the lazarus support forum in the Win32 part:
https://forum.lazarus.freepascal.org/index.php?board=24.0
since I don't know what part of Win32 lazarus widgetset is the culprit.
if you find it, better post the patch to the lazarus bugtracker.

[Alexey-T]

FYI: lazarus win32 widgetset is located here:
lazarus/lcl/interfaces/win32
there we must search for PopupMenu implementation.

[Alexey-T]

if you search for 'separator' in
lazarus/lcl/interfaces/win32
you find many interesting places like

procedure DrawSeparator(const AHDC: HDC; DPI: Integer; const ARect: Windows.RECT);
var
  separatorRect: Windows.RECT;
  space: Integer;
begin
  if IsFlatMenus then
    space := 3
  else
    space := 1;

  separatorRect.Left  := ARect.Left  + space;
  separatorRect.Right := ARect.Right - space;
  separatorRect.Top   := ARect.Top + GetSystemMetricsForDpi(SM_CYMENUSIZE, DPI) div 4 - 1;
  DrawEdge(AHDC, separatorRect, EDGE_ETCHED, BF_TOP);
end; 

[theonlyasdk]

@vhanla Can I have that win32darkmode.pas file?

[vhanla]

@vhanla Can I have that win32darkmode.pas file?

Sure, but it is kind of messy 🙈, it requires cleaning up. Sorry about that, it was written for a "quick test".

unit win32darkmode;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, Types, Windows, Graphics, GraphUtil, Themes,
  Dwmapi, UxTheme;

const
  TV_FIRST = $1100;
  TVM_SETEXTENDEDSTYLE = TV_FIRST + 44;
  TVS_EX_DOUBLEBUFFER = $0004;
type
// For Windows 10 that supports dark titlebar/Windows 11 and above
  TPreferredAppMode = (dmDefault, dmAllowDark, dmForceDark, dmForceLight, dmMax);

  function SetPreferredAppMode(mode: TPreferredAppMode): BOOL; stdcall;
    external 'uxtheme.dll' index 135;
  function AllowDarkModeForWindow(hWnd: HWND; allow: Boolean): Boolean; stdcall;
    external 'uxtheme.dll' index 133;
function GetIsImmersiveColorUsingHighContrast: BOOL; stdcall;
  external 'uxtheme.dll' index 106;
function IsDarkModeAllowedForWindow(hWnd: HWND): BOOL; stdcall;
  external 'uxtheme.dll' index 137;
procedure RefreshImmersiveColorPolicyState; stdcall;
  external 'uxtheme.dll' index 104;
function ShouldAppsUseDarkMode: BOOL; stdcall;
  external 'uxtheme.dll' index 132;
function AllowDarkModeForApp(fEnable: BOOL): BOOL; stdcall;
  external 'uxtheme.dll' index 135;
function DarkMode: BOOL; stdcall;  external 'uxtheme.dll' index 136; // FlushMenuThemes
procedure EnableNCShadow(Wnd: HWND);
procedure UseImmersiveDarkMode(Handle: HWND; Enable: Boolean);
procedure SetDarkMode(Handle: HWND; Enable: Boolean);

implementation


procedure EnableNCShadow(Wnd: HWND);
const
  DWMWCP_DEFAULT    = 0; // Let the system decide whether or not to round window corners
  DWMWCP_DONOTROUND = 1; // Never round window corners
  DWMWCP_ROUND      = 2; // Round the corners if appropriate
  DWMWCP_ROUNDSMALL = 3; // Round the corners if appropriate, with a small radius
  DWMWA_WINDOW_CORNER_PREFERENCE = 33; // [set] WINDOW_CORNER_PREFERENCE, Controls the policy that rounds top-level window corners
var
  DWM_WINDOW_CORNER_PREFERENCE: Cardinal;
begin

  //[todo]... verify windows versions
  begin

    DWM_WINDOW_CORNER_PREFERENCE := DWMWCP_ROUNDSMALL;
     DwmSetWindowAttribute(Wnd, DWMWA_WINDOW_CORNER_PREFERENCE, @DWM_WINDOW_CORNER_PREFERENCE, sizeof(DWM_WINDOW_CORNER_PREFERENCE));
  end;
end;


procedure UseImmersiveDarkMode(Handle: HWND; Enable: Boolean);
const
  DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1 = 19;
  DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
var
  DarkMode: DWORD;
  Attribute: DWORD;
begin
//https://stackoverflow.com/a/62811758
  DarkMode := DWORD(Enable);

  if Win32MajorVersion = 10  then
  begin
    if Win32BuildNumber >= 17763 then
    begin
      Attribute := DWMWA_USE_IMMERSIVE_DARK_MODE_BEFORE_20H1;
    if Win32BuildNumber >= 18985 then
      Attribute := DWMWA_USE_IMMERSIVE_DARK_MODE;
      DwmSetWindowAttribute(Handle, Attribute, @DarkMode, SizeOf(DWord));
      SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_DRAWFRAME or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
    end;
  end;
end;

procedure SetDarkMode(Handle: HWND; Enable: Boolean);
begin
//  EnableNCShadow(Handle); // forces window shadow

  UseImmersiveDarkMode(Handle, Enable);
  AllowDarkModeForApp(Enable);
  AllowDarkModeForWindow(Handle, Enable);
  RefreshImmersiveColorPolicyState;
  if ShouldAppsUseDarkMode then
  begin
//    SendMessage(Handle, TVM_SETEXTENDEDSTYLE, TVS_EX_DOUBLEBUFFER, TVS_EX_DOUBLEBUFFER); // not really necessary
    if Enable then
      SetPreferredAppMode(dmForceDark)
    else
      SetPreferredAppMode(dmDefault);
  end;
  DarkMode;
// SetWindowTheme(Handle, 'CFD', nil); 
// some Windows components can be turned to dark mode support as mentioned here https://gist.github.com/rounk-ctrl/b04e5622e30e0d62956870d5c22b7017 but they need to be set one by one, like TButton TCombobox, etc.

end;

end.