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