-
Jun 6th, 2018, 12:57 PM
#1
Thread Starter
Addicted Member
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?
-
Jun 7th, 2018, 11:13 AM
#2
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
-
Jun 7th, 2018, 02:33 PM
#3
Thread Starter
Addicted Member
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
-
Jun 7th, 2018, 03:18 PM
#4
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"
-
Jun 8th, 2018, 08:52 AM
#5
Thread Starter
Addicted Member
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?
-
Jun 8th, 2018, 09:56 AM
#6
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.
-
Jun 8th, 2018, 04:00 PM
#7
Thread Starter
Addicted Member
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?
-
Jun 8th, 2018, 05:36 PM
#8
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...
-
Jun 9th, 2018, 11:18 AM
#9
Thread Starter
Addicted Member
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?
-
Jun 9th, 2018, 11:23 AM
#10
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.
-
Jun 9th, 2018, 11:36 AM
#11
Thread Starter
Addicted Member
Re: how to get Windows title bar color set in system (Win 10)
Originally Posted by LaVolpe
@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).
-
Jun 9th, 2018, 12:18 PM
#12
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.
-
Jun 11th, 2018, 02:59 AM
#13
Fanatic Member
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
-
Jun 13th, 2018, 05:02 PM
#14
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.
-
Jun 13th, 2018, 05:26 PM
#15
Thread Starter
Addicted Member
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?
-
Jun 13th, 2018, 05:32 PM
#16
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.
-
Jun 13th, 2018, 07:09 PM
#17
Thread Starter
Addicted Member
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
-
Sep 23rd, 2021, 05:09 PM
#18
Fanatic Member
Re: how to get Windows title bar color set in system (Win 10)
Originally Posted by DEXWERX
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.
-
Sep 24th, 2021, 07:31 AM
#19
Fanatic Member
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.
-
Sep 24th, 2021, 07:46 AM
#20
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>
-
Sep 24th, 2021, 08:10 AM
#21
Fanatic Member
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.
-
Sep 24th, 2021, 11:34 AM
#22
Fanatic Member
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 ?
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|