Who wants to have some fun?

So, I am trying to make a hash function that, given a string will return a unique color. Not a random color, but the same color everytime. I am just hoping to make it hash oddly enough that the colors will be varied. I am using it in a bar graph to color the different bars. With what I have now I am getting shades of red only. Anybody got any ideas to make this hash better?

VB Code:

Private Function ColorHash(ByVal strHashThis As String) As System.Drawing.Color
        Dim x, y, z As Integer
 
 
'122 is ascii value of 'Z'
'57 is number of characters from 'a' to 'Z'
        x = ((122 - Asc(strHashThis.Chars(0))) * 5) + Asc(strHashThis.Chars(strHashThis.Length - 1))
        x = ((122 - Asc(strHashThis.Chars(strHashThis.Length - 1))) * 5) + Asc(strHashThis.Chars(0))
        z = (strHashThis.Length Mod 57) * 5
 
        Return Color.FromArgb(x Mod 255, y Mod 255, z Mod 255)
    End Function

VB Code:

y = ((122 - Asc(strHashThis.Chars(strHashThis.Length - 1))) * 5) + Asc(strHashThis.Chars(0))

Ooops, I changed the second line to y instead of x. Still, though, I'm getting a lot of ugly greens and some strange reds, but not the rainbow of colors I was hoping for. I know I need to research how the number affect the outcome. I probably need to limit the range of my factors greatly, perhaps by modding them by a smaller number. I guess what I would really like is more traditional colors, if possible.

By the way, here are some samples of the strings I am sending to the function:
Art Dept
ASSEMBLE
Assembly
Fabrication
Finish
Manual
Laster
OP-Other

What? Nobody wants to have some fun? You are all a bunch of party poopers.

A good way to do that would be to make a back-loop function (I have one written, but it's at home) and have it cycle through all the letters in the string to find the character value and multiple/add the character PLACE value to it. Then, add them all together and get the first 3 numbers, the next 3 numbers starting from the second number, and so on for the third set.

Then, with the back-loop function (a variation of Mod), add the remainder of thenumber Mod 255 and get the color value.

Hard to explain, but when I get home I'll write a sample for you and see if it works. I'll comment it accordingly, of course.

In any case, it won't generate a random color per-say. If you type in "testing" for the hash string, it will return the same color every time. But if you type in "testign", it will generate a completely different color.

Thats cool. I want it to generate the same color everytime based on what string it is sent.

That's what this will do. Didn't have time to do it when I got home, but I can tonight(hopefully, unless I get dragged out to the bar against my will when I'm sick :sad: ).

This is what I ended up doing. I seems to work well enough.

VB Code:

Private Function WCEfficiencyColorHash(ByVal strHashThis As String) As System.Drawing.Color
        Dim x, y, z, Total As Integer
        x = 0
        For i As Integer = 0 To strHashThis.Length - 1
            x += Asc(strHashThis.Chars(i))
        Next
        y = Math.Abs((strHashThis.Length * x) - Asc(strHashThis.Chars(0)))
        z = x * y
 
        Return Color.FromArgb(x Mod 255, y Mod 255, z Mod 255)

You can use this code (I used a picture box to change the color of, and a textbox to enter the string/color name):

VB Code:

Public Function colorRoundValueRGB(ByVal number As Long) As Long
 
        'Set boundries
        If number < 1 Then Return 1
        If number <= 255 Then Return 255
 
        'Find remaining placement value
        Dim remain As Long = number - (255 * (Math.Floor(number / 255)))
 
        If remain < 1 Then remain = 1
 
        Return remain
 
    End Function
 
    Public Function colorRandomFromString(ByVal str As String) As Color
 
        Dim lng As Long = 1
        Dim r, g, b As Integer
 
        For stp As Integer = 1 To str.Length
            Try
                lng *= CInt(AscW(Mid(str, stp, 1)))
            Catch ex As Exception
                If ex.Message.Contains("overflow") Then
                    lng = 1
                End If
            End Try
        Next
 
        If lng < 99999 Then
            lng += ((99999 - lng) ^ 2)
        End If
 
        r = colorRoundValueRGB(CInt(Mid(CStr(lng), 1, 3)))
        g = colorRoundValueRGB(CInt(Mid(CStr(lng), 2, 3)))
        b = colorRoundValueRGB(CInt(Mid(CStr(lng), 3, 3)))
 
        Return Color.FromArgb(r, g, b)
 
    End Function

Works for me, anyway. Still gets a bit of red and green, but you get a bunch of other colors, too. And it stays the same each time. Funny, this actually made me create a "moduleColor.vb" module. I've been looking for something interesting to try out while waiting for a cooperative project I'm working on to take off. This did it!

And you can use as large or as small of a string as you wish, doesn't really matter. Hence the try / catch.

Pretty interesting fact: I put this code in a timer:

VB Code:

PictureBox1.BackColor = colorRandomFromString(CStr(integerRandomBetween(0, 99999)))

...to generate basically convert a random number between 0 and 99999 to a string, and then generate a color based on that string. It creates a neat little flashy picturebox, lol.

This seems to work pretty good. As with all hash functions, there are collisions (two different things producing the same hash. You'd have to have a hash that contains exactly the same amount of data (or more) as the original string to prevent all collisions.) The fact that I manually set the color to opaque increases the likelihood of a collision.

VB Code:

Public Function ColorFromString(ByVal [String] As String) As Color
        Return Color.FromArgb(255, Color.FromArgb([String].GetHashCode))
    End Function