View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
Peter T[_7_] Peter T[_7_] is offline
external usenet poster
 
Posts: 162
Default Get a color name from any RGB combination?


"GS" wrote in message
Hi Peter,

What purpose is a "virtual color space"? What purpose does the "xyz"
assignments serve?

VB's RGB() function only requires the 3 RGB values, and so I don't get the
need for all the extra 'fluff' if using that function to define/name
colors derived from RGB values. Am I missing something?


Hi Garry,

You can't imagine how effort much went into developing what I described and
you call fluff <g.
But actually you're right, or rather we both are, it depends. With a
relatively small number of well separated colours to match against a simple
RGB 'distance' comparison is probably fine, and (from a quick look) that's
what the JavaScript example is based on. However for closer matching,
particularly with a larger number of less different colours, a colour space
that reflects the way the human eye differentiates colours is a better
albeit more complicated approach.

Try this to replicate the JavaScript demo: copy the whole page I referred to
last time to Sheet1. Clear the top two rows and you should have three
columns of colours with their definitions. Run the following to split names
& web-hex colours into cols A & B (I ended up with #100c08 in B4)

Sub abc()
Dim pos As Long
Dim rng As Range, c As Range
Set rng = Range("a2:a690")
For Each c In rng
If Len(c) Then
pos = InStrRev(c, "#")
If pos Then
c.Offset(0, 1) = Mid(c, pos, 7)
c = Left(c, pos - 1)
End If
End If
Next
End Sub

The following makes 100 random colours and returns the best "linear" match
for each

Sub test_match()
Dim rx&, gx&, bx&, clrX&
Dim ra&, ga&, ba&, clrA&
Dim dist As Double, minDist As Double
Dim lBestMatch As Long, rBestCell As Range
Dim sHex As String
Dim c1 As Range, c2 As Range
Dim cClr2Match As Range

For Each c1 In Range("f3:f102")
clrA = Int(Rnd() * vbWhite)
c1.Value = clrA
c1.Interior.Color = clrA
getRGB clrA, ra, ga, ba

minDist = vbWhite
For Each c2 In Worksheets("Sheet1").Range("b2:B690")
sHex = c2
If Len(sHex) Then
If Left(sHex, 1) = "#" Then
getRGBfromHEX sHex, clrX, rx, gx, bx
dist = ((ra - rx) ^ 2 + (ga - gx) ^ 2 + (ba - bx) ^ 2) ^
0.5
If dist < minDist Then
minDist = dist
lBestMatch = clrX
Set rBestCell = c2
End If
End If
End If
Next
With c1.Offset(, 1)
.Value = rBestCell & " " & lBestMatch
.Interior.Color = lBestMatch
End With
Next
End Sub

When done should see a list of 100 random colours in col-F and the best
matched in col-G.

FWIW there's a lot more to colour than meets the eye!

Regards,
Peter T