Browse Source

Improve support for high-contrast themes. The script wizard and update panel now follow the high-contrast theme. The tabsets now ignore it.

Martijn Laan 3 days ago
parent
commit
8d587ec3b2
4 changed files with 34 additions and 15 deletions
  1. 2 2
      Components/ModernColors.pas
  2. 16 4
      Projects/Src/IDE.HelperFunc.pas
  3. 15 9
      Projects/Src/IDE.MainForm.pas
  4. 1 0
      whatsnew.htm

+ 2 - 2
Components/ModernColors.pas

@@ -67,8 +67,8 @@ const
   LIntelliBack = $F8F8F8;    { VSCode Modern Light }
   LWACOBack = $ECECEC;       { Inno Setup 5, 4 tints lightened using color-hex.com }
   LSTOBACK = $FEEAD3;        { VSCode Modern Light }
-  LMarginFore = $716F71;     { Monokai Pro }
-  LMarginBack = $F9FBFB;     { Monokai Pro }
+  LMarginFore = $868686;     { VSCode Modern Light, tabset }
+  LMarginBack = $F8F8F8;     { VSCode Modern Light, tabset }
   LSplitterBack = LToolBack;
   LBraceBack = LWACOBack;
   LIndentGuideFore = clSilver;

+ 16 - 4
Projects/Src/IDE.HelperFunc.pas

@@ -81,6 +81,7 @@ function ReadScriptLines(const ALines: TStringList; const ReadFromFile: Boolean;
 function CreateBitmapInfo(const Width, Height, BitCount: Integer): TBitmapInfo;
 function GetPreferredMemoFont: String;
 function DoubleAmp(const S: String): String;
+function HighContrastActive: Boolean;
 
 implementation
 
@@ -136,7 +137,7 @@ function InitFormTheme(const Form: TForm): Boolean;
 begin
   Result := (Form = MainForm) or FormTheme.Dark;
   if Result then begin
-    Form.Color := InitFormThemeGetBkColor(Form = MainForm);
+    Form.Color := InitFormThemeGetBkColor(Form = MainForm); { Prevents some flicker, but not all }
 
     { 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
@@ -152,9 +153,11 @@ end;
 
 function InitFormThemeGetBkColor(const WindowColor: Boolean): TColor;
 begin
-  if WindowColor then
-    Result := FormTheme.Colors[tcBack] { This is white/window if not dark mode }
-  else
+  if WindowColor then begin
+    Result := FormTheme.Colors[tcBack]; { This is white if not dark mode }
+    if Result = clWhite then
+      Result := GetSysColor(COLOR_WINDOW); { For high contrast themes }
+	end else
     Result := FormTheme.Colors[tcToolBack]; { This is gray/btnface if not dark mode }
 end;
 
@@ -893,6 +896,15 @@ begin
   end;
 end;
 
+function HighContrastActive: Boolean;
+begin
+  var HighContrast: THighContrast;
+  HighContrast.cbSize := SizeOf(HighContrast);
+  Result := False;
+  if SystemParametersInfo(SPI_GETHIGHCONTRAST, HighContrast.cbSize, @HighContrast, 0) then
+    Result := (HighContrast.dwFlags and HCF_HIGHCONTRASTON) <> 0;
+end;
+
 initialization
   var OSVersionInfo: TOSVersionInfo;
   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);

+ 15 - 9
Projects/Src/IDE.MainForm.pas

@@ -503,6 +503,7 @@ type
     FCallTipState: TCallTipState;
     FUpdatePanelMessages: TUpdatePanelMessages;
     FBuildImageList: TImageList;
+    FHighContrastActive: Boolean;
     function AnyMemoHasBreakPoint: Boolean;
     class procedure AppOnException(Sender: TObject; E: Exception);
     procedure AppOnActivate(Sender: TObject);
@@ -953,6 +954,16 @@ begin
 
   InitFormFont(Self);
 
+  FHighContrastActive := HighContrastActive; { Just checking once at startup }
+  if FHighContrastActive then begin
+    { If UseVisualStyle is False (LWS_USEVISUALSTYLE is off) the regular text of the label does not
+      follow any high contrast theme but stays black instead, which is likely to be invisible.
+      Setting it to True makes all text (regular and link) to get the COLOR_HOTLIGHT color. }
+    UpdateLinkLabel.UseVisualStyle := True;
+    { COLOR_WINDOW is documented as the associated background color of COLOR_HOTLIGHT }
+    UpdatePanel.Color := GetSysColor(COLOR_WINDOW);
+  end;
+
   { For some reason, if AutoScroll=False is set on the form Delphi ignores the
     'poDefault' Position setting }
   AutoScroll := False;
@@ -990,6 +1001,8 @@ begin
 
   FTheme := TTheme.Create;
   InitFormThemeInit(FTheme);
+  MemosTabSet.Theme := FTheme;
+  OutputTabSet.Theme := FTheme;
 
   ToolBarPanel.ParentBackground := False;
   UpdatePanel.ParentBackground := False;
@@ -6525,14 +6538,6 @@ begin
   SplitPanel.ParentBackground := False;
   SplitPanel.Color := FTheme.Colors[tcSplitterBack];
 
-  if FTheme.Dark then begin
-    MemosTabSet.Theme := FTheme;
-    OutputTabSet.Theme := FTheme;
-  end else begin
-    MemosTabSet.Theme := nil;
-    OutputTabSet.Theme := nil;
-  end;
-
   FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
   FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
 
@@ -6587,7 +6592,8 @@ begin
     var MessageToShowIndex := FUpdatePanelMessages.Count-1;
     UpdateLinkLabel.Tag := MessageToShowIndex;
     UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
-    UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
+    if not FHighContrastActive then
+      UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
   end;
   UpdateBevel1Visibility;
 end;

+ 1 - 0
whatsnew.htm

@@ -200,6 +200,7 @@ Source: "https://jrsoftware.org/download.php/iscrypt.dll?dontcount=1"; DestName:
       <li>The <i>Find in Files</i> result list will now update its line numbers when you add or delete lines.</li>
       <li>The <i>Highlight occurrences of current word</i> option (which is disabled by default) no longer highlights a section's directive names, parameter names, or Pascal keywords. The <i>Highlight occurrences of current selection</i> option (which is enabled by default) still does.</li>
       <li>Improved dark mode support.</li>
+      <li>Improved support for high-contrast themes.</li>
     </ul>
   </li>
   <li><tt>[Files]</tt> section parameter <tt>Excludes</tt> can now be combined with the <tt>external</tt> flag.</li>