DETERMINER QUEL THEME XP EST ACTIF (BLUE THEME, OLIVE THEME, SILVER THEME)Résolu

Question

Bonjour à tous,

         J'aimerais savoir s'il existe un moyen (avec ou sans UxTheme.dll) de déterminer quel thème de Windows est actif. Si il s'agit du thème "Blue Theme", la fonction (que je vais créer) renverra 0, pour "Olive Theme" elle renverra 1, pour "Silver Theme" elle renverra 2 et enfin si il s'agit d'un autre thème, elle renverra -1. Il faut juste qu'elle puisse différencier les trois thèmes Windows par défaut.

Merci pour votre aide,
Copyrightx.

ShareVB · Accepted Answer

salut,
en fait, c'est le deuxième paramètre de l'api...seulement, les noms sont plutôt bizarre NormalColor bleu, HomeStead olive, Metallic = silver...

Option Explicit

Private Declare Function IsThemeActiveAPI Lib "uxtheme.dll" Alias "IsThemeActive" () As Boolean

Private Declare Function GetCurrentThemeName Lib "uxtheme.dll" ( _
    ByVal pszThemeFileName As Long, _
    ByVal dwMaxNameChars As Long, _
    ByVal pszColorBuff As Long, _
    ByVal cchMaxColorChars As Long, _
    ByVal pszSizeBuff As Long, _
    ByVal cchMaxSizeChars As Long _
   ) As Long

Public Function GetActiveThemeName() As String
If (IsThemeActiveAPI()) Then
    Dim szThemeFileName As String, szColorBuff As String, szSizeBuff As String
   
    szThemeFileName = Space(256)
    szColorBuff = Space(256)
    szSizeBuff = Space(256)
    GetCurrentThemeName StrPtr(szThemeFileName), 256, StrPtr(szColorBuff), 256, StrPtr(szSizeBuff), 256
   
    GetActiveThemeName = Mid$(szThemeFileName, InStrRev(szThemeFileName, "") + 1)
    GetActiveThemeName = Mid$(GetActiveThemeName, 1, InStr(GetActiveThemeName, ".") - 1)
Else
    GetActiveThemeName = vbNullString
End If
End Function

Public Function GetActiveThemeColor() As String
If (IsThemeActiveAPI()) Then
    Dim szThemeFileName As String, szColorBuff As String, szSizeBuff As String
   
    szThemeFileName = Space(256)
    szColorBuff = Space(256)
    szSizeBuff = Space(256)
    GetCurrentThemeName StrPtr(szThemeFileName), 256, StrPtr(szColorBuff), 256, StrPtr(szSizeBuff), 256
   
    GetActiveThemeColor = Mid$(szColorBuff, 1, InStr(szColorBuff, vbNullChar) - 1)
Else
    GetActiveThemeColor = vbNullString
End If
End Function

Public Function GetActiveThemeSize() As String
If (IsThemeActiveAPI()) Then
    Dim szThemeFileName As String, szColorBuff As String, szSizeBuff As String
   
    szThemeFileName = Space(256)
    szColorBuff = Space(256)
    szSizeBuff = Space(256)
    GetCurrentThemeName StrPtr(szThemeFileName), 256, StrPtr(szColorBuff), 256, StrPtr(szSizeBuff), 256
   
    GetActiveThemeSize = Mid$(szSizeBuff, 1, InStr(szSizeBuff, vbNullChar) - 1)
Else
    GetActiveThemeSize = vbNullString
End If
End Function

Sub main()
MsgBox GetActiveThemeName & "(" & GetActiveThemeColor & ") (" & GetActiveThemeSize & ")"
End Sub

ShareVB

ShareVB · Answer

salut,

IsThemeActive et GetCurrentThemeName

ShareVB

copyrightx · Answer

Bonjour ShareVB,

Un petit exemple de code serait le bienvenue ... 



Copyrightx

copyrightx · Answer

J'ai trouvé ça sur le forum de Microsoft (www.forums.microsoft.com) :

Private Declare Function IsThemeActiveAPI Lib "uxtheme.dll" Alias "IsThemeActive" () As Boolean




Public Function GetThemeActive() As Boolean

        isAct = IsThemeActiveAPI()
        If isAct = True Then
            GetThemeActive = True
        Else
            GetThemeActive = False
        End If

End Function



Sub Main()

    Dim isThemed As Boolean
    isThemed = GetThemeActive
    MsgBox isThemed

End Sub

Le problème c'est que ça ne vérifie que si le thème est actif ou pas ... 
Je continue les recherches ...

ShareVB · Answer

salut,

désolé pour la latence...

Option Explicit

Private Declare Function IsThemeActiveAPI Lib "uxtheme.dll" Alias "IsThemeActive" () As Boolean

Private Declare Function GetCurrentThemeName Lib "uxtheme.dll" ( _
    ByVal pszThemeFileName As Long, _
    ByVal dwMaxNameChars As Long, _
    ByVal pszColorBuff As Long, _
    ByVal cchMaxColorChars As Long, _
    ByVal pszSizeBuff As Long, _
    ByVal cchMaxSizeChars As Long _
   ) As Long

Public Function GetActiveThemeName() As String
If (IsThemeActiveAPI()) Then
    Dim szThemeFileName As String, szColorBuff As String, szSizeBuff As String
    
    szThemeFileName = Space(256)
    szColorBuff = Space(256)
    szSizeBuff = Space(256)
    GetCurrentThemeName StrPtr(szThemeFileName), 256, StrPtr(szColorBuff), 256, StrPtr(szSizeBuff), 256
    
    GetActiveThemeName = Mid$(szThemeFileName, InStrRev(szThemeFileName, "") + 1)
    GetActiveThemeName = Mid$(GetActiveThemeName, 1, InStr(GetActiveThemeName, ".") - 1)
Else
    GetActiveThemeName = vbNullString
End If
End Function

Sub main()
MsgBox GetActiveThemeName
End Sub

ShareVB

copyrightx · Answer

Merci pour le code ShareVB, je teste et je te répond le plus vite possible ... 

Copyrightx

copyrightx · Answer

Bonjour,

Tout d'abord et ce, avant les formalités, merci pour le code ShareVB.

Ce dernier est très complêt car la fonction GetActiveThemeName retourne bien le nom du thème en cours, mais problème ...

Le fichier de thème Windows XP par défaut s'appelle "Luna". La fonction GetActiveThemeName renvoie donc la chaîne de caractère "Luna" mais cependant, ne permet pas de faire la différence entre le style BLUE, OLIVE et SILVER. Ce code ne répond donc qu'à la moitié de la question ...

Y a-t-il une fonction API qui permet d'obtenir le nom du style actif à partir du thème passé en paramêtre pour ainsi renvoyer, à partir de "Luna" (ou même sans passer de paramêtres), le style actif : BLUE ou OLIVE ou SILVER ?

Copyrightx

copyrightx · Answer

Plutôt rapide les réponses sur le forum : c'est pas en mal !!!

Mais je crois que pour toi rapidité rime avec productivité !
Encore merci pour le code !

Je teste et je répond le plus vite possible pour confirmer.

Copyrightx

DETERMINER QUEL THEME XP EST ACTIF (BLUE THEME, OLIVE THEME, SILVER THEME)

8 réponses

Votre réponse

Discussions similaires