Classe pour gérer les couleurs hexadecimales

Soyez le premier à donner votre avis sur cette source.

Vue 5 495 fois - Téléchargée 190 fois

Description

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.

Codes Sources

A voir également

Ajouter un commentaire

Commentaire

cs_iPol
Messages postés
27
Date d'inscription
jeudi 4 février 2010
Statut
Membre
Dernière intervention
3 juin 2010
-
il manque un truck du genre:

If Len(SString) 4 Then SString SString & "000"
If Len(SString) 5 Then SString SString & "00"
If Len(SString) 6 Then SString SString & "0"

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.