Răsfoiți Sursa

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 1 lună în urmă
părinte
comite
8d587ec3b2
4 a modificat fișierele cu 34 adăugiri și 15 ștergeri
  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 }
   LIntelliBack = $F8F8F8;    { VSCode Modern Light }
   LWACOBack = $ECECEC;       { Inno Setup 5, 4 tints lightened using color-hex.com }
   LWACOBack = $ECECEC;       { Inno Setup 5, 4 tints lightened using color-hex.com }
   LSTOBACK = $FEEAD3;        { VSCode Modern Light }
   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;
   LSplitterBack = LToolBack;
   LBraceBack = LWACOBack;
   LBraceBack = LWACOBack;
   LIndentGuideFore = clSilver;
   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 CreateBitmapInfo(const Width, Height, BitCount: Integer): TBitmapInfo;
 function GetPreferredMemoFont: String;
 function GetPreferredMemoFont: String;
 function DoubleAmp(const S: String): String;
 function DoubleAmp(const S: String): String;
+function HighContrastActive: Boolean;
 
 
 implementation
 implementation
 
 
@@ -136,7 +137,7 @@ function InitFormTheme(const Form: TForm): Boolean;
 begin
 begin
   Result := (Form = MainForm) or FormTheme.Dark;
   Result := (Form = MainForm) or FormTheme.Dark;
   if Result then begin
   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
     { 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
@@ -152,9 +153,11 @@ end;
 
 
 function InitFormThemeGetBkColor(const WindowColor: Boolean): TColor;
 function InitFormThemeGetBkColor(const WindowColor: Boolean): TColor;
 begin
 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 }
     Result := FormTheme.Colors[tcToolBack]; { This is gray/btnface if not dark mode }
 end;
 end;
 
 
@@ -893,6 +896,15 @@ begin
   end;
   end;
 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
 initialization
   var OSVersionInfo: TOSVersionInfo;
   var OSVersionInfo: TOSVersionInfo;
   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);

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

@@ -503,6 +503,7 @@ type
     FCallTipState: TCallTipState;
     FCallTipState: TCallTipState;
     FUpdatePanelMessages: TUpdatePanelMessages;
     FUpdatePanelMessages: TUpdatePanelMessages;
     FBuildImageList: TImageList;
     FBuildImageList: TImageList;
+    FHighContrastActive: Boolean;
     function AnyMemoHasBreakPoint: Boolean;
     function AnyMemoHasBreakPoint: Boolean;
     class procedure AppOnException(Sender: TObject; E: Exception);
     class procedure AppOnException(Sender: TObject; E: Exception);
     procedure AppOnActivate(Sender: TObject);
     procedure AppOnActivate(Sender: TObject);
@@ -953,6 +954,16 @@ begin
 
 
   InitFormFont(Self);
   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
   { For some reason, if AutoScroll=False is set on the form Delphi ignores the
     'poDefault' Position setting }
     'poDefault' Position setting }
   AutoScroll := False;
   AutoScroll := False;
@@ -990,6 +1001,8 @@ begin
 
 
   FTheme := TTheme.Create;
   FTheme := TTheme.Create;
   InitFormThemeInit(FTheme);
   InitFormThemeInit(FTheme);
+  MemosTabSet.Theme := FTheme;
+  OutputTabSet.Theme := FTheme;
 
 
   ToolBarPanel.ParentBackground := False;
   ToolBarPanel.ParentBackground := False;
   UpdatePanel.ParentBackground := False;
   UpdatePanel.ParentBackground := False;
@@ -6525,14 +6538,6 @@ begin
   SplitPanel.ParentBackground := False;
   SplitPanel.ParentBackground := False;
   SplitPanel.Color := FTheme.Colors[tcSplitterBack];
   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];
   FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
   FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
   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;
     var MessageToShowIndex := FUpdatePanelMessages.Count-1;
     UpdateLinkLabel.Tag := MessageToShowIndex;
     UpdateLinkLabel.Tag := MessageToShowIndex;
     UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
     UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
-    UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
+    if not FHighContrastActive then
+      UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
   end;
   end;
   UpdateBevel1Visibility;
   UpdateBevel1Visibility;
 end;
 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>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>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 dark mode support.</li>
+      <li>Improved support for high-contrast themes.</li>
     </ul>
     </ul>
   </li>
   </li>
   <li><tt>[Files]</tt> section parameter <tt>Excludes</tt> can now be combined with the <tt>external</tt> flag.</li>
   <li><tt>[Files]</tt> section parameter <tt>Excludes</tt> can now be combined with the <tt>external</tt> flag.</li>