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 remove the declare and call to RoUninitialize, I’ll update the project