Dark mode experimental feature

src/Microsoft.VisualBasic.Forms/src/Microsoft.VisualBasic.Forms.vbproj

@@ -9,8 +9,8 @@
     <AssemblyName>Microsoft.VisualBasic.Forms</AssemblyName>
     <Deterministic>true</Deterministic>
     <OptionExplicit>On</OptionExplicit>
-    <OptionInfer>Off</OptionInfer>
     <OptionStrict>On</OptionStrict>
+    <OptionInfer>On</OptionInfer>
     <RootNamespace></RootNamespace>
     <LangVersion>Latest</LangVersion>
     <VBRuntime>None</VBRuntime>

src/Microsoft.VisualBasic.Forms/src/Microsoft/VisualBasic/ApplicationServices/ApplyApplicationDefaultsEventArgs.vb

@@ -2,9 +2,11 @@
 ' The .NET Foundation licenses this file to you under the MIT license.
 
 Imports System.ComponentModel
+Imports System.Diagnostics.CodeAnalysis
 Imports System.Drawing
 Imports System.Runtime.InteropServices
 Imports System.Windows.Forms
+Imports System.Windows.Forms.Analyzers.Diagnostics
 
 Namespace Microsoft.VisualBasic.ApplicationServices
 
@@ -15,12 +17,19 @@ Namespace Microsoft.VisualBasic.ApplicationServices
     Public Class ApplyApplicationDefaultsEventArgs
         Inherits EventArgs
 
+#Disable Warning WFO5001
+
         Friend Sub New(minimumSplashScreenDisplayTime As Integer,
-                highDpiMode As HighDpiMode)
+                highDpiMode As HighDpiMode,
+                colorMode As SystemColorMode)
+
             Me.MinimumSplashScreenDisplayTime = minimumSplashScreenDisplayTime
             Me.HighDpiMode = highDpiMode
+            Me.ColorMode = colorMode
         End Sub
 
+#Enable Warning WFO5001
+
         ''' <summary>
         '''  Setting this property inside the event handler causes a new default Font for Forms and UserControls to be set.
         ''' </summary>
@@ -34,7 +43,7 @@ Namespace Microsoft.VisualBasic.ApplicationServices
         '''  Setting this Property inside the event handler determines how long an application's Splash dialog is displayed at a minimum.
         ''' </summary>
         Public Property MinimumSplashScreenDisplayTime As Integer =
-            WindowsFormsApplicationBase.MINIMUM_SPLASH_EXPOSURE_DEFAULT
+            WindowsFormsApplicationBase.MinimumSplashExposureDefault
 
         ''' <summary>
         '''  Setting this Property inside the event handler determines the general HighDpiMode for the application.
@@ -44,5 +53,11 @@ Namespace Microsoft.VisualBasic.ApplicationServices
         ''' </remarks>
         Public Property HighDpiMode As HighDpiMode
 
