Skip to content

Commit

Permalink
Add dark mode support to the context menus on Windows 10 Version 1903…
Browse files Browse the repository at this point in the history 
… and later. \o/
  • Loading branch information
@martijnlaan
martijnlaan committed Apr 19, 2024
1 parent 912573f commit f6249ed
Show file tree
Hide file tree
Showing 5 changed files with 336 additions and 7 deletions.
8 changes: 7 additions & 1 deletion Components/ModernColors.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ TTheme = class
property Dark: Boolean read FGetDark;
property Modern: Boolean read FGetModern;
property Typ: TThemeType read FType write FType;
class function DarkType(Typ: TThemeType): Boolean;
end;

implementation
Expand Down Expand Up @@ -100,9 +101,14 @@ function TTheme.FGetColor(Color: TThemeColor): TColor;
Result := Colors[FType, Color];
end;

class function TTheme.DarkType(Typ: TThemeType): Boolean;
begin
Result := Typ = ttModernDark;
end;

function TTheme.FGetDark: Boolean;
begin
Result := FType = ttModernDark;
Result := DarkType(FType);
end;

function TTheme.FGetModern: Boolean;
Expand Down
30 changes: 27 additions & 3 deletions Components/NewUxTheme.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,11 +44,13 @@
{ }
{******************************************************************************}

{ Simplified by Martijn Laan for Inno Setup }
{ Simplified by Martijn Laan for Inno Setup
{ Cannot be replaced by Delphi's built in Winapi.UxTheme.pas even though it has
Cannot be replaced by Delphi's built in Winapi.UxTheme.pas even though it has
the same functions: see the comment at the bottom of this file. For this
reason this unit has been renamed to NewUxTheme. }
reason this unit has been renamed to NewUxTheme.
Additionally this unit includes SetPreferredAppMode. }

unit NewUxTheme;

Expand Down Expand Up @@ -1012,6 +1014,14 @@ _INTLIST = record

var
EnableTheming: function(fEnable: BOOL): HRESULT; stdcall;

//----------------------------------------------------------------------------------------------------------------------

type
TPreferredAppMode = (pamDefault, pamAllowDark, pamForceDark, pamForceLight, pamMax);

var
SetPreferredAppMode: function(appMode: TPreferredAppMode): TPreferredAppMode; stdcall;

implementation

Expand Down Expand Up @@ -1085,6 +1095,7 @@ procedure FreeThemeLibrary;
GetThemeDocumentationProperty := nil;
DrawThemeParentBackground := nil;
EnableTheming := nil;
SetPreferredAppMode := nil;
end;
end;

Expand All @@ -1100,6 +1111,15 @@ function InitThemeLibrary: Boolean;
Result := StrPas(Buf);
end;

function WindowsVersionAtLeast(const AMajor, AMinor: Byte; const ABuild: Word): Boolean;
begin
var OSVersionInfo: TOSVersionInfoEx;
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
var WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or (Byte(OSVersionInfo.dwMinorVersion) shl 16) or Word(OSVersionInfo.dwBuildNumber);
Result := WindowsVersion >= Cardinal((AMajor shl 24) or (AMinor shl 16) or ABuild);
end;

begin
Inc(ReferenceCount);

Expand Down Expand Up @@ -1153,6 +1173,10 @@ function InitThemeLibrary: Boolean;
GetThemeDocumentationProperty := GetProcAddress(ThemeLibrary, 'GetThemeDocumentationProperty');
DrawThemeParentBackground := GetProcAddress(ThemeLibrary, 'DrawThemeParentBackground');
EnableTheming := GetProcAddress(ThemeLibrary, 'EnableTheming');
if WindowsVersionAtLeast(10, 0, 18362) then { 10.0.18362 = Windows 10 Version 1903 (May 2019 Update) }
SetPreferredAppMode := GetProcAddress(ThemeLibrary, MakeIntResource(135))
else
SetPreferredAppMode := nil;

This comment has been minimized.

Sign in to view

Copy link
@jordanrussell

jordanrussell Apr 20, 2024

Member

Eh... I don't know about this. According to:

https://stackoverflow.com/questions/53501268/win10-dark-theme-how-to-use-in-winapi

ordinal 135 was changed from one function to another at one point. How do we know it won't change again in the future? That could lead to the IDE crashing when calling the function -- which sounds far worse than the menus not being rendered in dark mode.

On an unrelated note, the unit needs {$MINENUMSIZE 4} to make Delphi enumerated types match the size of C enum types (which is 4 bytes, not 1).

This comment has been minimized.

Sign in to view

Copy link
@jordanrussell

