Selaa lähdekoodia

Since 10.4 VCL styles can be turned on/off per control, see https://blog.marcocantu.com/blog/2020-may-per-control-styling.html.

This makes them suitable for us to get dark mode support for the remaining stuff: our dialogs, other dialogs like message boxes, and tooltips.

Not that in non-dark mode everything is still fully native and unstyled. And in dark mode the main form looks 100% the same as before.

The dark mode style used is 'Window11 Dark 1.0' by Embacadero from GetIt.

Todo:
-Call InitFormTheme in all forms.
-Make TNew* controls aware of VCL styles, or do something else for them.
-Common dialogs look bad in dark mode, at last open file, save file, and open folder.
-Propbaly can revert dark statusbar subclass now.
-Update whatsnew.
Martijn Laan 2 kuukautta sitten
vanhempi
commit
ae64e7b5cf

+ 7 - 1
Projects/Compil32.dpr

@@ -72,7 +72,9 @@ uses
   IDE.ImagesModule in 'Src\IDE.ImagesModule.pas' {ImagesModule: TDataModule},
   IDE.ImagesModule in 'Src\IDE.ImagesModule.pas' {ImagesModule: TDataModule},
   ECDSA in '..\Components\ECDSA.pas',
   ECDSA in '..\Components\ECDSA.pas',
   ISSigFunc in '..\Components\ISSigFunc.pas',
   ISSigFunc in '..\Components\ISSigFunc.pas',
-  StringScanner in '..\Components\StringScanner.pas';
+  StringScanner in '..\Components\StringScanner.pas',
+  VCL.Styles,
+  VCL.Themes;
 
 
 {$SETPEOSVERSION 6.1}
 {$SETPEOSVERSION 6.1}
 {$SETPESUBSYSVERSION 6.1}
 {$SETPESUBSYSVERSION 6.1}
@@ -81,6 +83,7 @@ uses
 {$R Res\Compil32.docicon.res}
 {$R Res\Compil32.docicon.res}
 {$R Res\Compil32.manifest.res}
 {$R Res\Compil32.manifest.res}
 {$R Res\Compil32.versionandicon.res}
 {$R Res\Compil32.versionandicon.res}
+{$R Res\Compil32.darkstyle.res}
 
 
 procedure SetAppUserModelID;
 procedure SetAppUserModelID;
 var
 var
@@ -252,6 +255,9 @@ begin
       Title := SCompilerFormCaption;
       Title := SCompilerFormCaption;
   end;
   end;
 
 
