| Код | Option Explicit
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
Private Const S_OK As Long = &H0&
Public Sub GetThemeType(stFile As String, stName As String, stSize As String)
Dim s As String, t As String, u As String
s = Space$(256)
t = Space$(256)
u = Space$(256)
If GetCurrentThemeName(StrPtr(s), Len(s), StrPtr(t), Len(t), StrPtr(u), Len(u)) = S_OK Then
stFile = NullTrim(s)
stName = NullTrim(t)
stSize = NullTrim(u)
End If
End Sub
Private Function NullTrim(ByVal strString As String) As String
NullTrim = Left$(strString, InStr(strString, vbNullChar) - 1)
End Function |
Удачи |