Results 1 to 8 of 8

Thread: DwmGetColorizationColor - Close, but no cigar

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    DwmGetColorizationColor - Close, but no cigar

    I'm trying to find the active title bar colors under the last supported version of Windows. I want to ape them in controls, e.g. Label.

    I am making several assumptions, any of which may be wrong.

    Getting there but I am missing something and/or have faulty logic here:

    Code:
    Option Explicit
    '
    'Here I want to try to color Label1 as closely as possible to the Form's
    'caption/title bar.
    '
    'I only really care about Windows 10 since everything else is now
    'unsupported.  However it still might be interesting to see how badly
    'this fails on Windows 8.1 Fire Two or Windows 7 SP1.
    '
    
    Private Declare Function ColorRGBToHLS Lib "shlwapi" ( _
        ByVal clrRGB As Long, _
        ByRef wHue As Integer, _
        ByRef wLuminance As Integer, _
        ByRef wSaturation As Integer) As Long
    
    Private Const S_OK As Long = 0
    
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" ( _
        ByRef crColorization As Byte, _
        ByRef fOpaqueBlend As Long) As Long
    
    Private Sub GetTitleBarColors(ByRef BackColor As Long, ByRef ForeColor As Long)
        Const MIN_BRIGHT_HUE As Integer = 30 'Orange.
        Const MAX_BRIGHT_HUE As Integer = 122 'Dimming cyan.
        Dim crColorization(0 To 3) As Byte 'ARGB.
        Dim fOpaqueBlend As Long
        Dim COLORREF(0 To 3) As Long '0BGR.
        Dim wHue As Integer
        Dim wLuminance As Integer
        Dim wSaturation As Integer
    
        If DwmGetColorizationColor(crColorization(0), fOpaqueBlend) = S_OK Then
            'We'll ignore fOpaqueBlend because we will never
            'be transparent against the desktop and covered
            'windows:                                         *** IS THIS CORRECT? ***
    
            'ARGB to COLORREF blended with white:             *** IS THIS CORRECT? ***
            COLORREF(0) = Int(crColorization(2) * (CSng(&HFF&) / crColorization(3)))
            COLORREF(1) = Int(crColorization(1) * (CSng(&HFF&) / crColorization(3)))
            COLORREF(2) = Int(crColorization(0) * (CSng(&HFF&) / crColorization(3)))
            If COLORREF(0) > &HFF& Then COLORREF(0) = &HFF&
            If COLORREF(1) > &HFF& Then COLORREF(1) = &HFF&
            If COLORREF(2) > &HFF& Then COLORREF(2) = &HFF&
            BackColor = COLORREF(2) * &H10000 _
                     Or COLORREF(1) * &H100& _
                     Or COLORREF(0)
    
            'Choose the proper contrasting ForeColor:         *** IS THIS CORRECT? ***
            ColorRGBToHLS BackColor, wHue, wLuminance, wSaturation
            If wLuminance >= 240 \ 2 And MIN_BRIGHT_HUE <= wHue And wHue <= MAX_BRIGHT_HUE Then
                ForeColor = vbBlack
            Else
                ForeColor = vbWhite
            End If
        Else
            BackColor = vbInactiveTitleBar
            ForeColor = vbInactiveTitleBarText
        End If
    End Sub
    
    Private Sub Form_Load()
        Dim BG As Long
        Dim FG As Long
    
        GetTitleBarColors BG, FG
        With Label1
            .BackColor = BG
            .ForeColor = FG
        End With
    End Sub
    Name:  sshot1.png
Views: 379
Size:  1.6 KB

    Name:  sshot2.png
Views: 378
Size:  1.4 KB

    Name:  sshot3.png
Views: 374
Size:  1.5 KB

    No idea what this ends up looking like on downlevel Windows versions though.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: DwmGetColorizationColor - Close, but no cigar

    BTW: This is Shell32's hue spectrum from 0 at left to 240 at right:

    Name:  sshot.jpg
Views: 357
Size:  8.4 KB

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: DwmGetColorizationColor - Close, but no cigar

    Even though imperfect, this might be good enough for my intended uses.

    Of course the user might have made some other choice that makes this approach fall apart, for example a really bad choice of ForeColor against some BackColor.


    The main thing I want this for is a docking capability for ToolWindow Forms in MDI Forms. Undocked, then docked:

    Name:  sshot.png
