Soyez le premier à donner votre avis sur cette source.
Vue 7 248 fois - Téléchargée 481 fois
Option Explicit '---- Déclarations des fonctions d'accès aux fichiers profiles #If Win16 Then Private Declare Function GetProfileString Lib "Kernel" (ByVal NomAppli As String, ByVal NomCle As String, ByVal Defaut As String, ByVal Retour As String, ByVal Taille As Integer) As Integer Private Declare Function WriteProfileString Lib "Kernel" (ByVal NomAppli As String, ByVal NomCle As String, ByVal Valeur As String) As Integer #Else Private Declare Function GetProfileString Lib "Kernel32" Alias "GetProfileStringA" (ByVal NomAppli As String, ByVal NomCle As String, ByVal Defaut As String, ByVal Retour As String, ByVal Taille As Integer) As Integer Private Declare Function WriteProfileString Lib "Kernel32" Alias "WriteProfileStringA" (ByVal NomAppli As String, ByVal NomCle As String, ByVal Valeur As String) As Integer #End If Const NOMAPP = "colors" 'Section couleurs dans le registre '---- Initialisations Private Sub Form_Load() Dim LaListe As String * 1024 Dim i, Pos, NPos As Integer Dim MotClé As String ' Obtient la liste des mots clés de [colors] dans le registre GetProfileString NOMAPP, vbNullString, "", LaListe, Len(LaListe) ' Explore et remplit la liste Pos = 1 Do While True NPos = InStr(Pos, LaListe, Chr(0)) If NPos = 0 Then Exit Do MotClé = Mid(LaListe, Pos, NPos - Pos) If MotClé = "" Then Exit Do ListeClés.AddItem MotClé Pos = NPos + 1 Loop ' Initialise les valeurs For i = 0 To 2 DefilCouleur(i).Value = 0 Next End Sub '---- Sélection d'une clé dans la liste Private Sub ListeClés_Click() Dim Clé As String Dim Coul As String * 20 Dim Courant As String Dim i As Integer Dim Pos As Integer Dim NPos As Integer ' Lit la valeur correspondant à la sélection Clé = ListeClés.Text GetProfileString NOMAPP, Clé, "", Coul, Len(Coul) Pos = 1 For i = 0 To 2 NPos = InStr(Pos, Coul, " ") If NPos = 0 Then NPos = InStr(Pos, Coul, Chr(0)) Courant = Mid(Coul, Pos, NPos - Pos) DefilCouleur(i).Value = Val(Courant) Pos = NPos + 1 Next End Sub '---- Affiche les couleurs Private Sub AffCouleur() Couleur.BackColor = RGB(DefilCouleur(0).Value, DefilCouleur(1).Value, DefilCouleur(2).Value) End Sub '---- Modification dans les couleurs Private Sub DefilCouleur_Change(Index As Integer) ValCouleur(Index).Caption = LTrim(Str(DefilCouleur(Index).Value)) AffCouleur End Sub '---- Ecriture d'une modification Private Sub Ecrire_Click() ' Nouvelles valeurs Dim Valeur As String, Clé As String Valeur = ValCouleur(0).Caption + " " + ValCouleur(1).Caption + " " + ValCouleur(2).Caption + " " Clé = ListeClés.Text ' Ecrit dans WINI.INI WriteProfileString NOMAPP, Clé, Valeur MsgBox "La valeur a été écrite" + vbCrLf + "La modification sera prise en compte" + vbCrLf + "au prochain lancement de Windows", 48, Feuille.Caption End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.