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

Réponse acceptée !
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