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.

salut,

IsThemeActive et GetCurrentThemeName

ShareVB

Bonjour ShareVB,

Un petit exemple de code serait le bienvenue ...

Copyrightx

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 ...

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

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

Copyrightx

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

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

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