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 GetCurrentThemeName Lib "uxtheme" ( _
ByVal lpszThemeName As Long, _
ByVal dwMaxNameChars As Long, _
ByVal lpszColorBuff As Long, _
ByVal cchMaxColorChars As Long, _
ByVal lpszSizeBuff As Long, _
ByVal cchMaxSizeChars As Long _
) As Long
Public Function IsXPThemed() As Boolean
Dim hTheme As Long
hTheme = OpenThemeData(0, StrPtr("ExplorerBar"))
If (hTheme) Then
CloseThemeData hTheme
IsXPThemed = True
End If
End Function
Public Function XPThemeName() As String
If (IsXPThemed()) Then
XPThemeName = Space$(260)
GetCurrentThemeName 0, 0, StrPtr(XPThemeName), 260, 0, 0
XPThemeName = Trim$(XPThemeName)
Else
XPThemeName = "n/a"
End If
End Function