XP-Theme ermitteln Dieser Tipp verrät, wie sich ermitteln lässt, welche Darstellung der User unter WinXP gewählt hat.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  15.456
https://www.tools4vb.com	System:  WinXP, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 12 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Unter XP kann der User bekanntlich auswählen, ob er lieber die klassische Darstellung oder die modernere Luna-Darstellung bevorzugt. Weiterhin kann er zwischen verschiedenen Farbschemen auswählen (Blau, Grün, Silber).

Nachfolgender Tipp zeigt, wie Sie die aktuelle Einstellung aus Ihrer VB-Anwendung heraus ermitteln können.

' 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

Aufruf:

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)
 
  MsgBox "Theme-Name: " & sThemeFileName & vbCrLf & _
    "Color: " & sColorBuffer & vbCrLf & _
    "Size: " & sSizeBuffer
Else
  MsgBox "Error! Evtl. kein Theme aktiviert, sondern Windows-Klassisch."
End If

' Hilfsfunktion
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