Determine XP Theme Name and Color

[RobDog888]

In order to use XP themes you need to be running Windows XP at a minimum. This code will detect the filename being used and the theme color. This is a Global detection and not just for a single application or any trickery.

Option Explicit
 
Private Declare Function GetCurrentThemeName Lib "uxtheme.dll" (ByVal pszThemeFileName As String, ByVal dwMaxNameChars As Integer, _
ByVal pszColorBuff As String, ByVal cchMaxColorChars As Integer, ByVal pszSizeBuff As String, ByVal cchMaxSizeChars As Integer) As Long
    
Private Sub Command1_Click()
    Dim lResult As Long
    Dim strFileName As String
    Dim strColor As String
    Const S_OK As Long = &H0
    
    strFileName = Space(255)
    strColor = Space(255)
    lResult = GetCurrentThemeName(strFileName, 255, strColor, 255, vbNullString, 0)
    If lResult <> S_OK Then
        MsgBox "Error: Can not read theme (if any).", vbOKOnly + vbInformation
        Exit Sub
    End If
    strFileName = InStrRev(strFileName, vbNullChar)
    strFileName = Replace(strFileName, vbNullChar, "")
    strColor = Replace(strColor, vbNullChar, "")
    If Trim$(strFileName) = vbNullString Then strFileName = "Windows Classic (No Theme)"
    If Trim$(strColor) = vbNullString Then strColor = "None"
    MsgBox "Theme: " & strFileName & vbNewLine & "Color: " & strColor
End Sub