Windows Theme!

[moe188]

Hi,
I was wondering how can I determine what windows theme is in use by the user. For example: if blue theme, I want to display "Blue Theme" (or Olive, Silver or Classic).
I know it's not important, but it's something that I want to find out.
Thank you,
Mc

[RobDog888]

You need to use the uxtheme.dll theme APIs to determine if a theme is being used (Windows XP and newer only).

IsThemeActive and GetCurrentThemeName.

[moe188]

can you assist with a sample please?
thank you

[RobDog888]

Sorry, IsThemeActive is only for a particular app and not globally for your windows session.

I'll whip something up right now.

[seacoldheart]

what's the API declare method

[penagate]

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

[mebhas]

straightaway i can see some problems here. sorry pean, maybe i'm wrong but i think it can cause some problems here

Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long) As Long
 
hTheme = OpenThemeData(0, StrPtr("ExplorerBar"))

two parameters are passed to OpenThemeData which takes only one parameter.

[penagate]

Bahaha, sorry, I forgot the second one

Private Declare Function OpenThemeData Lib "uxtheme" ( _
    ByVal hWnd As Long, _
    ByVal pszClassList As Long _
) As Long

[mebhas]

there is still a problem here, it will always be "", null string

Public Function XPThemeName() As String
    If (IsXPThemed()) Then
        Dim buffer As String: buffer = Space$(260)
        GetCurrentThemeName 0, 0, StrPtr(buffer), 260, 0, 0
        XPThemeName = Trim$(XPThemeName) '<==XPThemeName is always nothing, make a guess
    Else
        XPThemeName = "n/a"
    End If
End Function

i think it should be

Public Function XPThemeName() As String
    If (IsXPThemed()) Then
        Dim buffer As String: buffer = Space$(260)
        GetCurrentThemeName 0, 0, StrPtr(buffer), 260, 0, 0
        XPThemeName = Trim$(buffer)
    Else
        XPThemeName = "n/a"
    End If
End Function

[penagate]

Fixed

[RobDog888]

I finished this last night but didnt have time to post it. This works and is not for a particular app theming either.

http://www.vbforums.com/showthread.php?t=378272