Convertisseur de codes couleur décimal - hexadécimal - rgb

Soyez le premier à donner votre avis sur cette source.

Vue 33 901 fois - Téléchargée 1 165 fois

Description

Ce programme est un convertisseur pour les codes de couleurs.
Il sert pour différents logiciels et différents types de programmation. Par exemple, la programmation HTML demande les codes couleurs Hexadécimaux alors que le dessin Bitmap demande les codes couleurs RGB.
Les couleurs sont identiques mais il existe 3 bases (au moins) pour les appeler:
- le code décimal : 1 --------> 16777216
- le code hexadécimal : 000000 --------> FFFFFF
- le code RGB : 000 000 000 --------> 255 255 255
ATTENTION !!!
Les codes hexadécimaux et RGB peuvent être inversés suivant les logiciels:
- code hexadécimal : 0C589A --------> 9A580C (l'inversion se fait par 2 caractères)
- code RGB : 253 125 034 --------> 034 125 253
Cela vient du fait que des logiciels utilisent RGB et d'autres BGR (idem pour code hexadécimal).

Je vous conseille de télécharger le ZIP car trop de contrôles sont programmés à partir de la fenêtre de propriétés.

Source / Exemple :


Dim TxtF As Integer
Dim Temp As Integer

Private Sub Form_Load()
    TxtF = 1
    Conversion (3)
End Sub

Private Sub AscenseurDéc_Change()
    Call AscenseurDéc_Scroll
End Sub

Private Sub AscenseurDéc_Scroll()
    Dim AD As Long
    AD = AscenseurDéc.Value
    AD = (1000 * AD) + -999
    Text1.Text = Trim(Str(AD))
    Conversion (1)
End Sub

Private Sub BoutonOK_Click()
    Conversion (TxtF)   'TxtF est le choix du Focus : La TextBox qui a le focus garde sa valeur et les autres TextBox changent de valeur en fonction de celle-ci
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Temp = Text1.SelStart
    If KeyCode = vbKeyBack And Text1.SelStart <> 0 Then
        Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)
        Text1.SelStart = Temp - 1
    End If
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
    Temp = Text2.SelStart
    If KeyCode = vbKeyBack And Text2.SelStart <> 0 Then
        Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1)
        Text2.SelStart = Temp - 1
    End If
End Sub