jordanrussell Apr 20, 2024

Member

Well it appears that the new ordinal 135 function might be ABI compatible with the old one, replacing a bool with an enum where 0 and 1 may have the same meaning.

Still though, calling undocumented functions by ordinal? Did someone at Microsoft endorse this?

This comment has been minimized.

Sign in to view

Copy link
@martijnlaan

martijnlaan Apr 21, 2024 •
edited
Loading

Author Member

The best thread to start reading about this is microsoft/WindowsAppSDK#41

It's cleary a huge mess for no apparent reason: some of this stuff (including SetPreferredAppMode) has been unchanged for many years now. Some of it was even part of Windows Terminal's code at some point, later replaced by a non open source DLL at the request of the DWM team, even though Windows Terminal is supposed to be open source. For example it had this line:

pfn = (PfnShouldAppsUseDarkMode)GetProcAddress(_module.get(), MAKEINTRESOURCEA(UXTHEME_SHOULDAPPSUSEDARKMODE_ORDINAL));

Here I read that MS will take steps to fix this at next month's BUILD event, hopefully this is true.

At the same time I see around me that everyone uses dark mode which me being the rare exception. If it can be supported in a reasonable way I think it should. Besides my personal experiences there's also this saying we should support this.

I consider owner drawing everything as unreasonable. So I don't want to use VCL styles.

I don't know yet if I think loading a function by ordinal is reasonable or not. It's probably reasonable if limited to build numbers known to be good. So not just a minimum but also a maximum.

Still looking for a way to get a dark menu bar and status bar. Tried some stuff that's supposed to work but didn't. Getting a dark title bar is documented here now but haven't tried it yet.

This comment has been minimized.

Sign in to view

Copy link
@martijnlaan

martijnlaan Apr 24, 2024 •
edited
Loading

Author Member

Did some changes which should make this branch ok to merge.

Also found some additional info:

BTW this is the post where this DLL is announced: microsoft/terminal#3425 (comment)

This comment has been minimized.

Sign in to view

Copy link
@martijnlaan

martijnlaan Apr 24, 2024

Author Member

Did changes for a dark menu bar main menu bar on a darkermenus branch, see bade4aa. Like I said in the commit it works very well, even on Windows 7 and in the meantime I found that it's what Notepad++ does, see https://github.com/notepad-plus-plus/notepad-plus-plus/blob/89aaf4372232346efffcedcc5a1a51fd94011ff4/PowerEditor/src/NppDarkMode.cpp#L778

This comment has been minimized.

Sign in to view

Copy link
@martijnlaan

martijnlaan Apr 24, 2024

Author Member

