Cette classe est la reproduction d'un morceau de code que j'ai fait en Objective-C afin de faire des convertions de couleurs de leur format hexadécimal utilisé en HTML vers le RVB, et inversement.
La classe permet également d'utiliser les couleurs 'VB' qui sont sous forme de long pour les conversions.
Source / Exemple :
' Version 1.0 - 20020415
' Romuald Brunet
Option Explicit
' Composantes internes de la couleur
Private redValue As Integer
Private greenValue As Integer
Private blueValue As Integer
' Composante rouge en lecture
Public Property Get red() As Integer
red = redValue
End Property
' Composante verte en lecture
Public Property Get green() As Integer
green = greenValue
End Property
' Composante bleue en lecture
Public Property Get blue() As Integer
blue = blueValue
End Property
' Composante rouge en écriture
Public Property Let red(ByVal newValue As Integer)
redValue = newValue
End Property
' Composante verte en écriture
Public Property Let green(ByVal newValue As Integer)
greenValue = newValue
End Property
' Composante bleue en écriture
Public Property Let blue(ByVal newValue As Integer)
blueValue = newValue
End Property
' Couleur "VB" en lecture
Public Property Get vbColor() As Long
vbColor = RGB(redValue, greenValue, blueValue)
End Property
' Couleur "VB" en écriture
Public Property Let vbColor(ByVal color As Long)
blueValue = Fix(color / 65536)
color = color - CLng(blueValue) * 65536
greenValue = Fix(color / 256)
redValue = color - CLng(greenValue) * 256
End Property
' Valeur hexadécimale en lecture
Public Property Get hexa() As String
Dim r, g, b As String
' Pour chaque composante on fait en sorte que la valeur hexa comporte deux "lettres"
r = Hex(redValue)
If Len(r) = 1 Then r = "0" + r
g = Hex(greenValue)
If Len(g) = 1 Then g = "0" + g
b = Hex(blueValue)
If Len(b) = 1 Then b = "0" + b
' Et on retourne la valeur précédée d'un #
hexa = "#" + r + g + b
End Property
' Valeur hexadécimale en écriture
' Attention il n'y a qu'une simple vérification sur la longueur de faite
Public Property Let hexa(ByVal sString As String)
Dim startIndex, color As Long
' Si le texte commence par # le "range" du texte à convertir n'est pas le même
startIndex = 0
If Len(sString) > 1 Then
If Mid(sString, 1, 1) = "#" Then startIndex = 1
Else
Exit Property
End If
' Longueur exacte à avoir selon qu'on a le # ou pas
If Len(sString) - startIndex <> 6 Then
Exit Property
End If
sString = LCase(sString) ' on met en minuscules
' Puis on récuppere chaque valeur
redValue = hexaVal(Mid(sString, 1 + startIndex, 2))
greenValue = hexaVal(Mid(sString, 3 + startIndex, 2))
blueValue = hexaVal(Mid(sString, 5 + startIndex, 2))
End Property
' Longeur de sString = 2 caractères
' Retourne la valeur hexadécimale sur 2 caractères (FA, 38, ...)
Private Function hexaVal(sString As String) As Integer
Dim i, c As Integer
hexaVal = 0
For i = 1 To 2
c = Asc(Mid(sString, i, 1))
If c > 47 And c < 58 Then c = c - 48 ' chiffres
If c > 96 And c < 103 Then c = c - 87 ' lettres (minuscules)
hexaVal = hexaVal + c * pow(16, 2 - i)
Next
End Function
' Dommage j'ai pas trouvé l'équivalent en VB donc je l'ai refaite :o)
Private Function pow(ByVal number As Long, ByVal power As Integer) As Long
Dim i As Integer
pow = 1
For i = 0 To power - 1
pow = pow * number
Next
End Function
Conclusion :
Voilà. Le code de la classe se trouve également dans le ZIP.
N'hésitez pas à apporter vos commentaires.