Views: 331
Size:  3.3 KB


    There might be other reasons to derive these colors as well.

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: DwmGetColorizationColor - Close, but no cigar

    Well, I hate reaching directly into the registry but we don't seem to have any documented direct calls to get the right BackColor:

    Code:
    Option Explicit
    '
    'Here I want to try to color Label1 as closely as possible to the Form's
    'caption/title bar.
    '
    'I only really care about Windows 10 since everything else is now
    'unsupported.  However it still might be interesting to see how badly
    'this fails on Windows 8.1 Fire Two or Windows 7 SP1.
    '
    
    Private Declare Function ColorRGBToHLS Lib "shlwapi" ( _
        ByVal clrRGB As Long, _
        ByRef wHue As Integer, _
        ByRef wLuminance As Integer, _
        ByRef wSaturation As Integer) As Long
    
    Private Const KEY_READ As Long = &H20019
    Private Const ERROR_SUCCESS As Long = 0&
    
    Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    
    Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExW" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As Long, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) As Long
    
    Private Declare Function RegQueryValueExDWORD Lib "advapi32" _
        Alias "RegQueryValueExW" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As Long, _
        ByVal lpReserved As Long, _
        ByRef RegType As Long, _
        ByRef Data As Long, _
        ByRef cbData As Long) As Long
    
    Private Sub GetTitleBarColors(ByRef BackColor As Long, ByRef ForeColor As Long)
        Const HKEY_CURRENT_USER As Long = &H80000001
        Const HKCU As Long = HKEY_CURRENT_USER
        Const MIN_BRIGHT_HUE As Integer = 22 'Orange.
        Const MAX_BRIGHT_HUE As Integer = 122 'Dimming cyan.
        Dim hKey As Long
        Dim RegType As Long
        Dim cbData As Long
        Dim wHue As Integer
        Dim wLuminance As Integer
        Dim wSaturation As Integer
        Dim Success As Boolean
    
        If RegOpenKeyEx(HKCU, _
                        StrPtr("SOFTWARE\Microsoft\Windows\DWM"), _
                        0, _
                        KEY_READ, _
                        hKey) = ERROR_SUCCESS Then
            cbData = 4
            If RegQueryValueExDWORD(hKey, _
                                    StrPtr("AccentColor"), _
                                    0, _
                                    RegType, _
                                    BackColor, _
                                    cbData) = ERROR_SUCCESS Then
                BackColor = BackColor And &HFFFFFF
                'Choose the proper contrasting ForeColor:         *** IS THIS CORRECT? ***
                ColorRGBToHLS BackColor, wHue, wLuminance, wSaturation
                If wLuminance >= 240 \ 2 And MIN_BRIGHT_HUE <= wHue And wHue <= MAX_BRIGHT_HUE Then
                    ForeColor = vbBlack
                Else
                    ForeColor = vbWhite
                End If
                Success = True
            End If
            RegCloseKey hKey
        End If
        If Not Success Then
            BackColor = vbInactiveTitleBar
            ForeColor = vbInactiveTitleBarText
        End If
    End Sub
    
    Private Sub Form_Load()
        Dim BG As Long
        Dim FG As Long
    
        GetTitleBarColors BG, FG
        With Label1
            .BackColor = BG
            .ForeColor = FG
        End With
    End Sub
    I also fiddled with my "bright colors" hue range a bit for deciding whether to use black or white as ForeColor. Sadly that color setting doesn't seem to be in the registry.

  5. #5
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,121

    Re: DwmGetColorizationColor - Close, but no cigar

    FYI, here are a couple of helper functions I'm using for alpha blending and luminance calculation

    Code:
    Option Explicit
    '
    'Here I want to try to color Label1 as closely as possible to the Form's
    'caption/title bar.
    '
    'I only really care about Windows 10 since everything else is now
    'unsupported.  However it still might be interesting to see how badly
    'this fails on Windows 8.1 Fire Two or Windows 7 SP1.
    '
    
    Private Declare Function OleTranslateColor Lib "oleaut32" (ByVal lOleColor As Long, ByVal lHPalette As Long, pColorRef As Any) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    
    Private Declare Function ColorRGBToHLS Lib "shlwapi" ( _
        ByVal clrRGB As Long, _
        ByRef wHue As Integer, _
        ByRef wLuminance As Integer, _
        ByRef wSaturation As Integer) As Long
    
    Private Const S_OK As Long = 0
    
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" ( _
        ByRef crColorization As Byte, _
        ByRef fOpaqueBlend As Long) As Long
    
    Private Type RGB_QUAD
        R                   As Byte
        G                   As Byte
        B                   As Byte
        A                   As Byte
    End Type
    
    Private Sub GetTitleBarColors(ByRef BackColor As Long, ByRef ForeColor As Long)
        Const MIN_BRIGHT_HUE As Integer = 30 'Orange.
        Const MAX_BRIGHT_HUE As Integer = 122 'Dimming cyan.
        Dim crColorization(0 To 3) As Byte 'ARGB.
        Dim fOpaqueBlend As Long
        Dim COLORREF(0 To 3) As Long '0BGR.
        Dim wHue As Integer
        Dim wLuminance As Integer
        Dim wSaturation As Integer
    
        If DwmGetColorizationColor(crColorization(0), fOpaqueBlend) = S_OK Then
            'We'll ignore fOpaqueBlend because we will never
            'be transparent against the desktop and covered
            'windows:                                         *** IS THIS CORRECT? ***
    
            'ARGB to COLORREF blended with white:             *** IS THIS CORRECT? ***
    '        COLORREF(0) = Int(crColorization(2) * (CSng(&HFF&) / crColorization(3)))
    '        COLORREF(1) = Int(crColorization(1) * (CSng(&HFF&) / crColorization(3)))
    '        COLORREF(2) = Int(crColorization(0) * (CSng(&HFF&) / crColorization(3)))
    '        If COLORREF(0) > &HFF& Then COLORREF(0) = &HFF&
    '        If COLORREF(1) > &HFF& Then COLORREF(1) = &HFF&
    '        If COLORREF(2) > &HFF& Then COLORREF(2) = &HFF&
    '        BackColor = COLORREF(2) * &H10000 _
    '                 Or COLORREF(1) * &H100& _
    '                 Or COLORREF(0)
            BackColor = crColorization(0) * &H10000 _
                     Or crColorization(1) * &H100& _
                     Or crColorization(2)
            BackColor = AlphaBlendColors(BackColor, vbWhite, crColorization(3))
    
            'Choose the proper contrasting ForeColor:         *** IS THIS CORRECT? ***
    '        ColorRGBToHLS BackColor, wHue, wLuminance, wSaturation
    '        If wLuminance >= 240 \ 2 And MIN_BRIGHT_HUE <= wHue And wHue <= MAX_BRIGHT_HUE Then
    '            ForeColor = vbBlack
    '        Else
    '            ForeColor = vbWhite
    '        End If
            If GetLuminance(BackColor) < GetLuminance(vbButtonFace) Then
                ForeColor = vbBlack
            Else
                ForeColor = vbWhite
            End If
        Else
            BackColor = vbInactiveTitleBar
            ForeColor = vbInactiveTitleBarText
        End If
    End Sub
    
    Private Sub Form_Load()
        Dim BG As Long
        Dim FG As Long
    
        GetTitleBarColors BG, FG
        With Label1
            .BackColor = BG
            .ForeColor = FG
        End With
    End Sub
    
    Public Function AlphaBlendColors(ByVal clrFirst As OLE_COLOR, ByVal clrSecond As OLE_COLOR, ByVal lAlpha As Long) As Long
        Dim uFore           As RGB_QUAD
        Dim uBack           As RGB_QUAD
        
        Call OleTranslateColor(clrFirst, 0, uFore)
        Call OleTranslateColor(clrSecond, 0, uBack)
        With uFore
            .R = (.R * lAlpha + uBack.R * (255 - lAlpha)) / 255
            .G = (.G * lAlpha + uBack.G * (255 - lAlpha)) / 255
            .B = (.B * lAlpha + uBack.B * (255 - lAlpha)) / 255
        End With
        Call CopyMemory(AlphaBlendColors, uFore, 4)
    End Function
    
    Public Function GetLuminance(ByVal clrColor As OLE_COLOR) As Long
        Dim uColor          As RGB_QUAD
        
        Call OleTranslateColor(clrColor, 0, uColor)
        GetLuminance = (uColor.R * 76& + uColor.G * 150& + uColor.B * 29&) / 255
    End Function
    With OleTranslateColor can target arrays for the result and skip UDT declartion of RGB_QUAD altogether I guess.

    cheers,
    </wqw>

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: DwmGetColorizationColor - Close, but no cigar

    Yeah, those should be RGBQUAD not COLORREF as I named them. That was an error.

    Fishing "AccentColor" out of the registry seems to work though. The only challenge left is choosing the ForeColor that matches the window Title Bar color.

  7. #7
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: DwmGetColorizationColor - Close, but no cigar

    hi I remember dealing with the same thing years ago and couldn't find a way to get the correct colors with DwmGetColorizationColor and finished using the registry.
    I also used invert the color between black and white to contrast, this function works for me
    Code:
    Private Function IsDarkColor(ByVal Color As Long) As Boolean
        Dim BGRA(0 To 3) As Byte
        OleTranslateColor Color, 0, BGRA(0)'ByRef As Any
        IsDarkColor = ((CLng(BGRA(0)) + (CLng(BGRA(1) * 3)) + CLng(BGRA(2))) / 2) < 382
    End Function
    leandroascierto.com Visual Basic 6 projects

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: DwmGetColorizationColor - Close, but no cigar

    Thanks. Looks good enough to me.

    Only needed rarely anyhow, but still seems like an odd thing to be hard to get.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width