Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

CONVERTISSEUR DE CODES COULEUR DÉCIMAL - HEXADÉCIMAL - RGB


Information sur la source

Catégorie :Graphique Classé sous : convertisseur, conversion, couleur, code, hexa Niveau : Débutant Date de création : 16/04/2001 Vu / téléchargé: 20 288 / 664

Note :
9,8 / 10 - par 5 personnes
9,80 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale
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

  • 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
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.
 

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

Commentaires et avis

signaler à un administrateur
Commentaire de bonbecman le 07/08/2003 14:39:31

c'est genial, exactement ce que je cherchais! j'ai mis 10.
BRAVO !

signaler à un administrateur
Commentaire de wonesek le 28/10/2003 21:13:45

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

signaler à un administrateur
Commentaire de Steff le 26/11/2003 15:45:20

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.

signaler à un administrateur
Commentaire de CyberFlash le 17/01/2004 17:24:43

ça aurait été une super source si au moins elle fonctionnait CORRECTEMENT

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

recuperer code hexa entier d'une couleur [ par NaBuCO ] voila mon pb c ke je ve recuperer le code hexa de la couleur que choisi l'utilisateur ds la palette tout va bien qd c a 6 caractere genre FFFFFF (pour Conversion Hex/Dec/Bin [ par Siller ] Bonjour,Je débute en VisualBasic et j'aimerais créer un convertisseur Hexa/Binaire/DécimalLa probleme est que je ne sias pas du tout quel est le code Aide pour conversion de code Basic - C++ !! [ par Ral ] Salut à tous.N'ayant pas de compétence en "Basic",Je recherche quelqu'un qui s'y connait bien en "Basic"(sur Turbo-Basic ou Quick-Basic) et C++ ,et qu Convertisseur code source [ par sb ] Où puis-je trouver un convertisseur de code source vers un document RFT ou DOC (Microsoft Word) ?Les copier-coller font perdre la couleur du texte (le Couleur de WinXP [ par DeepImpact ] Voila je crée une application pour WinXP sur un PC qui as Win 98 SE, mon probleme c la couleur !!!Quelle est le code de la couleur de WinXP le sorte d couleur hexadecimal urgent!! [ par gianfare ] hello, j'ai un ocx qui s'appelle codemax21 qui me permet detaper du code html.mon problème survient lorsque je veux mettreune couleure d'arrière plan couleur urgent!!!! [ par gianfare ] hello, j'ai un ocx qui s'appelle codemax21 qui me permet detaper du code html.mon problème survient lorsque je veux mettreune couleure d'arrière plan Couleur vb --> hexadecimal [ par vjeux ] Bonjour, je cherche un algo qui permette de passer d'une couleur vb (ex : &H8000000E& ) en une couleur hexa (ex : FF00FF )J'ai trouvé la conversion he Problème de filtre avec VB6 [ par ugob ] Bonjour,J'ai fais un formulaire dynamique de recherche sous VB6 relié à une base de donnée ACCESS 2000.Je peux parcourir les enregistrements de la tab Conversion image couleur en noir et blanc [ par merlin ] Je cherche a convertir l'image d'un picturebox en couleurs vers une image monochrome, pour ensuite la mettre dans le clipboard (prend moins de place).


Nos sponsors

Sondage...

CalendriCode

Janvier 2009
LMMJVSD
   1234
567891011
12131415161718
19202122232425
262728293031 

Consulter la suite du CalendriCode

Téléchargements

Logiciels à télécharger sur le même thème :



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel BAÏSE, Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,390 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.