Get Windows 10 Accent Color

I’m aware of the GetSysColor declare into User32. The trouble is none of the values match the accent color (the one used in the titlebar) on Windows 10. Anybody know of a way to find it? MBS is an option.

Code posted for future search, example project:

Public Function GetColorValue(desiredColor As UIColorType) as Color
  'Information provided by William here https://blog.xojo.com/2019/07/02/accessing-windows-runtime-winrt/ made this a lot easier to do, thanks William
  
  Declare Function WindowsCreateString Lib "combase.dll" (source As WString, length As UInt32, ByRef out As Ptr) As Integer
  Declare Function WindowsDeleteString Lib "combase.dll" (hstring As Ptr) As Integer
  Declare Function RoActivateInstance Lib "combase.dll" (classId As Ptr, ByRef inspectable As Ptr) As Integer
  
  Dim classUUID As String = "{03021BE4-5254-4781-8194-5168F7D06D7B}"
  Dim className As String = "Windows.UI.ViewManagement.UISettings"
  Dim classId As Ptr
  Dim result As Integer = WindowsCreateString(className, className.Len, classId)
  
  Dim inspectable As Ptr
  result = RoActivateInstance(classId, inspectable)
  
  Dim unknown As New COM.IUnknown(inspectable)
  Dim interfacePtr As Ptr
  
  result = unknown.QueryInterface(COM.IIDFromString(classUUID), interfacePtr)
  
  '0-2 for IUnknown, 3-5 for IInspectable, 6 for GetColorValue
  Dim func As New GetColorValueFunc(interfacePtr.Ptr(0).Ptr(6 * COM.SIZEOF_PTR))
  
  Dim colorValue As UInt32
  result = func.Invoke(interfacePtr, desiredColor, colorValue)
  
  Dim r As UInt8 = Bitwise.ShiftRight(colorValue And &hFF00, 8, 32)
  Dim g As UInt8 = Bitwise.ShiftRight(colorValue And &hFF0000, 16, 32)
  Dim b As UInt8 = Bitwise.ShiftRight(colorValue And &hFF000000, 24, 32)
  Dim a As UInt8 = Not Bitwise.ShiftRight(colorValue And &hFF, 0, 32)
  
  Dim convertedColor As Color = Color.RGBA(r, g, b, a)
    
  Return convertedColor
End Function
2 Likes

Thanks a ton. I don’t know much about this stuff, so why can I only query one color per execution? If I try to get more than one, the app just doesn’t launch.

Because bugs :wink: remove the declare and call to RoUninitialize, I’ll update the project