Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
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.
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
Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Danny Poirier" <dpoirier@pgsystem.com> wrote in message
news:eAoCngkcDHA.1552@TK2MSFTNGP11.phx.gbl...
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
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
Private Sub Main() Dim rg As CRegistry Set rg = New CRegistry Debug.Print rg.GetValue(rkcCurrentUser, "SoftwareMicrosoftWindowsCurrentVersionThemeManager", "ColorName") End Sub '***
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. > >
merci beaucoup Zoury !
Zoury <yanick_lefebvre@hotmail.com> a écrit dans le message :
u5BkwqkcDHA.2432@TK2MSFTNGP10.phx.gbl...
Salut Danny! :O)
Tu dois lire la la valeur "ColorName" contenue dans la clé
Private Sub Main()
Dim rg As CRegistry
Set rg = New CRegistry
Debug.Print rg.GetValue(rkcCurrentUser,
"SoftwareMicrosoftWindowsCurrentVersionThemeManager", "ColorName")
End Sub
'***
Merci de poster les réponses au groupe afin d'en faire profiter à tous
"Danny Poirier" <dpoirier@pgsystem.com> wrote in message
news:eAoCngkcDHA.1552@TK2MSFTNGP11.phx.gbl...
> 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.
>
>
Private Sub Main() Dim rg As CRegistry Set rg = New CRegistry Debug.Print rg.GetValue(rkcCurrentUser, "SoftwareMicrosoftWindowsCurrentVersionThemeManager", "ColorName") End Sub '***
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. > >
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
"Zoury" <yanick_lefebvre@hotmail.com> a écrit dans le message de
news:u5BkwqkcDHA.2432@TK2MSFTNGP10.phx.gbl...
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
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
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
Merci de poster les réponses au groupe afin d'en faire profiter à tous
"François Picalausa" <fpicalausa@chez.com> wrote in message
news:%23QUIQZlcDHA.3044@TK2MSFTNGP11.phx.gbl...
Bonjour/soir,
"Zoury" <yanick_lefebvre@hotmail.com> a écrit dans le message de
news:u5BkwqkcDHA.2432@TK2MSFTNGP10.phx.gbl...
> 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
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