' Benötigte API-Funktion
Private Declare Function GetCurrentThemeName Lib "uxtheme.dll" ( _
  ByVal pszThemeFileName As String, _
  ByVal dwMaxNameChars As Long, _
  ByVal pszColorBuff As String, _
  ByVal cchMaxColorChars As Long, _
  ByVal pszSizeBuff As String, _
  ByVal cchMaxSizeChars As Long) As Long

Dim sThemeFileName As String
Dim sColorBuffer As String
Dim sSizeBuffer As String
Dim nResult As Long
 
sThemeFileName = Space$(260)
sColorBuffer = Space$(255)
sSizeBuffer = Space$(255)
 
nResult = GetCurrentThemeName(sThemeFileName, Len(sThemeFileName), _
  sColorBuffer, Len(sColorBuffer), _
  sSizeBuffer, Len(sSizeBuffer))
 
If nResult = 0 Then
  sThemeFileName = ConvUnicode(sThemeFileName)
  sColorBuffer = ConvUnicode(sColorBuffer)
  sSizeBuffer = ConvUnicode(sSizeBuffer)
End If

Private Function ConvUnicode(ByVal sString As String) As String
  sString = StrConv(sString, vbFromUnicode)
  sString = Left$(sString, InStr(sString, Chr$(0)) - 1)
  ConvUnicode = sString
End Function

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de