Closest Color Match

[SMcNeill]

This here is one of those tools that was so damn simple to make, and one which I think I could've used a bazillion times in the past.  I have to wonder why the heck I haven't made something like this earlier.  GAHHH!!! 

Anywho, here is the amazing color matcher!

Code: (Select All)

_Title "Steve's Color Match Tool"

Screen _NewImage(800, 800, 32)

Randomize Timer



Open "Color Name Large List.txt" For Binary As #1

Do Until EOF(1)

    Line Input #1, junk$ 'just to count lines

    total = total + 1

Loop



Close: Open "Color Name Large List.txt" For Input As #1



Dim Names(total) As String, Kolors(total) As _Unsigned Long

Dim test As _Unsigned Long



For i = 1 To total

    Input #1, Names(i), r, g, b, a

    Kolors(i) = _RGBA32(r, g, b, a)

Next



Print "Matching against "; total; "colors in list."

For i = 1 To 10

    test = _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)

    closest = ClosestColorIndex(test, Kolors())

    Print Names(closest); " is the closest match", "("; _Red32(test); ","; _Green32(test); ","; _Blue32(test); ")", "("; _Red32(Kolors(closest)); ","; _Green32(Kolors(closest)); ","; _Blue32(Kolors(closest)); ")"

    Line (100, 150 + 50 * i)-Step(100, 50), test, BF

    Line (220, 150 + 50 * i)-Step(100, 50), Kolors(closest), BF

Next



Function ClosestColorIndex& (targetColor As _Unsigned Long, Pal() As _Unsigned Long)

    Dim As Long tr, tg, tb, colors, bestdist

    Dim As Long bestIndex, dr, dg, db, i, dist

    Dim As _Unsigned Long c



    tr = _Red32(targetColor): tg = _Green32(targetColor): tb = _Blue32(targetColor):

    colors = UBound(Pal): bestdist = _LONG_MAX



    $Checking:Off

    While i < colors

        c = Pal(i)

        dr = tr - _Red32(c)

        dg = tg - _Green32(c)

        db = tb - _Blue32(c)

        dist = dr * dr + dg * dg + db * db

        If dist < bestdist Then

            If dist = 0 Then ClosestColorIndex = i: Exit Function

            bestdist = dist: bestIndex = i

        End If

        i = i + 1

    Wend

    $Checking:On

    ClosestColorIndex = bestIndex

End Function

As you can see, this chooses 10 random colors from us.
Then it runs those 10 random colors against the list of 270 colors which are our color constants.
Then it tells you which of the color constants are the closest match to your specific color.

Then it draws you a box so you can compare with your own eyes how close the match is to the original color.

And I'll let the results speak for themselves!

---

Edit:  Updated to optomize with the changes as suggested below.
Edit:  Also updated to use STxATxIC's large list of gathered colored names from across the interweb.  It's almost 10,000 names in the list so it's pretty comprehensive and does a good job at matching colors extremely closely to one of these many given names.

[Pete]

I thought you did make this, or something very similar, a couple of years back.

Pete

[SMcNeill]

I thought you did make this, or something very similar, a couple of years back.

Pete

Well, I has...  but finding the damn thing after the old forums crashed and I've swapped out drives and replaced laptops...   It's gone and lost and GAH!!  I probably haven't had it since I shared something similar to it here all those years ago.  

I think what you're thinking of is the 32-bit color to 256 color convertor which basically does this to try and make a 32-bit color image display best on a 256 color palette.  This is very similar to that, except it just asks for a single color and then finds the best match in an array of colors (Palette) and tells you which one is the closest match.

The one does the whole palette, this lets you look for individual matches as you see fit. 

[Pete]

Or... Maybe this thread: https://qb64phoenix.com/forum/showthread...0#pid31620

That's not a matcher
It's a picker
An A.S.C.II kicker
It picks out colors when it's run...

[a740g]

I was improving the 8bpp dithering code last week after the discussion with Tony on Discord and I ended up writing a similar color matching function in C. I did some tiny optimization in my code. You can exit the loop early if dist = 0. That would mean an exact match, and we do not need to continue the search. Also, the target color components can be split outside the loop.

Code: (Select All)

FUNCTION ClosestColorIndex& (targetColor AS _UNSIGNED LONG, Pal() AS _UNSIGNED LONG, numColors AS LONG)

    DIM tr AS LONG: tr = _RED32(targetColor)

    DIM tg AS LONG: tg = _GREEN32(targetColor)

    DIM tb AS LONG: tb = _BLUE32(targetColor)

    DIM bestDist AS _UNSIGNED LONG: bestDist = _ULONG_MAX

    DIM colors AS LONG: colors = _IIF(numColors > 0, numColors, UBOUND(Pal) + 1)



    DIM AS LONG bestIndex, dr, dg, db, i

    DIM AS _UNSIGNED LONG dist, c



    WHILE i < colors

        c = Pal(i)



        dr = tr - _RED32(c)

        dg = tg - _GREEN32(c)

        db = tb - _BLUE32(c)



        dist = dr * dr + dg * dg + db * db



        IF dist < bestDist THEN

            IF dist = 0 THEN

                ClosestColorIndex = i

                EXIT FUNCTION

            END IF



            bestDist = dist

            bestIndex = i

        END IF



        i = i + 1

    WEND



    ClosestColorIndex = bestIndex

END FUNCTION

[SMcNeill]

Updated with changes suggested by @a740g
Also uploaded STxATxIC's collected list of color names and values from across the web.  Close to 10,000 color names to compare against to find the one closest to a suitable match for whatever color value you might compare it against.