FWIW, WinSCP uses SetPreferredAppMode as well, see https://github.com/winscp/winscp/blob/464705dbce57cc3ddf8d5b9e692f7b366087e2df/source/packages/my/PasTools.pas#L1177
end;
end;
Result := ThemeLibrary <> 0;
Expand Down
267 changes: 267 additions & 0 deletions Projects/Src/CompForm.dfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19075,4 +19075,271 @@ object CompileForm: TCompileForm
Left = 224
Top = 149
end
object DarkVirtualImageList: TVirtualImageList
AutoFill = True
Images = <
item
CollectionIndex = 0
CollectionName = 'document-new'
Name = 'document-new'
end
item
CollectionIndex = 1
CollectionName = 'folder-open-filled-arrow-down-right'
Name = 'folder-open-filled-arrow-down-right'
end
item
CollectionIndex = 2
CollectionName = 'save-filled'
Name = 'save-filled'
end
item
CollectionIndex = 3
CollectionName = 'build'
Name = 'build'
end
item
CollectionIndex = 4
CollectionName = 'build-cancel-2'
Name = 'build-cancel-2'
end
item
CollectionIndex = 5
CollectionName = 'debug-start-filled'
Name = 'debug-start-filled'
end
item
CollectionIndex = 6
CollectionName = 'debug-break-all-filled'
Name = 'debug-break-all-filled'
end
item
CollectionIndex = 7
CollectionName = 'install'
Name = 'install'
end
item
CollectionIndex = 8
CollectionName = 'uninstall'
Name = 'uninstall'
end
item
CollectionIndex = 9
CollectionName = 'button-help'
Name = 'button-help'
end
item
CollectionIndex = 10
CollectionName = 'debug-stop-filled'
Name = 'debug-stop-filled'
end
item
CollectionIndex = 11
CollectionName = 'save-as-filled'
Name = 'save-as-filled'
end
item
CollectionIndex = 12
CollectionName = 'save-all-filled'
Name = 'save-all-filled'
end
item
CollectionIndex = 13
CollectionName = 'printer'
Name = 'printer'
end
item
CollectionIndex = 14
CollectionName = 'command-redo-1'
Name = 'command-redo-1'
end
item
CollectionIndex = 15
CollectionName = 'command-undo-1'
Name = 'command-undo-1'
end
item
CollectionIndex = 16
CollectionName = 'clipboard-cut'
Name = 'clipboard-cut'
end
item
CollectionIndex = 17
CollectionName = 'clipboard-copy'
Name = 'clipboard-copy'
end
item
CollectionIndex = 18
CollectionName = 'clipboard-paste'
Name = 'clipboard-paste'
end
item
CollectionIndex = 19
CollectionName = 'select-all'
Name = 'select-all'
end
item
CollectionIndex = 20
CollectionName = 'find'
Name = 'find'
end
item
CollectionIndex = 21
CollectionName = 'replace'
Name = 'replace'
end
item
CollectionIndex = 22
CollectionName = 'control-edit'
Name = 'control-edit'
end
item
CollectionIndex = 23
CollectionName = 'debug-step-into'
Name = 'debug-step-into'
end
item
CollectionIndex = 24
CollectionName = 'debug-step-over'
Name = 'debug-step-over'
end
item
CollectionIndex = 25
CollectionName = 'debug-step-out'
Name = 'debug-step-out'
end
item
CollectionIndex = 26
CollectionName = 'debug-breakpoint-filled'
Name = 'debug-breakpoint-filled'
end
item
CollectionIndex = 27
CollectionName = 'variables'
Name = 'variables'
end
item
CollectionIndex = 28
CollectionName = 'heart-filled'
Name = 'heart-filled'
end
item
CollectionIndex = 29
CollectionName = 'alert-filled'
Name = 'alert-filled'
end
item
CollectionIndex = 30
CollectionName = 'home'
Name = 'home'
end
item
CollectionIndex = 31
CollectionName = 'button-info'
Name = 'button-info'
end
item
CollectionIndex = 32
CollectionName = 'application'
Name = 'application'
end
item
CollectionIndex = 33
CollectionName = 'folder-filled-find'
Name = 'folder-filled-find'
end
item
CollectionIndex = 34
CollectionName = 'gear-filled'
Name = 'gear-filled'
end
item
CollectionIndex = 35
CollectionName = 'key-filled'
Name = 'key-filled'
end
item
CollectionIndex = 36
CollectionName = 'letter-a-arrow-right-2'
Name = 'letter-a-arrow-right-2'
end
item
CollectionIndex = 37
CollectionName = 'symbol-cancel'
Name = 'symbol-cancel'
end
item
CollectionIndex = 38
CollectionName = 'comment-text-script-filled'
Name = 'comment-text-script-filled'
end
item
CollectionIndex = 39
CollectionName = 'control-tree-script-filled'
Name = 'control-tree-script-filled'
end
item
CollectionIndex = 40
CollectionName = 'documents-script-filled'
Name = 'documents-script-filled'
end
item
CollectionIndex = 41
CollectionName = 'tag-script-filled'
Name = 'tag-script-filled'
end
item
CollectionIndex = 42
CollectionName = 'control-tab-filled-arrow-left-2'
Name = 'control-tab-filled-arrow-left-2'
end
item
CollectionIndex = 43
CollectionName = 'control-tab-filled-arrow-right-2'
Name = 'control-tab-filled-arrow-right-2'
end
item
CollectionIndex = 44
CollectionName = 'unused\control-tab-filled-cancel-2'
Name = 'unused\control-tab-filled-cancel-2'
end
item
CollectionIndex = 45
CollectionName = 'control-tab-filled-redo-1'
Name = 'control-tab-filled-redo-1'
end
item
CollectionIndex = 46
CollectionName = 'unused\find-arrow-left-2'
Name = 'unused\find-arrow-left-2'
end
item
CollectionIndex = 47
CollectionName = 'unused\find-arrow-right-2'
Name = 'unused\find-arrow-right-2'
end
item
CollectionIndex = 48
CollectionName = 'announcement'
Name = 'announcement'
end
item
CollectionIndex = 49
CollectionName = 'debug-start-filled-arrow-right-2'
Name = 'debug-start-filled-arrow-right-2'
end
item
CollectionIndex = 50
CollectionName = 'zoom-in'
Name = 'zoom-in'
end
item
CollectionIndex = 51
CollectionName = 'zoom-out'
Name = 'zoom-out'
end>
ImageCollection = DarkToolBarImageCollection
Left = 272
Top = 180
end
end
Loading

0 comments on commit f6249ed

Please sign in to comment.