Results 1 to 22 of 22

Thread: how to get Windows title bar color set in system (Win 10)

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    how to get Windows title bar color set in system (Win 10)

    i am trying to get the current color of window's title bar which is set in system in Desktop settings .. I've tried using Getsyscolors (eg: COLOR_ACTIVECAPTION and others) but this doesn't seem to work consistently for Win10? It seems that the function (eg: COLOR_ACTIVECAPTION) works fine on Win7 (and WinXP) but doesn't work accurately on win10 (doesn't show correct color)?

    For example, if the user has a theme installed that they are using then this does not get the colors that the theme uses, it only gets what the system settings are set to.

    Is there a way around this?
    /Jimboat

  2. #2
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    Code:
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" (ByRef pcrColorization As Long, ByRef pfOpaqueBlend As Long) As Long
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    
    Const COLOR_ACTIVECAPTION As Long = 2
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
    Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
    Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
    Const VSCLASS_WINDOW As String = "WINDOW"
    Const WP_CAPTION As Long = 1
    Const CS_ACTIVE As Long = 1
    Const TMT_FILLCOLORHINT     As Long = 3821
    
    ' DWM colors are ARGB, unlike VB/COLOREF which is 0BGR
    Public Function DwmColor() As Long
        Dim DwmEnabled As Long  ' BOOL
        Dim OpagueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise 5, "DwmIsCompositionEnabled()", "ERROR (0x" & Hex$(Result) & ")"
    
        If DwmEnabled = 0 Then
            Err.Raise 5, "DwmColor()", "DwmIsComposition is not enabled"
       
        Result = DwmGetColorizationColor(DwmColor, OpagueBlend)
        If Result < 0 Then _
            Err.Raise 5, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
    End Function
    
    
    Public Function ThemeActiveCaptionColor(ByVal hWnd As Long) As Long
        Dim Theme As Long
        Dim Result As Long  ' HRESULT
        Dim Color As Long   ' COLOREF
        
        Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
        If Theme Then ' is theming enabled?
            Result = GetThemeColor(Theme, _
                                   WP_CAPTION, _
                                   CS_ACTIVE, _
                                   TMT_FILLCOLORHINT, _
                                   Color)
            If Result < 0 Then _
                Err.Raise 5, "GetThemeColor()", "ERROR (0x" & Hex$(Result) & ")"
    
            ThemeActiveCaptionColor = Color
            CloseThemeData Theme
        Else
            ' fallback to GetSysColor
            ThemeActiveCaptionColor = GetSysColor(COLOR_ACTIVECAPTION)
        End If
    End Function
    FYI DwmGetColorizationColor returns ARGB, so you'll have to shuffle the bits appropriately if you want a COLORREF

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    DEXWERX - thanks! i'll try it out. i'm not familiar with DwmGetColorizationColor, so i'll have to experiment... is there an "End IF" missing here?

    Code:
    Public Function DwmColor() As Long
        Dim DwmEnabled As Long  ' BOOL
        Dim OpagueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise 5, "DwmIsCompositionEnabled()", "ERROR (0x" & Hex$(Result) & ")"
    
        If DwmEnabled = 0 Then
            Err.Raise 5, "DwmColor()", "DwmIsComposition is not enabled"
       
        Result = DwmGetColorizationColor(DwmColor, OpagueBlend)
        END IF
        If Result < 0 Then _
            Err.Raise 5, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
    End Function
    /Jimboat

  4. #4
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    sorry, was copy pasting! missed an underscore
    Code:
    If DwmEnabled = 0 Then _
            Err.Raise 5, "DwmColor()", "DwmIsComposition is not enabled"

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    [QUOTE=DEXWERX;5294793]
    Code:
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" (ByRef pcrColorization As Long, ByRef pfOpaqueBlend As Long) As Long
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    DEXWERX - do you know if is there a way that i can make this method workable on WinXP machines too? Since 'dwmapi.dll' isn't installed with WinXP?
    /Jimboat

  6. #6
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    On XP you have to use GetThemeColor if themeing is enabled (IsThemeActive()) and defer to GetSysColor otherwise.

    edit: I've revised the code to work on XP.
    Code:
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" (ByRef pcrColorization As Long, ByRef pfOpaqueBlend As Long) As Long
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    
    Const COLOR_ACTIVECAPTION As Long = 2
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
    Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
    Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
    Const VSCLASS_WINDOW As String = "WINDOW"
    Const WP_CAPTION As Long = 1
    Const CS_ACTIVE As Long = 1
    Const TMT_FILLCOLORHINT     As Long = 3821
    
    Public Function ARGBToCOLORREF(ByVal ARGB As Long) As Long
        ' drops alpha
        ARGBToCOLORREF = ARGBToCOLORREF Or (ARGB And &HFF&) * &H10000
        ARGBToCOLORREF = ARGBToCOLORREF Or ARGB And &HFF00&
        ARGBToCOLORREF = ARGBToCOLORREF Or (ARGB And &HFF0000) \ &H10000
    End Function
    
    ' DWM colors are ARGB, unlike VB/COLOREF which is 0BGR
    Public Function GetDwmColor(ByRef Color As Long) As Boolean
        Dim DwmEnabled As Long  ' BOOL
        Dim OpaqueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        Dim ARGB As Long
        
        On Error GoTo EH
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise 5, "DwmIsCompositionEnabled()", "ERROR (0x" & Hex$(Result) & ")"
    
        If DwmEnabled = 0 Then _
            Err.Raise 5, "GetDwmColor()", "DwmIsComposition is not enabled"
       
        Result = DwmGetColorizationColor(ARGB, OpaqueBlend)
        If Result < 0 Then _
            Err.Raise 5, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
            
        Color = ARGBToCOLORREF(ARGB)
        GetDwmColor = True
    EH:
    End Function
    
    
    Public Function GetActiveCaptionColor(ByVal hWnd As Long) As Long
        Dim Theme As Long
        Dim Result As Long  ' HRESULT
        
        If Not GetDwmColor(GetActiveCaptionColor) Then
            
            Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
            
            If Theme Then ' is theming enabled?
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_ACTIVE, _
                                       TMT_FILLCOLORHINT, _
                                       GetActiveCaptionColor)
                If Result < 0 Then _
                    Err.Raise 5, "GetThemeColor()", "ERROR (0x" & Hex$(Result) & ")"
        
                CloseThemeData Theme
            Else
                ' fallback to GetSysColor
                GetActiveCaptionColor = GetSysColor(COLOR_ACTIVECAPTION)
            End If
        End If
    End Function
    Code:
    Private Sub Form_Load()
        Show
        BackColor = GetActiveCaptionColor(hWnd)
    End Sub
    Last edited by DEXWERX; Jun 8th, 2018 at 11:41 AM.

  7. #7

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    DEXWERX - You're a genius! That code works in WinXP, Win7 and Win10. Great! Thanks for all your work.

    can i make this method work similarly for getting theme text color too?
    /Jimboat

  8. #8
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    That's slightly easier if as long as you have an updated XP.
    GetThemeSysColor() is the GetSysColor equivalent for themes.

    altogether...
    Code:
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" (ByRef pcrColorization As Long, ByRef pfOpaqueBlend As Long) As Long
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    
    Private Const COLOR_ACTIVECAPTION As Long = 2
    Private Const COLOR_CAPTIONTEXT As Long = 9
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
    Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
    Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
    Private Declare Function GetThemeSysColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iColorID As Long) As Long 'COLORREF
    Private Const VSCLASS_WINDOW As String = "WINDOW"
    Private Const WP_CAPTION As Long = 1
    Private Const CS_ACTIVE As Long = 1
    Private Const TMT_FILLCOLORHINT As Long = 3821&
    Private Const TMT_ACTIVECAPTION As Long = 1603&
    Private Const TMT_TEXTCOLOR As Long = 3803&
    Private Const TMT_GRADIENTACTIVECAPTION = 1628&
    
    
    Public Function ARGBToCOLORREF(ByVal ARGB As Long, Optional BlendWith As Long = &HFFFFFF) As Long
        Dim R!: R = ((ARGB And &HFF0000) \ &H10000) / 255!
        Dim G!: G = ((ARGB And &HFF00&) \ &H100) / 255!
        Dim B!: B = (ARGB And &HFF&) / 255!
        Dim A!: A = (ARGB And &H7F000000) \ &H1000000
        If ARGB < 0 Then A = (A + 128!)
        A = A / 255!
        
        Dim R_!, G_!, B_!
        R_ = (BlendWith And &HFF) / 255!
        G_ = (BlendWith And &HFF00& \ &H100) / 255!
        B_ = (BlendWith And &HFF0000 \ &H10000) / 255!
        
        ' crude alpha blend?
        ARGBToCOLORREF = RGB(255 * (R_ * (1 - A) + R * A), _
                             255 * (G_ * (1 - A) + G * A), _
                             255 * (B_ * (1 - A) + B * A))
    End Function
    
    ' DWM colors are ARGB, unlike VB/COLOREF which is 0BGR
    Public Function GetDwmColor(ByRef Color As Long, Optional BlendWith As Long = &HFFFFFF) As Boolean
        Dim DwmEnabled As Long  ' BOOL
        Dim OpaqueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        Dim ARGB As Long
        
        On Error GoTo EH
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise 5, "DwmIsCompositionEnabled()", "ERROR (0x" & Hex$(Result) & ")"
    
        If DwmEnabled = 0 Then _
            Err.Raise 5, "GetDwmColor()", "DwmIsComposition is not enabled"
       
        Result = DwmGetColorizationColor(ARGB, OpaqueBlend)
        If Result < 0 Then _
            Err.Raise 5, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
            
        Color = ARGBToCOLORREF(ARGB, BlendWith)
        GetDwmColor = True
    EH:
    End Function
    
    
    Public Function GetActiveCaptionColor(ByVal hWnd As Long, Optional BlendWith As Long = &HFFFFFF) As Long
        Dim Theme As Long
        Dim Result As Long  ' HRESULT
        
        If Not GetDwmColor(GetActiveCaptionColor, BlendWith) Then
            
            Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
            
            If Theme Then ' is theming enabled?
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_ACTIVE, _
                                       TMT_FILLCOLORHINT, _
                                       GetActiveCaptionColor)
                If Result < 0 Then _
                    Err.Raise 5, "GetThemeColor()", "ERROR (0x" & Hex$(Result) & ")"
        
                CloseThemeData Theme
            Else
                ' fallback to GetSysColor
                GetActiveCaptionColor = GetSysColor(COLOR_ACTIVECAPTION)
            End If
        End If
    End Function
    
    Public Function GetActiveCaptionTextColor(ByVal hWnd As Long) As Long
        Dim Theme As Long
        Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
        If Theme Then
            GetActiveCaptionTextColor = GetThemeSysColor(Theme, COLOR_CAPTIONTEXT)
            CloseThemeData Theme
        Else
            GetActiveCaptionTextColor = GetSysColor(COLOR_CAPTIONTEXT)
        End If
    End Function
    note I attempted to add alpha blending for those on Win7 with Glass enabled...

  9. #9

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    DEXWERX - thanks for all your work, DEXWERX! The line "GetActiveCaptionTextColor = GetThemeSysColor(Theme, COLOR_CAPTIONTEXT)" returns valid color value for WinXP (themed) but returns =0 for Win7 and Win10 OS's. Any idea what i've done wrong?
    /Jimboat

  10. #10
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: how to get Windows title bar color set in system (Win 10)

    @Jim, 0 = vbBlack. When running on Win10 (default theme), the titlebar caption color sure looks black. If you are using some custom theme, ensure the Theme variable returned by his function is non-zero.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  11. #11

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    Quote Originally Posted by LaVolpe View Post
    @Jim, 0 = vbBlack. When running on Win10 (default theme), the titlebar caption color sure looks black. If you are using some custom theme, ensure the Theme variable returned by his function is non-zero.
    Yes. tried different theme colors, but on the Win7 and Win10 OS's, always get return=0 (current test shows text color is white, but return=0).
    /Jimboat

  12. #12
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    wow, talk about consistency. turns out you can't really count on it, in the different OS versions.
    The best you can do is detect the OS, and use the appropriate APIs based on that.

    Try and use GetSysColor(COLOR_CAPTIONTEXT) it seems it should work instead of GetThemeSysColor.

    Of course on Win10 using a High Contrast theme throws everything into question, so as with all things MS, testing is really the only way to get the desired behavior.

  13. #13
    Fanatic Member
    Join Date
    Apr 2015
    Posts
    524

    Re: how to get Windows title bar color set in system (Win 10)

    Here's what I use:

    Code:
    GetAccentColor = CLng(&H80000002) 'default
    
    m = GetRegistryValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows\DWM", "AccentColor")
    
    If Len(m) Then
        argb = CLng(m)
        rgb = argb And &HFFFFFF
    Else
        rgb = CLng(&H80000002)
    End If
    
    GetAccentColor = rgb
    It is Elroy's idea:
    http://www.vbforums.com/showthread.p...ht=AccentColor

  14. #14
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    just revisiting this. Turns out DwmGetColorizationColor is broken, and the most reliable thing is to hit up the registry (like Karl/Elroy), or use the undocumented API to get out the same values.
    https://stackoverflow.com/questions/...et-glass-color

    Here's my final take...

    Code:
    Option Explicit
    
    Private Type DWMCOLORIZATIONPARAMS
        ColorizationColor As Long
        ColorizationAfterGlow As Long
        ColorizationColorBalance As Long
        ColorizationAfterglowBalance As Long
        ColorizationBlurBalance As Long
        ColorizationGlassReflectionIntensity As Long
        ColorizationOpaqueBlend As Long
    End Type
    
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    Private Declare Function DwmGetColorizationParameters Lib "dwmapi" Alias "#127" (ByRef Parameters As DWMCOLORIZATIONPARAMS) As Long
    
    Private Const COLOR_ACTIVECAPTION As Long = 2
    Private Const COLOR_CAPTIONTEXT As Long = 9
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
    Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
    Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
    Private Declare Function GetThemeSysColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iColorID As Long) As Long 'COLORREF
    Private Const VSCLASS_WINDOW As String = "WINDOW"
    Private Const WP_CAPTION As Long = 1
    Private Const CS_ACTIVE As Long = 1
    Private Const TMT_FILLCOLORHINT As Long = 3821&
    Private Const TMT_ACTIVECAPTION As Long = 1603&
    Private Const TMT_TEXTCOLOR As Long = 3803&
    Private Const TMT_GRADIENTACTIVECAPTION = 1628&
    
    Public Function ARGBToCOLORREF2(ByVal ARGB As Long, Optional ByVal BlendWith As Long = &HFFFFFF) As Long
    
        Dim R!: R = ((ARGB And &HFF0000) \ &H10000) / 255!
        Dim G!: G = ((ARGB And &HFF00&) \ &H100) / 255!
        Dim b!: b = (ARGB And &HFF&) / 255!
        Dim A!: A = (ARGB And &H7F000000) \ &H1000000
        If ARGB < 0 Then A = (A + 128!)
        A = A / 255!
    
        Dim R_!, G_!, B_!
        R_ = (BlendWith And &HFF) / 255!
        G_ = (BlendWith And &HFF00& \ &H100) / 255!
        B_ = (BlendWith And &HFF0000 \ &H10000) / 255!
    
        ARGBToCOLORREF2 = RGB(255 * (R_ * (1 - A) + R * A), _
                              255 * (G_ * (1 - A) + G * A), _
                              255 * (B_ * (1 - A) + b * A))
    End Function
    
    ' DWM colors are ARGB, unlike VB/COLOREF which is 0BGR
    Public Function GetDwmColor(ByRef Color As Long, Optional ByVal BlendWith As Long = &HFFFFFF) As Boolean
        Dim DwmEnabled As Long  ' BOOL
        Dim OpaqueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        Dim ARGB As Long
        Dim DwmParameters As DWMCOLORIZATIONPARAMS
        
        On Error GoTo EH
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise Result, "DwmIsCompositionEnabled()"
    
        If DwmEnabled = 0 Then _
            Err.Raise 5, "GetDwmColor()", "DwmIsComposition is not enabled"
       
        ' https://stackoverflow.com/questions/3560890/vista-7-how-to-get-glass-color
        ' DwmGetColorizationColor is broken...
        'Result = DwmGetColorizationColor(ARGB, OpaqueBlend)
        'If Result < 0 Then _
        '    Err.Raise result, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
        
        'so we're using an undocumted API instead...
        Result = DwmGetColorizationParameters(DwmParameters)
        If Result < 0 Then _
            Err.Raise Result, "DwmGetColorizationParameters()"
        
        Color = ARGBToCOLORREF2(DwmParameters.ColorizationColor, BlendWith)
        GetDwmColor = True
    EH:
    End Function
    
    Public Function GetActiveCaptionColor(ByVal hWnd As Long, Optional ByVal BlendWith As Long = &HFFFFFF) As Long
        Dim Theme As Long
        Dim Result As Long  ' HRESULT
        
        If Not GetDwmColor(GetActiveCaptionColor) Then
            
            Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
            If Theme Then ' is theming enabled?
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_ACTIVE, _
                                       TMT_FILLCOLORHINT, _
                                       GetActiveCaptionColor)
                If Result < 0 Then _
                    Err.Raise Result, "GetThemeColor()"
        
                CloseThemeData Theme
            Else
                ' fallback to GetSysColor
                GetActiveCaptionColor = GetSysColor(COLOR_ACTIVECAPTION)
            End If
        End If
    End Function
    
    Private Sub Form_Click()
        BackColor = GetActiveCaptionColor(hWnd)
        ForeColor = GetSysColor(COLOR_CAPTIONTEXT)
        Cls
        Print "0x" & Right$("0000000" & Hex$(ForeColor), 8)
        Print "0x" & Right$("0000000" & Hex$(ForeColor), 8)
        Print "0x" & Right$("0000000" & Hex$(ForeColor), 8)
        Print "0x" & Right$("0000000" & Hex$(ForeColor), 8)
    End Sub
    
    Private Sub Form_Load()
        Show
        Form_Click
    End Sub
    Last edited by DEXWERX; Jun 13th, 2018 at 05:34 PM.

  15. #15

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    DEXWERX - wow! this project has turned out to be much harder than i anticipated. many thanks for your perseverance, DEXWERX!

    i've been trying for the past few days to get some code with DwmGetColorizationColor to work, and it just doesn't work consistently after all my testing on different OS's and different selected themes. Interesting that you say that DwmGetColorizationColor is 'broken'...that sure explains things!

    Your new code using the 'undocumented' DwmGetColorizationParameters seems to work OK in all the cases where i've tested it. (good job!) The only place i'm getting a problem so far, is with Win10, getting wrong color of caption text (shows black, but form heading text is white).

    DEXWERX, is there any 'risk' going forward, with using the 'undocumented' DwmGetColorizationParameters API? what is the real meaning of 'undocumented'? is it likely to be dropped from future OS versions, do you think?
    /Jimboat

  16. #16
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: how to get Windows title bar color set in system (Win 10)

    yes, that's exactly what it means. it's at risk for breaking on future versions.
    It's theoretically more at risk of breaking than the registry entry - although highly unlikely. the stackoverflow link has some of that discussion.

  17. #17

    Thread Starter
    Addicted Member
    Join Date
    Feb 2004
    Posts
    145

    Re: how to get Windows title bar color set in system (Win 10)

    The stackoverflow discussion is interesting. So, if using the undocumented API is "bad, bad" and relying on registry is "bad", I'm starting to think that duplicating Windows theme caption background and text colors is just not going to be possible?
    Last edited by Jimboat; Jul 10th, 2018 at 07:52 AM.
    /Jimboat

  18. #18
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: how to get Windows title bar color set in system (Win 10)

    Quote Originally Posted by DEXWERX View Post
    On XP you have to use GetThemeColor if themeing is enabled (IsThemeActive()) and defer to GetSysColor otherwise.

    edit: I've revised the code to work on XP.
    Code:
    Private Declare Function DwmGetColorizationColor Lib "dwmapi" (ByRef pcrColorization As Long, ByRef pfOpaqueBlend As Long) As Long
    Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
    
    Const COLOR_ACTIVECAPTION As Long = 2
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
    Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
    Private Declare Function GetThemeColor Lib "uxtheme" (ByVal hTheme As Long, ByVal iPartId As Long, ByVal iStateId As Long, ByVal iPropId As Long, ByRef pColor As Long) As Long
    Const VSCLASS_WINDOW As String = "WINDOW"
    Const WP_CAPTION As Long = 1
    Const CS_ACTIVE As Long = 1
    Const TMT_FILLCOLORHINT     As Long = 3821
    
    Public Function ARGBToCOLORREF(ByVal ARGB As Long) As Long
        ' drops alpha
        ARGBToCOLORREF = ARGBToCOLORREF Or (ARGB And &HFF&) * &H10000
        ARGBToCOLORREF = ARGBToCOLORREF Or ARGB And &HFF00&
        ARGBToCOLORREF = ARGBToCOLORREF Or (ARGB And &HFF0000) \ &H10000
    End Function
    
    ' DWM colors are ARGB, unlike VB/COLOREF which is 0BGR
    Public Function GetDwmColor(ByRef Color As Long) As Boolean
        Dim DwmEnabled As Long  ' BOOL
        Dim OpaqueBlend As Long ' BOOL
        Dim Result As Long      ' HRESULT
        Dim ARGB As Long
        
        On Error GoTo EH
        
        Result = DwmIsCompositionEnabled(DwmEnabled)
        If Result < 0 Then _
            Err.Raise 5, "DwmIsCompositionEnabled()", "ERROR (0x" & Hex$(Result) & ")"
    
        If DwmEnabled = 0 Then _
            Err.Raise 5, "GetDwmColor()", "DwmIsComposition is not enabled"
       
        Result = DwmGetColorizationColor(ARGB, OpaqueBlend)
        If Result < 0 Then _
            Err.Raise 5, "DwmGetColorizationColor()", "ERROR (0x" & Hex$(Result) & ")"
            
        Color = ARGBToCOLORREF(ARGB)
        GetDwmColor = True
    EH:
    End Function
    
    
    Public Function GetActiveCaptionColor(ByVal hWnd As Long) As Long
        Dim Theme As Long
        Dim Result As Long  ' HRESULT
        
        If Not GetDwmColor(GetActiveCaptionColor) Then
            
            Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
            
            If Theme Then ' is theming enabled?
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_ACTIVE, _
                                       TMT_FILLCOLORHINT, _
                                       GetActiveCaptionColor)
                If Result < 0 Then _
                    Err.Raise 5, "GetThemeColor()", "ERROR (0x" & Hex$(Result) & ")"
        
                CloseThemeData Theme
            Else
                ' fallback to GetSysColor
                GetActiveCaptionColor = GetSysColor(COLOR_ACTIVECAPTION)
            End If
        End If
    End Function
    Code:
    Private Sub Form_Load()
        Show
        BackColor = GetActiveCaptionColor(hWnd)
    End Sub
    Hi DEXWERX,

    Thanks for the code. It works well.

    Now Im trying to get the theme color for the inactive caption.
    I have tried the following constantes among many others:
    Code:
         Theme = OpenThemeData(hWnd, StrPtr(VSCLASS_WINDOW))
           
       
            If Theme Then ' is theming enabled?
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_INACTIVE, _
                                       TMT_INACTIVECAPTION, _
                                       GetInActiveCaptionColor)
    
    Debug.Print Result  '<== failed with negative value
    But it doesn' work... Any thoughts ? Using Windows 10

    Thanks.

  19. #19
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: how to get Windows title bar color set in system (Win 10)

    I still can't figrue out the correct Part and State constants\values that are required in the GetThemeColor API for retrieving the current theme color of the title bar in U]inactive[/U] windows

    This is driving me crazy .... Can sombody help me with this ?

    Thanks.

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

    Re: how to get Windows title bar color set in system (Win 10)

    Most logical would be to use CS_INACTIVE (=2) instead of CS_ACTIVE (=1) in call to GetThemeColor like this

    Code:
                Result = GetThemeColor(Theme, _
                                       WP_CAPTION, _
                                       CS_INACTIVE, _
                                       TMT_FILLCOLORHINT, _
                                       GetInActiveCaptionColor)
    Why change TMT_FILLCOLORHINT to TMT_INACTIVECAPTION? This param should specify whether to return fill color or border color.

    cheers,
    </wqw>

  21. #21
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: how to get Windows title bar color set in system (Win 10)

    That is exactly the first logical thing I tried but it didn't work. That's why I kept trying with many other constants but no success.

    your code suggestion gives me the color #b9d1ea which is a grey shade darker than the current inactive title bar theme color.

    Thanks wqw.

  22. #22
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: how to get Windows title bar color set in system (Win 10)

    Ok - I have finally managed to get the inactive caption theme color ... I was mistakenly using BRG instead of RGB.

    I have another question:
    Is there a dwmapi or uxtheme API to query if the theme color is currently being applied to the windows title bars and Borders or not ?

    Name:  image_2021-09-24_173255.png
Views: 814
Size:  8.0 KB

    Thanks.

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