CLASSE POUR GÉRER LES COULEURS HEXADECIMALES

' 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