+  { We don't need VCL Styles for dark menus. This keeps shDialogs and shTooltips. }
+  TStyleManager.SystemHooks := TStyleManager.SystemHooks - [shMenus];
+
   Application.CreateForm(TImagesModule, ImagesModule);
   Application.CreateForm(TImagesModule, ImagesModule);
   Application.CreateForm(TMainForm, MainForm);
   Application.CreateForm(TMainForm, MainForm);
   Application.Run;
   Application.Run;

BIN
Projects/Res/Compil32.darkstyle.res


+ 8 - 21
Projects/Src/IDE.HelperFunc.pas

@@ -108,8 +108,11 @@ begin
 end;
 end;
 
 
 procedure SetControlWindowTheme(const WinControl: TWinControl; const Dark: Boolean);
 procedure SetControlWindowTheme(const WinControl: TWinControl; const Dark: Boolean);
+{ Can be used for buttons to give them the native dark look and for memos and listboxes to give
+  them a native dark scrollbar }
 begin
 begin
   if UseThemes then begin
   if UseThemes then begin
+    WinControl.StyleName := 'Windows';
     if Dark then
     if Dark then
       SetWindowTheme(WinControl.Handle, 'DarkMode_Explorer', nil)
       SetWindowTheme(WinControl.Handle, 'DarkMode_Explorer', nil)
     else
     else
@@ -127,29 +130,12 @@ end;
 
 
 procedure InitFormTheme(Form: TForm);
 procedure InitFormTheme(Form: TForm);
 
 
-  procedure InitListBoxDarkTheme(const ListBox: TListBox);
-  begin
-    ListBox.Font.Color := FormTheme.Colors[tcFore];
-    ListBox.Color := FormTheme.Colors[tcBack];
-    ListBox.Invalidate;
-    SetControlWindowTheme(ListBox, FormTheme.Dark);
-  end;
-
   procedure InitWinControlTheme(const ParentControl: TWinControl);
   procedure InitWinControlTheme(const ParentControl: TWinControl);
   begin
   begin
     for var I := 0 to ParentControl.ControlCount-1 do begin
     for var I := 0 to ParentControl.ControlCount-1 do begin
-      var Control := ParentControl.Controls[I];
-      if Control is TPanel then
-        (Control as TPanel).Color := FormTheme.Colors[tcBack]
-      else if Control is TListBox then
-        InitListBoxDarkTheme(Control as TListBox)
-      else if (Control is TButton) or (Control is TRadioButton) or (Control is TCheckBox) then begin
-        { Not actually used at the moment since only TMainForm calls InitFormTheme and it doesn't
-          have any of these controls. If it would be used: it works fully for buttons but for
-          radiobuttons and checkboxes it only updates the glyph and not the text color. }
+      const Control = ParentControl.Controls[I];
+      if Control is TButton then
         SetControlWindowTheme(Control as TWinControl, FormTheme.Dark);
         SetControlWindowTheme(Control as TWinControl, FormTheme.Dark);
-      end;
-
       if Control is TWinControl then
       if Control is TWinControl then
         InitWinControlTheme(Control as TWinControl);
         InitWinControlTheme(Control as TWinControl);
     end;
     end;
@@ -158,16 +144,17 @@ procedure InitFormTheme(Form: TForm);
 begin
 begin
   if (Form = MainForm) or FormTheme.Dark then begin
   if (Form = MainForm) or FormTheme.Dark then begin
     Form.Color := FormTheme.Colors[tcBack];
     Form.Color := FormTheme.Colors[tcBack];
-  
+
     { Based on https://learn.microsoft.com/en-us/windows/apps/desktop/modernize/apply-windows-themes
     { Based on https://learn.microsoft.com/en-us/windows/apps/desktop/modernize/apply-windows-themes
       Unlike this article we check for Windows 10 Version 2004 because that's the first version
       Unlike this article we check for Windows 10 Version 2004 because that's the first version
       that introduced DWMWA_USE_IMMERSIVE_DARK_MODE as 20 (the now documented value) instead of 19 }
       that introduced DWMWA_USE_IMMERSIVE_DARK_MODE as 20 (the now documented value) instead of 19 }
     if WindowsVersionAtLeast(10, 0, 19041) then begin
     if WindowsVersionAtLeast(10, 0, 19041) then begin
+      Form.StyleElements := Form.StyleElements - [seBorder];
       const DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
       const DWMWA_USE_IMMERSIVE_DARK_MODE = 20;
       var value: BOOL := FormTheme.Dark;
       var value: BOOL := FormTheme.Dark;
       DwmSetWindowAttribute(Form.Handle, DWMWA_USE_IMMERSIVE_DARK_MODE, @value, SizeOf(value));
       DwmSetWindowAttribute(Form.Handle, DWMWA_USE_IMMERSIVE_DARK_MODE, @value, SizeOf(value));
     end;
     end;
-  
+
     InitWinControlTheme(Form);
     InitWinControlTheme(Form);
   end;
   end;
 end;
 end;

+ 4 - 0
Projects/Src/IDE.MainForm.dfm

@@ -14,6 +14,7 @@ object MainForm: TMainForm
   KeyPreview = True
   KeyPreview = True
   Menu = MainMenu1
   Menu = MainMenu1
   Position = poDefault
   Position = poDefault
+  StyleElements = []
   OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
   OnAfterMonitorDpiChanged = FormAfterMonitorDpiChanged
   OnCloseQuery = FormCloseQuery
   OnCloseQuery = FormCloseQuery
   OnKeyDown = FormKeyDown
   OnKeyDown = FormKeyDown
@@ -47,6 +48,7 @@ object MainForm: TMainForm
       FullRepaint = False
       FullRepaint = False
       TabOrder = 1
       TabOrder = 1
       Visible = False
       Visible = False
+      StyleName = 'Windows'
       OnMouseMove = SplitPanelMouseMove
       OnMouseMove = SplitPanelMouseMove
     end
     end
     object StatusPanel: TPanel
     object StatusPanel: TPanel
@@ -183,6 +185,7 @@ object MainForm: TMainForm
         Bevel = pbNone
         Bevel = pbNone
         Width = 50
         Width = 50
       end>
       end>
+    StyleName = 'Windows'
     OnClick = StatusBarClick
     OnClick = StatusBarClick
     OnDrawPanel = StatusBarDrawPanel
     OnDrawPanel = StatusBarDrawPanel
     OnResize = StatusBarResize
     OnResize = StatusBarResize
@@ -195,6 +198,7 @@ object MainForm: TMainForm
     Align = alTop
     Align = alTop
     BevelOuter = bvNone
     BevelOuter = bvNone
     TabOrder = 0
     TabOrder = 0
+    StyleName = 'Windows'
     object ToolBar: TToolBar
     object ToolBar: TToolBar
       AlignWithMargins = True
       AlignWithMargins = True
       Left = 7
       Left = 7

+ 30 - 5
Projects/Src/IDE.MainForm.pas

@@ -680,7 +680,7 @@ var
 implementation
 implementation
 
 
 uses
 uses
-  ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes,
+  ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Themes,
   Math, StrUtils, WideStrUtils, TypInfo,
   Math, StrUtils, WideStrUtils, TypInfo,
   PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, IDE.Messages, NewUxTheme.TmSchema, BrowseFunc,
   PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, IDE.Messages, NewUxTheme.TmSchema, BrowseFunc,
   IDE.HtmlHelpFunc, TaskbarProgressFunc, IDE.ImagesModule,
   IDE.HtmlHelpFunc, TaskbarProgressFunc, IDE.ImagesModule,
@@ -6553,18 +6553,43 @@ begin
 end;
 end;
 
 
 procedure TMainForm.UpdateTheme;
 procedure TMainForm.UpdateTheme;
+
+  procedure SetListBoxWindowTheme(const ListBox: TListBox);
+  begin
+    ListBox.Font.Color := FTheme.Colors[tcFore];
+    ListBox.Color := FTheme.Colors[tcBack];
+    ListBox.Invalidate;
+    SetControlWindowTheme(ListBox, FTheme.Dark);
+  end;
+
 begin
 begin
   FTheme.Typ := FOptions.ThemeType;
   FTheme.Typ := FOptions.ThemeType;
 
 
   SetHelpFileDark(FTheme.Dark);
   SetHelpFileDark(FTheme.Dark);
 
 
+  { For MainForm the active style only impacts message boxes and tooltips: FMemos, Toolbar, SplitPanel, StatusBar
+    and the 4 ListBoxes ignore it because their StyleName property is set to 'Windows' always. Additionally,
+    for scrollbars and StatusBar, MainForm's StyleElements is empty. Menus ignore it because shMenus is removed
+    from TStyleManager.SystemHooks at startup. }
+  if FTheme.Dark then
+    TStyleManager.TrySetStyle('Windows11 Modern Dark')
+  else
+    TStyleManager.TrySetStyle('Windows');
+  { For some reason only MainForm needs this: with StyleName set to an empty string, dialog boxes look bad }
+  StyleName := TStyleManager.ActiveStyle.Name;
+
+  InitFormTheme(Self);
+
+  ToolbarPanel.Color := FTheme.Colors[tcToolBack];
+
   for var Memo in FMemos do begin
   for var Memo in FMemos do begin
     Memo.UpdateThemeColorsAndStyleAttributes;
     Memo.UpdateThemeColorsAndStyleAttributes;
     SetControlWindowTheme(Memo, FTheme.Dark);
     SetControlWindowTheme(Memo, FTheme.Dark);
   end;
   end;
-
-  InitFormTheme(Self);
-  ToolbarPanel.Color := FTheme.Colors[tcToolBack];
+  SetListBoxWindowTheme(CompilerOutputList);
+  SetListBoxWindowTheme(DebugOutputList);
+  SetListBoxWindowTheme(DebugCallStackList);
+  SetListBoxWindowTheme(FindResultsList);
 
 
   if FTheme.Dark then begin
   if FTheme.Dark then begin
     ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.DarkToolBarImageCollection;
     ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.DarkToolBarImageCollection;
@@ -7484,7 +7509,7 @@ end;
 { Should be removed if the main menu ever gets removed }
 { Should be removed if the main menu ever gets removed }
 procedure TMainForm.UAHDrawMenuBottomLine;
 procedure TMainForm.UAHDrawMenuBottomLine;
 begin
 begin
-  if FTheme.Dark then begin
+  if not (csDestroying in ComponentState) and (FTheme <> nil) and FTheme.Dark then begin
     var ClientRect: TRect;
     var ClientRect: TRect;
     Windows.GetClientRect(Handle, ClientRect);
     Windows.GetClientRect(Handle, ClientRect);
 		MapWindowPoints(Handle, 0, ClientRect, 2);
 		MapWindowPoints(Handle, 0, ClientRect, 2);

+ 1 - 0
Projects/Src/IDE.OptionsForm.pas

@@ -82,6 +82,7 @@ uses
 procedure TOptionsForm.FormCreate(Sender: TObject);
 procedure TOptionsForm.FormCreate(Sender: TObject);
 begin
 begin
   InitFormFont(Self);
   InitFormFont(Self);
+  InitFormTheme(Self);
 
 
   { Order must match CompFunc.TKeyMappingType }
   { Order must match CompFunc.TKeyMappingType }
   KeyMappingComboBox.Items.Add('Classic');
   KeyMappingComboBox.Items.Add('Classic');

+ 1 - 0
Projects/Src/IDE.StartupForm.pas

@@ -95,6 +95,7 @@ begin
   FResult := srNone;
   FResult := srNone;
 
 
   InitFormFont(Self);
   InitFormFont(Self);
+  InitFormTheme(Self);
 
 
   DonateImage.Hint := MainForm.UpdatePanelDonateImage.Hint;
   DonateImage.Hint := MainForm.UpdatePanelDonateImage.Hint;