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

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_lbs)