+        ''' <summary>
+        '''  Setting this property inside the event handler determines the <see cref="Application.ColorMode"/> for the application.
+        ''' </summary>
+        <Experimental(DiagnosticIDs.ExperimentalDarkMode, UrlFormat:=WindowsFormsApplicationBase.WinFormsExperimentalUrl)>
+        Public Property ColorMode As SystemColorMode
+
     End Class
 End Namespace

src/Microsoft.VisualBasic.Forms/src/Microsoft/VisualBasic/ApplicationServices/WindowsFormsApplicationBase.vb

@@ -3,13 +3,15 @@
 
 Imports System.Collections.ObjectModel
 Imports System.ComponentModel
+Imports System.Diagnostics.CodeAnalysis
 Imports System.IO.Pipes
 Imports System.Reflection
 Imports System.Runtime.CompilerServices
 Imports System.Runtime.InteropServices
 Imports System.Security
 Imports System.Threading
 Imports System.Windows.Forms
+Imports System.Windows.Forms.Analyzers.Diagnostics
 
 Imports ExUtils = Microsoft.VisualBasic.CompilerServices.ExceptionUtils
 Imports VbUtils = Microsoft.VisualBasic.CompilerServices.Utils
@@ -88,9 +90,10 @@ Namespace Microsoft.VisualBasic.ApplicationServices
         Private Delegate Sub DisposeDelegate()
 
         ' How long a subsequent instance will wait for the original instance to get on its feet.
-        Private Const SECOND_INSTANCE_TIMEOUT As Integer = 2500 ' milliseconds.
+        Private Const SecondInstanceTimeOut As Integer = 2500 ' milliseconds.
 
-        Friend Const MINIMUM_SPLASH_EXPOSURE_DEFAULT As Integer = 2000 ' milliseconds.
+        Friend Const MinimumSplashExposureDefault As Integer = 2000 ' milliseconds.
+        Friend Const WinFormsExperimentalUrl As String = "https://aka.ms/winforms-experimental/{0}"
 
         Private ReadOnly _splashLock As New Object
         Private ReadOnly _appContext As WinFormsAppContext
@@ -131,15 +134,20 @@ Namespace Microsoft.VisualBasic.ApplicationServices
         Private _splashScreen As Form
 
         ' Minimum amount of time to show the splash screen. 0 means hide as soon as the app comes up.
-        Private _minimumSplashExposure As Integer = MINIMUM_SPLASH_EXPOSURE_DEFAULT
+        Private _minimumSplashExposure As Integer = MinimumSplashExposureDefault
         Private _splashTimer As Timers.Timer
         Private _appSynchronizationContext As SynchronizationContext
 
         ' Informs My.Settings whether to save the settings on exit or not.
         Private _saveMySettingsOnExit As Boolean
 
-        ' The HighDpiMode the user picked from the AppDesigner or assigned to the ApplyHighDpiMode's Event.
+        ' The HighDpiMode the user picked from the AppDesigner or assigned to the ApplyApplicationsDefault event.
         Private _highDpiMode As HighDpiMode = HighDpiMode.SystemAware
+#Disable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
+        ' The ColorMode (Classic/Light, System, Dark) the user assigned to the ApplyApplicationsDefault event.
+        ' Note: We aim to expose this to the App Designer in later runtime/VS versions.
+        Private _colorMode As SystemColorMode = SystemColorMode.Classic
+#Enable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
 
         ''' <summary>
         '''  Occurs when the network availability changes.
@@ -249,15 +257,15 @@ Namespace Microsoft.VisualBasic.ApplicationServices
             RaiseEvent(sender As Object, e As UnhandledExceptionEventArgs)
                 If _unhandledExceptionHandlers IsNot Nothing Then
 
-                    ' In the case that we throw from the <see cref="UnhandledException"/> handler, we don't want to
-                    ' run the <see cref="UnhandledException"/>  handler again.
+                    ' In the case that we throw from the UnhandledException handler, we don't want to
+                    ' run the UnhandledException handler again.
                     _processingUnhandledExceptionEvent = True
 
                     For Each handler As UnhandledExceptionEventHandler In _unhandledExceptionHandlers
                         handler?.Invoke(sender, e)
                     Next
 
-                    ' Now that we are out of the <see cref="UnhandledException"/> handler, treat exceptions normally again.
+                    ' Now that we are out of the UnhandledException handler, treat exceptions normally again.
                     _processingUnhandledExceptionEvent = False
                 End If
             End RaiseEvent
@@ -291,8 +299,8 @@ Namespace Microsoft.VisualBasic.ApplicationServices
             If authenticationMode = AuthenticationMode.Windows Then
                 Try
                     ' Consider: Sadly, a call to: System.Security.SecurityManager.IsGranted(New SecurityPermission(SecurityPermissionFlag.ControlPrincipal))
-                    ' Will only check THIS caller so you'll always get TRUE.
-                    ' What is needed is a way to get to the value of this on a demand basis.
+                    ' Will only check the THIS caller so you'll always get TRUE.
+                    ' What we need is a way to get to the value of this on a demand basis.
                     ' So I try/catch instead for now but would rather be able to IF my way around this block.
                     Thread.CurrentPrincipal = New Principal.WindowsPrincipal(Principal.WindowsIdentity.GetCurrent)
                 Catch ex As SecurityException
@@ -347,9 +355,13 @@ Namespace Microsoft.VisualBasic.ApplicationServices
 
                     ' --- We are launching a subsequent instance.
                     Dim tokenSource As New CancellationTokenSource()
-                    tokenSource.CancelAfter(SECOND_INSTANCE_TIMEOUT)
+                    tokenSource.CancelAfter(SecondInstanceTimeOut)
                     Try
-                        Dim awaitable As ConfiguredTaskAwaitable = SendSecondInstanceArgsAsync(applicationInstanceID, commandLine, cancellationToken:=tokenSource.Token).ConfigureAwait(False)
+                        Dim awaitable As ConfiguredTaskAwaitable = SendSecondInstanceArgsAsync(
+                            pipeName:=applicationInstanceID,
+                            args:=commandLine,
+                            cancellationToken:=tokenSource.Token).ConfigureAwait(False)
+
                         awaitable.GetAwaiter().GetResult()
                     Catch ex As Exception
                         Throw New CantStartSingleInstanceException()
@@ -492,20 +504,24 @@ Namespace Microsoft.VisualBasic.ApplicationServices
             '    in a derived class and setting `MyBase.MinimumSplashScreenDisplayTime` there.
             '    We are picking this (probably) changed value up, and pass it to the ApplyDefaultsEvents
             '    where it could be modified (again). So event wins over Override over default value (2 seconds).
-            ' b) We feed the default HighDpiMode (SystemAware) to the EventArgs. With the introduction of
-            '    the HighDpiMode property, we give Project System the chance to reflect the HighDpiMode
-            '    in the App Designer UI and have it code-generated based on a modified Application.myapp, which
-            '    would result it to be set in the derived constructor. (See the hidden file in the Solution Explorer
-            '    "My Project\Application.myapp\Application.Designer.vb for how those UI-set values get applied.)
+            ' b) We feed the defaults for HighDpiMode, ColorMode, VisualStylesMode to the EventArgs. 
+            '    With the introduction of the HighDpiMode property, we changed Project System the chance to reflect 
+            '    those default values in the App Designer UI and have it code-generated based on a modified 
+            '    Application.myapp, which would result it to be set in the derived constructor.
+            '    (See the hidden file in the Solution Explorer "My Project\Application.myapp\Application.Designer.vb
+            '     for how those UI-set values get applied.)
             '    Once all this is done, we give the User another chance to change the value by code through
             '    the ApplyDefaults event.
-            ' Overriding MinimumSplashScreenDisplayTime needs still to keep working!
+            ' Note: Overriding MinimumSplashScreenDisplayTime needs still to keep working!
+#Disable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
             Dim applicationDefaultsEventArgs As New ApplyApplicationDefaultsEventArgs(
                 MinimumSplashScreenDisplayTime,
-                HighDpiMode) With
+                HighDpiMode,
+                ColorMode) With
             {
                 .MinimumSplashScreenDisplayTime = MinimumSplashScreenDisplayTime
             }
+#Enable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
 
             RaiseEvent ApplyApplicationDefaults(Me, applicationDefaultsEventArgs)
 
@@ -521,17 +537,22 @@ Namespace Microsoft.VisualBasic.ApplicationServices
 
             _highDpiMode = applicationDefaultsEventArgs.HighDpiMode
 
+#Disable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
+
+            _colorMode = applicationDefaultsEventArgs.ColorMode
+
             ' Then, it's applying what we got back as HighDpiMode.
             Dim dpiSetResult As Boolean = Application.SetHighDpiMode(_highDpiMode)
+
             If dpiSetResult Then
                 _highDpiMode = Application.HighDpiMode
             End If
             Debug.Assert(dpiSetResult, "We could net set the HighDpiMode.")
 
-            ' And finally we take care of EnableVisualStyles.
-            If _enableVisualStyles Then
-                Application.EnableVisualStyles()
-            End If
+            ' Now, let's set VisualStyles and ColorMode:
+            Application.SetColorMode(_colorMode)
+
+#Enable Warning WFO5001 ' Type is for evaluation purposes only and is subject to change or removal in future updates.
 
             ' We'll handle "/nosplash" for you.
             If Not (commandLineArgs.Contains("/nosplash") OrElse Me.CommandLineArgs.Contains("-nosplash")) Then
@@ -559,7 +580,7 @@ Namespace Microsoft.VisualBasic.ApplicationServices
             ' It is important not to create the network object until the ExecutionContext has everything on it.
             ' By now the principal will be on the thread so we can create the network object.
             ' The timing is important because the network object has an AsyncOperationsManager in it that marshals
-            ' the network changed event to the main thread. The asycnOperationsManager does a CreateOperation()
+            ' the network changed event to the main thread. The asyncOperationsManager does a CreateOperation()
             ' which makes a copy of the executionContext. That execution context shows up on your thread during
             ' the callback so I delay creating the network object (and consequently the capturing of the execution context)
             ' until the principal has been set on the thread. This avoids the problem where My.User isn't set
@@ -796,6 +817,23 @@ Namespace Microsoft.VisualBasic.ApplicationServices
             End Set
         End Property
 
+        ''' <summary>
+        '''  Gets or sets the ColorMode for the Application.
+        ''' </summary>
+        ''' <returns>
+        '''  The <see cref="SystemColorMode"/> that the application is running in.
+        ''' </returns>
+        <Experimental(DiagnosticIDs.ExperimentalDarkMode, UrlFormat:=WinFormsExperimentalUrl)>
+        <EditorBrowsable(EditorBrowsableState.Never)>
+        Protected Property ColorMode As SystemColorMode
+            Get
+                Return _colorMode
+            End Get
+            Set(value As SystemColorMode)
+                _colorMode = value
+            End Set
+        End Property
+
         <EditorBrowsable(EditorBrowsableState.Advanced)>
         Protected Property IsSingleInstance() As Boolean
             Get

src/Microsoft.VisualBasic.Forms/src/Microsoft/VisualBasic/Interaction.vb

@@ -10,6 +10,7 @@ Imports Microsoft.VisualBasic.CompilerServices
 
 Imports ExUtils = Microsoft.VisualBasic.CompilerServices.ExceptionUtils
 Imports VbUtils = Microsoft.VisualBasic.CompilerServices.Utils
+Imports NativeMethods = Microsoft.VisualBasic.CompilerServices.NativeMethods
 
 Namespace Microsoft.VisualBasic
 

src/Microsoft.VisualBasic.Forms/src/PublicAPI.Unshipped.txt

@@ -0,0 +1,4 @@
+Microsoft.VisualBasic.ApplicationServices.ApplyApplicationDefaultsEventArgs.ColorMode() -> System.Windows.Forms.SystemColorMode
+Microsoft.VisualBasic.ApplicationServices.ApplyApplicationDefaultsEventArgs.ColorMode(AutoPropertyValue As System.Windows.Forms.SystemColorMode) -> Void
+Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.ColorMode() -> System.Windows.Forms.SystemColorMode
+Microsoft.VisualBasic.ApplicationServices.WindowsFormsApplicationBase.ColorMode(value As System.Windows.Forms.SystemColorMode) -> Void

src/System.Windows.Forms.Analyzers/src/System/Windows/Forms/Analyzers/Diagnostics/DiagnosticIDs.cs

@@ -19,7 +19,6 @@ internal static class DiagnosticIDs
     public const string DisposeModalDialog = "WFO2000";
 
     // Experimental, number group 5000+
-    public const string ExperimentalVisualStyles = "WFO5000";
     public const string ExperimentalDarkMode = "WFO5001";
     public const string ExperimentalAsync = "WFO5002";
 }

src/System.Windows.Forms.Primitives/src/NativeMethods.txt

@@ -108,6 +108,9 @@ DSH_FLAGS
 DTM_*
 DTN_*
 DTS_*
+DwmGetWindowAttribute
+DwmSetWindowAttribute
+DWM_WINDOW_CORNER_PREFERENCE
 DuplicateHandle
 EC_*
 ECO_*
@@ -164,6 +167,7 @@ GetClipboardFormatName
 GetClipBox
 GetClipCursor
 GetClipRgn
+GetComboBoxInfo
 GetCurrentActCtx
 GetCurrentObject
 GetCurrentProcess
@@ -595,6 +599,7 @@ SelectPalette
 SendDlgItemMessage
 SendInput
 SendMessage
+SendMessageCallback
 SendMessageTimeout
 SetActiveWindow
 SetBkColor

src/System.Windows.Forms.Primitives/src/Properties/AssemblyInfo.cs

@@ -5,6 +5,8 @@
 
 [assembly: System.Runtime.InteropServices.ComVisible(false)]
 
+[assembly: InternalsVisibleTo("Microsoft.VisualBasic.Forms, PublicKey=002400000480000094000000060200000024000052534131000400000100010007d1fa57c4aed9f0a32e84aa0faefd0de9e8fd6aec8f87fb03766c834c99921eb23be79ad9d5dcc1dd9ad236132102900b723cf980957fc4e177108fc607774f29e8320e92ea05ece4e821c0a5efe8f1645c4c0c93c1ab99285d622caa652c1dfad63d745d6f2de5f17e5eaf0fc4963d261c8a12436518206dc093344d5ad293")]
+
 [assembly: InternalsVisibleTo("System.Windows.Forms, PublicKey=00000000000000000400000000000000")]
 [assembly: InternalsVisibleTo("System.Windows.Forms.Design, PublicKey=00000000000000000400000000000000")]
 [assembly: InternalsVisibleTo("System.Windows.Forms.Design.Editors, PublicKey=00000000000000000400000000000000")]

src/System.Windows.Forms.Primitives/src/Windows/Win32/PInvoke.GetSysColorBrush.cs

@@ -10,9 +10,19 @@ internal static partial class PInvoke
     /// <inheritdoc cref="GetSysColorBrush(SYS_COLOR_INDEX)"/>
     public static HBRUSH GetSysColorBrush(Color systemColor)
     {
+#pragma warning disable SYSLIB5002 // Type is for evaluation purposes only and is subject to change or removal in future updates. Suppress this diagnostic to proceed.
+        bool useSolidBrush = SystemColors.UseAlternativeColorSet;
+#pragma warning restore SYSLIB5002
+
+        if (useSolidBrush)
+        {
+            // We don't have a real system color, so we'll just create a solid brush.
+            return CreateSolidBrush(systemColor);
+        }
+
         Debug.Assert(systemColor.IsSystemColor);
 
         // Extract the COLOR value
-        return PInvoke.GetSysColorBrush((SYS_COLOR_INDEX)(ColorTranslator.ToOle(systemColor) & 0xFF));
+        return GetSysColorBrush((SYS_COLOR_INDEX)(ColorTranslator.ToOle(systemColor) & 0xFF));
     }
 }

src/System.Windows.Forms.Primitives/src/Windows/Win32/PInvoke.SendMessageCallback.cs

@@ -0,0 +1,33 @@
+// Licensed to the .NET Foundation under one or more agreements.
+// The .NET Foundation licenses this file to you under the MIT license.
+
+using System.Runtime.InteropServices;
+using System.Runtime.CompilerServices;
+
+namespace Windows.Win32;
+
+internal static partial class PInvoke
+{
+    internal static unsafe BOOL SendMessageCallback<T>(
+       T hWnd,
+       MessageId Msg,
+       Action callback,
+       WPARAM wParam = default,
+       LPARAM lParam = default)
+       where T : IHandle<HWND>
+    {
+        GCHandle gcHandle = GCHandle.Alloc(callback);
+        BOOL result = SendMessageCallback(hWnd.Handle, Msg, wParam, lParam, &NativeCallback, (nuint)(nint)gcHandle);
+        GC.KeepAlive(hWnd.Wrapper);
+        return result;
+    }
+
+    [UnmanagedCallersOnly(CallConvs = [typeof(CallConvStdcall)])]
+    private static void NativeCallback(HWND hwnd, uint Msg, nuint dwData, LRESULT lResult)
+    {
+        GCHandle gcHandle = (GCHandle)(nint)dwData;
+        Action action = (Action)gcHandle.Target!;
+        gcHandle.Free();
+        action();
+    }
+}