Couleurs hexa ---> couleurs mirc

Commenter

Contenu du snippet

Permet de passer de couleurs au format Hexa au monde limité des 16 couleurs de Mirc

Source / Exemple : 


Type Col_Sep
    red As Integer
    green As Integer
    blue As Integer
End Type

Function GetMIRCcolor(ByVal HexColor As String) As Integer

Dim MircCol() As Long
Dim MircColZ() As String
ReDim MircCol(15)
ReDim MircColZ(15)
                
MircCol(0) = RGB(255, 255, 255)     'blanc
MircCol(1) = RGB(0, 0, 0)           'noir
MircCol(2) = RGB(0, 0, 127)         'bleu marine
MircCol(3) = RGB(0, 127, 0)         'vert
MircCol(4) = RGB(255, 0, 0)         'rouge
MircCol(5) = RGB(127, 0, 0)         'marron
MircCol(6) = RGB(127, 0, 127)       'violet
MircCol(7) = RGB(255, 127, 0)       'orange
MircCol(8) = RGB(255, 255, 0)       'jaune
MircCol(9) = RGB(0, 255, 0)         'vert clair
MircCol(10) = RGB(64, 128, 128)     'vert bleu
MircCol(11) = RGB(0, 255, 255)      'bleu clair
MircCol(12) = RGB(0, 0, 255)        'bleu roi
MircCol(13) = RGB(255, 0, 255)      'rose
MircCol(14) = RGB(92, 92, 92)       'gris
MircCol(15) = RGB(184, 184, 184)    'gris clair

MircColZ(0) = "blanc"
MircColZ(1) = "noir"
MircColZ(2) = "bleu marine"
MircColZ(3) = "vert"
MircColZ(4) = "rouge"
MircColZ(5) = "marron"
MircColZ(6) = "violet"
MircColZ(7) = "orange"
MircColZ(8) = "jaune"
MircColZ(9) = "vert clair"
MircColZ(10) = "vert bleu"
MircColZ(11) = "bleu clair"
MircColZ(12) = "bleu roi"
MircColZ(13) = "rose"
MircColZ(14) = "gris"
MircColZ(15) = "gris clair"

rcoul = CInt("&H" & Mid(HexColor, 1, 2))
gcoul = CInt("&H" & Mid(HexColor, 3, 2))
bcoul = CInt("&H" & Mid(HexColor, 5, 2))

bestmirccoul = -1
bestdistance = 0

For I = 0 To 15

 distance = ((rcoul - SepareColor(MircCol(I)).red) ^ 2 + _
            (gcoul - SepareColor(MircCol(I)).green) ^ 2 + _
            (bcoul - SepareColor(MircCol(I)).blue) ^ 2) ^ (1 / 2)
 If bestmirccoul < 0 Or distance < bestdistance Then
  bestdistance = distance
  bestmirccoul = I
 End If
Next I

GetMIRCcolor = bestmirccoul

Debug.Print "la couleur mirc correspondante a " & HexColor & " est " & MircColZ(bestmirccoul) & " de distance " & bestdistance

End Function

Function SepareColor(ByVal ColRGB As Long) As Col_Sep

With SepareColor
    .red = Int(ColRGB And &HFF)
    .green = Int((ColRGB And &H100FF00) / &H100)
    .blue = Int((ColRGB And &HFF0000) / &H10000)
End With

End Function

Conclusion :


ce n'est pas le meilleur code du monde (c'est sur) mais il m'est utile, si vous trouvez des pistes d'améliorations ça m'intéresse.

merci à max12 pour sa fonction separecolor pour isoler les composantes RGB
merci à psiman pour son aide

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 (erreurs404)