Windows Color Theme Aware App

Peter Volz 1,295 Reputation points
2023-07-27T14:27:32.9966667+00:00

Hello,

To apply the light/dark color theme to my app and update it in real time:

Private Const WM_SETTINGCHANGE As Integer = &H1A
Protected Overrides Sub WndProc(ByRef MSG As Message)
' I perform 3 checks:
If MSG.Msg = WM_SETTINGCHANGE Then

   If MSG.LParam <> IntPtr.Zero AndAlso Marshal.PtrToStringAuto(MSG.LParam) = "ImmersiveColorSet" Then
      ' And one more step:
      Select Case Convert.ToBoolean(LoadCurrentUser("Software\Microsoft\Windows   \CurrentVersion\Themes\Personalize", "AppsUseLightTheme", True))
      ' Now update the global style:
      Case True/False...
   End If

Else
   MyBase.WndProc(MSG)
End If

The problem is that WndProc sub is called many times when style changes, each global style change for me is resource intensive and calling it few times will cause flickering.

How to do more checks to make it more strict so with each style update my style updater runs only once? :)

Thanks :)

C#
C#
An object-oriented and type-safe programming language that has its roots in the C family of languages and includes support for component-oriented programming.
11,306 questions
VB
VB
An object-oriented programming language developed by Microsoft that is implemented on the .NET Framework. Previously known as Visual Basic .NET.
2,781 questions
0 comments No comments
{count} votes

Accepted answer
  1. Castorix31 86,986 Reputation points
    2023-07-27T17:19:29.31+00:00

    You can do something like this :

    (I assume in this test that DarK/Light theme is not changed several times in <5 seconds)

        <DllImport("Kernel32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
        Public Shared Function GetTickCount() As UInteger
        End Function
    
        Dim nTicksOld As UInteger = 0
    
        Protected Overrides Sub WndProc(ByRef MSG As Message)
            If (MSG.Msg = WM_SETTINGCHANGE AndAlso MSG.LParam <> IntPtr.Zero AndAlso Marshal.PtrToStringAuto(MSG.LParam) = "ImmersiveColorSet") Then
                Dim nTicks = GetTickCount()
                If (nTicks - nTicksOld > 5000 Or nTicksOld = 0) Then
                    Console.Beep(5000, 10)
                End If
                nTicksOld = nTicks 
            Else
                MyBase.WndProc(MSG)
            End If
        End Sub
    
    1 person found this answer helpful.

0 additional answers

Sort by: Most helpful

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.