OVH Cloud OVH Cloud

Thème de WindowsXP dans la base de registres?

4 réponses
Avatar
Danny Poirier
Bonjour,

J'aimerais savoir s'il est possible de déterminer à partir de la base de
registre
le thème courant appliqué dans Windows XP.

Sinon, est-il possible d'obtenir cet information autrement par programmation
?

Merci.

4 réponses

Avatar
Zoury
Salut Danny! :O)

Tu dois lire la la valeur "ColorName" contenue dans la clé
"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionThemeManager".

Voici un exemple :
'***
Option Explicit

Private Sub Main()
Dim rg As CRegistry
Set rg = New CRegistry
Debug.Print rg.GetValue(rkcCurrentUser,
"SoftwareMicrosoftWindowsCurrentVersionThemeManager", "ColorName")
End Sub
'***

pour la classe CRegistry
http://groups.google.com/groups?threadm=eLEAIB0EDHA.1548%40TK2MSFTNGP12.phx.gbl

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Danny Poirier" wrote in message
news:
Bonjour,

J'aimerais savoir s'il est possible de déterminer à partir de la base de
registre
le thème courant appliqué dans Windows XP.

Sinon, est-il possible d'obtenir cet information autrement par


programmation
?

Merci.




Avatar
Danny Poirier
merci beaucoup Zoury !


Zoury a écrit dans le message :

Salut Danny! :O)

Tu dois lire la la valeur "ColorName" contenue dans la clé



"HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionThemeManager".

Voici un exemple :
'***
Option Explicit

Private Sub Main()
Dim rg As CRegistry
Set rg = New CRegistry
Debug.Print rg.GetValue(rkcCurrentUser,
"SoftwareMicrosoftWindowsCurrentVersionThemeManager", "ColorName")
End Sub
'***

pour la classe CRegistry



http://groups.google.com/groups?threadm=eLEAIB0EDHA.1548%40TK2MSFTNGP12.phx.
gbl

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Danny Poirier" wrote in message
news:
> Bonjour,
>
> J'aimerais savoir s'il est possible de déterminer à partir de la base de
> registre
> le thème courant appliqué dans Windows XP.
>
> Sinon, est-il possible d'obtenir cet information autrement par
programmation
> ?
>
> Merci.
>
>




Avatar
François Picalausa
Bonjour/soir,

"Zoury" a écrit dans le message de
news:
Voici un exemple :



Programmaticalement, je conseillerais plutôt l'API GetCurrentThemeName:

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
Private Const S_OK = &H0

Private Sub Command1_Click()
Dim themefilename As String, color As String, size As String
themefilename = String$(256, vbNullChar)
color = String$(256, vbNullChar)
size = String$(256, vbNullChar)

'256 puis taille de 128 parce qu'en UNICODE
If GetCurrentThemeName(themefilename, 128, color, 128, size, 128) = S_OK
Then
MsgBox "Fichier : " & RTrimNulls(StrConv(themefilename,
vbFromUnicode)) & vbNewLine & "Couleur : " & RTrimNulls(StrConv(color,
vbFromUnicode)) & vbNewLine & "Taille : " & RTrimNulls(StrConv(size,
vbFromUnicode))
End If
End Sub

Private Function RTrimNulls(strText As String) As String
Dim NullPos As Long
NullPos = InStr(1, strText, vbNullChar)
If NullPos = 0 Then
RTrimNulls = strText
Else
RTrimNulls = Left(strText, NullPos - 1)
End If
End Function


--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com
Avatar
Zoury
belle trouvaille! ;O)

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous
"François Picalausa" wrote in message
news:%
Bonjour/soir,

"Zoury" a écrit dans le message de
news:
> Voici un exemple :

Programmaticalement, je conseillerais plutôt l'API GetCurrentThemeName:

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
Private Const S_OK = &H0

Private Sub Command1_Click()
Dim themefilename As String, color As String, size As String
themefilename = String$(256, vbNullChar)
color = String$(256, vbNullChar)
size = String$(256, vbNullChar)

'256 puis taille de 128 parce qu'en UNICODE
If GetCurrentThemeName(themefilename, 128, color, 128, size, 128) S_OK
Then
MsgBox "Fichier : " & RTrimNulls(StrConv(themefilename,
vbFromUnicode)) & vbNewLine & "Couleur : " & RTrimNulls(StrConv(color,
vbFromUnicode)) & vbNewLine & "Taille : " & RTrimNulls(StrConv(size,
vbFromUnicode))
End If
End Sub

Private Function RTrimNulls(strText As String) As String
Dim NullPos As Long
NullPos = InStr(1, strText, vbNullChar)
If NullPos = 0 Then
RTrimNulls = strText
Else
RTrimNulls = Left(strText, NullPos - 1)
End If
End Function


--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com