Private Sub Text3_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Temp = Text3(Index).SelStart
    If KeyCode = vbKeyBack And Text3(Index).SelStart <> 0 Then
        Text3(Index).Text = Left(Text3(Index).Text, Len(Text3(Index).Text) - 1)
        Text3(Index).SelStart = Temp - 1
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If InStr("0123456789" & vbKeyBack & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0    'Filtrage de la saisie
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If InStr("0123456789abcdefABCDEF" & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0   'Filtrage de la saisie
    If InStr("abcdef", Chr(KeyAscii)) Then KeyAscii = KeyAscii - 32
End Sub

Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
    If InStr("0123456789" & vbKeyDelete, Chr(KeyAscii)) = 0 Then KeyAscii = 0   'Filtrage de la saisie
End Sub

Private Sub Text1_Validate(Cancel As Boolean)
    If Text1.Text = "" Then Text1.Text = "00000001"
    Formatage
End Sub

Private Sub Text2_Validate(Cancel As Boolean)
    If Text2.Text = "" Then Text2.Text = "000000"
    Formatage
End Sub

Private Sub Text3_Validate(Index As Integer, Cancel As Boolean)
    If Text3(Index).Text = "" Then Text3(Index).Text = "000"
    Formatage
End Sub

Private Sub Text1_GotFocus()
    TxtF = 1
End Sub

Private Sub Text2_GotFocus()
    TxtF = 2
End Sub

Private Sub Text3_GotFocus(Index As Integer)
    TxtF = 3
End Sub

Private Sub UpDown1_Change(Index As Integer)
    Text3(Index).Text = Format(Text3(Index).Text, "000")
    Conversion (3)
End Sub

Private Sub UpDown2_Change(Index As Integer)
    Text4(Index).Text = Format(Text4(Index).Text, "000")
    Conversion (4)
End Sub

Sub Conversion(TxtFormat)
    On Error Resume Next    'Facultatif sauf si le code comporte des bugs (??)
    Formatage
    Select Case TxtFormat
        Case 1
            Text3(2).Text = Trim(Str(Int(Val(Text1.Text) / 65536)))
            Text3(1).Text = Trim(Str(Int((Val(Text1.Text) - 65536 * Val(Text3(2).Text)) / 256)))
            Text3(0).Text = Trim(Str(Int(Val(Text1.Text) - 65536 * Val(Text3(2).Text) - 256 * Val(Text3(1).Text))))
            Text2.Text = Hex(Text1.Text - 1)
        Case 2
            For i% = 5 To 0 Step -1
                If Asc(Mid(Text2.Text, i% + 1, 1)) > 64 Then Text3(Int(i% / 2)).Text = Trim(Str(Val(Text3(Int(i% / 2)).Text) + (Asc(Mid(Text2.Text, i% + 1, 1)) - 55) * (16 ^ Abs(Round((i% / 2) - Int(i% / 2) + 0.1) - 1)))) Else Text3(Int(i% / 2)).Text = Trim(Str(Val(Text3(Int(i% / 2)).Text) + Val(Mid(Text2.Text, i% + 1, 1) * (16 ^ Abs(Round((i% / 2) - Int(i% / 2) + 0.1) - 1)))))
                Text1.Text = Trim(Str(Val(Text3(0).Text) + Val(Text3(1).Text) * 256 + Val(Text3(2).Text) * 65536 + 1))
            Next i%
        Case 3
            Text1.Text = Trim(Str(Val(Text3(0).Text) + Val(Text3(1).Text) * 256 + Val(Text3(2).Text) * 65536 + 1))
            Text2.Text = Hex(Text1.Text - 1)
        Case 4
            'en attente
    End Select
    PictureAperçu(0).BackColor = "&H" + Text2.Text
    PictureAperçu(1).BackColor = "&H" & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3) & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3) & Hex((Val(Text3(0).Text) + Val(Text3(1).Text) + Val(Text3(2).Text)) / 3)
    Formatage
End Sub

Sub Formatage()
    If Val(Text1.Text) > 16777216 Then Text1.Text = "16777216"  'Eviter les dépassements de valeurs
    For Each Element In Text3()
        If Val(Element.Text) > 255 Then Element.Text = "255"
    Next Element
    Text1.Text = Format(Text1.Text, "00000000")
    If Len(Text2.Text) <> 6 Then
        For i% = 0 To 5 - Len(Text2.Text)
            Text2.Text = Text2.Text & "0"
        Next i%
    End If
    For Each Element In Text3()
        Element.Text = Format(Element.Text, "000")
    Next Element
    For Each Element In Text4()
        Element.Text = Format(Element.Text, "000")
    Next Element
End Sub

Conclusion :


Si ce code comportait des bugs, merci de me le signaler.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
38
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mai 2004

ça aurait été une super source si au moins elle fonctionnait CORRECTEMENT
Messages postés
34
Date d'inscription
vendredi 9 novembre 2001
Statut
Membre
Dernière intervention
29 mars 2007

Joli travail, je cherchais un convertisseur et j'avais la flemme de l'ecrire.
Je ne prendrais que trois lignes dans ton code (format decimal to RGB).
Je met 9 pour l'esthétique.
Messages postés
115
Date d'inscription
samedi 2 février 2002
Statut
Membre
Dernière intervention
13 mai 2006

Bon certains dirons que je cherche la tite bete mais dans l'exemple qu'on voit sur la capture d'ecran, il y a une erreur:
h6db5f0 = d7190000 et non pas d7190001 c'est erreur n'est pas pardonnable! y a que des maths dans la conversion des bases numerique!!!! ;p
Messages postés
11
Date d'inscription
vendredi 31 mai 2002
Statut
Membre
Dernière intervention
27 novembre 2004

c'est genial, exactement ce que je cherchais! j'ai mis 10.
BRAVO !
Et toi JejeDev, t'as sûrement pas inventé l'eau chaude pour faire ce genre de commentaire.

Le code est pratique par ailleurs, bravo.
Afficher les 8 commentaires

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.