Spanish Recurso, convertir palabra string a color RGB, manteniendo paridad de palabra=color / GetColorForWord

[alangonzalez91]

Buenas, comparto estas funciones que convierten string a color RGB. Lo que posibilita dar colores únicos a palabras, y siempre que se ingrese esa palabra o string dará el color correspondiente a esa palabra, lo que elimina la necesidad de almacenar el RGB correspondiente ya que la misma se obtiene con un calculo numérico. Util para colorear Tags o Etiquetas o Nombres.

'Palabra a RGB
Sub GetColorForWord(word As String) As Int
    Dim hash As Int
    hash = CalculateHash(word)
    
    ' Convierte el hash en un color RGB
    Dim red As Int
    Dim green As Int
    Dim blue As Int

    red = hash * 7 Mod 1000
        If red < 0 Then
            red = red * -1           
        End If
        Do While red > 160
            red = red / 2
        Loop
    green = hash * 2 / 10 Mod 1000
        If green < 0 Then
            green = green * -1           
        End If
        Do While green > 160
            green = green / 2
        Loop
    blue = hash * 35 / 100 Mod 1000
        If blue < 0 Then
            blue = blue * -1           
        End If
        Do While blue > 160
            blue = blue / 2
        Loop
    Return Colors.RGB(red, green, blue)
End Sub

Sub CalculateHash(input As String) As Int
    Dim hash As Int
    hash = 0
    Dim caracter As Char
    For i = 1 To input.Length - 1
        caracter = input.CharAt(i)
        hash = hash + Asc(caracter)
    Next
    hash = hash * 5337
    Return hash
End Sub

.
Saludos. Bendecido día!

 

[alangonzalez91]

Modo de uso:

nombre_apellido_Label.Color = GetColorForWord("Juan Carlos") '<-- Ingresas cualquier string

categoria_producto_Label.Color = GetColorForWord("Comestibles") '<-- Ingresas cualquier string

ultimo_usuario_mdoficiacion_Label.Color = GetColorForWord(ultimo_usuario_campo_tabla_registros) '<-- Ingresas cualquier string u objeto string