I stumbled across this nice one:
http://gauth.fr/2011/09/get-a-color-...b-combination/

Very neat indeed :-)
But made in JavaScript, which I know virtual nothing about...

I was wondering, if anyone has made something similar in VBA?
Can it be done?
How?


CE




---
Denne e-mail er fri for virus og malware fordi avast! Antivirus beskyttelse er aktiveret.
http://www.avast.com

I stumbled across this nice one:
http://gauth.fr/2011/09/get-a-color-...b-combination/

Very neat indeed :-)

Yes.., quite impressive to say the least!
But made in JavaScript, which I know virtual nothing about...

I was wondering, if anyone has made something similar in VBA?

Don't know, but maybe Karl Peterson has something you can modify to do
similar.

Can it be done?
How?

Simplest approach:
Parse the file "dataset.js" into columns and use a lookup function to
return a name based on user input. (I'd probably have it work both
ways, meaning user can optionally enter a name and return the RGB
value!)

I see that this file is one continuous string and so may need to be
edited so you can use Split() for each color name value. As is.., you
can parse each piece of color data using "}," as a delimiter to load
your initial array.

After that each element is a comma delimited set of property:value
pairs where you can Split() each part into a temp array, then split
again into a 2nd temp array using ":" as the delimiter. (you only need
to extract the UBound value of this 2nd array)

Once you get there you can decide how to put the table into a
worksheet. I'd probably build an output 2D array in memory, then 'dump'
that into the worksheet (OR a delimited file where I can search for my
RGB values, OR just store the data so it's easily retrievable into a
workable array at runtime)!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I see that this file is one continuous string and so may need to be
edited so you can use Split() for each color name value.

I was referring to the fact the entire string is enclosed in "[]" and
so these should be removed before you Split() the file contents into an
array. You can do so after you copy/paste the file from the website
into a text editor, OR use Replace() to remove them programatically.
Since the contents paste with the carat after the trailing "]" I'd just
backspace it out, Ctrl+Home, delete the leading "[", then save the
file.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Charlotte, try this on the dataset.js file 'as is'...

Option Explicit

Sub ConvertColorData()
Dim vTextIn, v1, v2, vTextOut, sTmp$
Dim n&, k&, i&
sTmp = ReadTextFile("C:\Users\Garry\Documents\VBA_Stuff\d ataset.js")
'Replace "}," with "|" as the line delimiter
sTmp = Replace(sTmp, "},", "|")
'Filter out unwanted characters
vTextIn = Split(FilterString(sTmp, ",:|"), "|")
'Store the data in a normal csv file
WriteTextFile Join(vTextIn, vbLf), _
"C:\Users\Garry\Documents\VBA_Stuff\dataset.tx t"

ReDim vTextOut(1 To UBound(vTextIn) + 1, 1 To 4)
For n = LBound(vTextIn) To UBound(vTextIn)
v1 = Split(vTextIn(n), ",")
For k = LBound(v1) To UBound(v1)
v2 = Split(v1(k), ":")
vTextOut(n + 1, k + 1) = v2(1)
Next 'k
Next 'n
Cells(1, 1).Resize(UBound(vTextOut), UBound(vTextOut, 2)) = vTextOut
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Function FilterString$(ByVal TextIn As String, _
Optional IncludeChars As String, _
Optional IncludeLetters As Boolean = True, _
Optional IncludeNumbers As Boolean = True)
' Filters out all unwanted characters in a string.
' Arguments: TextIn The string being filtered.
' IncludeChars [Optional] Keeps any characters.
' IncludeLetters [Optional] Keeps any letters.
' IncludeNumbers [Optional] Keeps any numbers.
'
' Returns: String containing only the wanted characters.

Const sSource As String = "FilterString()"

'The basic characters to always keep
Const sLetters As String = "abcdefghijklmnopqrstuvwxyz"
Const sNumbers As String = "0123456789"

Dim i As Long, CharsToKeep As String

CharsToKeep = IncludeChars
If IncludeLetters Then _
CharsToKeep = CharsToKeep & sLetters & UCase(sLetters)
If IncludeNumbers Then CharsToKeep = CharsToKeep & sNumbers

For i = 1 To Len(TextIn)
If InStr(CharsToKeep, Mid$(TextIn, i, 1)) Then _
FilterString = FilterString & Mid$(TextIn, i, 1)
Next
End Function 'FilterString()

Sub WriteTextFile(TextOut$, Filename$, Optional AppendMode As Boolean =
False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**
Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Replace this

vTextIn = Split(FilterString(sTmp, ",:|"), "|")

with this

vTextIn = Split(FilterString(sTmp, "," & ":" & "|"), "|")

if your reader shows the ":|" part as a smiley!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Testing another character combo...

vTextIn = Split(FilterString(sTmp, "|,:")

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

A better parse to dataset.txt:

Sub ConvertColorData()
Dim vTextIn, v1, v2, vTextOut, sTmp$
Dim n&, k&, i&
sTmp = ReadTextFile("C:\Users\Garry\Documents\VBA_Stuff\d ataset.js")
'Replace "}," with "|" as the line delimiter
sTmp = Replace(sTmp, "},", "|")
'Filter out unwanted characters
vTextIn = Split(FilterString(sTmp, "|,:"), "|")

ReDim vTextOut(1 To UBound(vTextIn) + 1, 1 To 4)
For n = LBound(vTextIn) To UBound(vTextIn)
v1 = Split(vTextIn(n), ",")
For k = LBound(v1) To UBound(v1)
v2 = Split(v1(k), ":")
vTextOut(n + 1, k + 1) = v2(1)
Next 'k
vTextIn(n) = Join(Application.Index(vTextOut, n + 1, 0), ",")
Next 'n

'Store the data in a normal csv file
WriteTextFile Join(vTextIn, vbLf),
"C:\Users\Garry\Documents\VBA_Stuff\dataset.tx t"

'Create lookup table
Cells(1, 1).Resize(UBound(vTextOut), UBound(vTextOut, 2)) = vTextOut
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Here's a userform I threw together that shows how to use "dataset.txt"

https://app.box.com/s/23yqum8auvzx17h04u4f

Note that the file doesn't contain every possible RGB combination, and
so there's opportunity to add your own names. If interested, I can
import the parsed file into a worksheet and edit the values, then
export it a a csv.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Typos...

Here's a userform I threw together that shows how to use
"dataset.txt"

https://app.box.com/s/23yqum8auvzx17h04u4f

Note that the file doesn't contain every possible RGB combination,

and so there's opportunity to add your own names. If interested, you
can import the parsed file into a worksheet and edit the values, then

export it as a csv.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Here's a userform I threw together that shows how to use
"dataset.txt"

https://app.box.com/s/23yqum8auvzx17h04u4f

Note that the file doesn't contain every possible RGB combination,
and so there's opportunity to add your own names. If interested, I
can import the parsed file into a worksheet and edit the values, then
export it a a csv.

After some thought (and a good night's sleep), I believe the userform
can be easily modified to 'Add' new names and RGB combos to the
"dataset.txt" file so it never actually needs to be loaded into a
worksheet.

I'm not sure what (if any) practical use this has other than say
designing custom paint colors, but it has captured my interest enough
that I started a XLS project named "ColorNameManager" which I will
provide a download link to when it's done to my satisfaction. This will
include a zip file containing the original "dataset.js" file and the
above named workbook in XLS format...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Way to go, Gary, and thank you so much for your effort :-)

I can't wait to see what you come up with :-)

I tried to download your userForm, but couldn't import it, since it seem to
be missing a .FMX file???

I'm currently working on a solution myself, so it'll be interesting to
compare :-)


Regards,

CE


"GS" wrote in message ...
Here's a userform I threw together that shows how to use "dataset.txt"

https://app.box.com/s/23yqum8auvzx17h04u4f

Note that the file doesn't contain every possible RGB combination, and so
there's opportunity to add your own names. If interested, I can import
the parsed file into a worksheet and edit the values, then export it a a
csv.

After some thought (and a good night's sleep), I believe the userform can
be easily modified to 'Add' new names and RGB combos to the "dataset.txt"
file so it never actually needs to be loaded into a worksheet.

I'm not sure what (if any) practical use this has other than say designing
custom paint colors, but it has captured my interest enough that I started
a XLS project named "ColorNameManager" which I will provide a download
link to when it's done to my satisfaction. This will include a zip file
containing the original "dataset.js" file and the above named workbook in
XLS format...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion





---
Denne e-mail er fri for virus og malware fordi avast! Antivirus beskyttelse er aktiveret.
http://www.avast.com

"Charlotte E." wrote in message
I stumbled across this nice one:
http://gauth.fr/2011/09/get-a-color-...b-combination/

Very neat indeed :-)
But made in JavaScript, which I know virtual nothing about...

I was wondering, if anyone has made something similar in VBA?
Can it be done?
How?

I did but it was a long time ago. At the time I couldn't find any examples
had despite extensive searching. Originally it was VBA but I put it in a VB6
ComAddin, a colour match tool as a small feature of a much larger range of
colour related stuff for Excel. Briefly this is "how" to go about it.

First you need a swatch of defined and optionally "named" RGB colours to
match against, your example seems to be using this list of named and defined
colours -

http://gauth.fr/2011/09/get-a-color-...b-combination/

But there are others, not least the well known swatch (1100+ colours) from a
certain print ink producer, or say the 140 named html colours.

The hard bit is to define a virtual "colour space" that reflects the very
different way the human eye perceives colour differences vs the actual RGB
differences. Eg the eye perceives green as occupying a much larger relative
space than its neighbour in the spectrum cyan. There are various example
spaces out there but replicating them is difficult. I gave up and devised my
own colour space as a semi regular 3D space, complex but regular enough to
be defined with an algorithm.

Then map all the colours in the list in the space with XYZ coordinates from
a given reference point, and similar with the RGB you want to match. Finally
the simple bit, calculate all the 3d distances of your colour to match to
each of the mapped swatch colours. The best match is the one with the
shortest distance in the space, though in a large swatch a good idea to
return and rank a few other close matches and let your own eye judge the
best. And that's all there is to it!

Regards,
Peter T

The hard bit is to define a virtual "colour space" that reflects the
very different way the human eye perceives colour differences vs the
actual RGB differences. Eg the eye perceives green as occupying a
much larger relative space than its neighbour in the spectrum cyan.
There are various example spaces out there but replicating them is
difficult. I gave up and devised my own colour space as a semi
regular 3D space, complex but regular enough to be defined with an
algorithm.

Then map all the colours in the list in the space with XYZ
coordinates from a given reference point, and similar with the RGB
you want to match. Finally the simple bit, calculate all the 3d
distances of your colour to match to each of the mapped swatch
colours. The best match is the one with the shortest distance in the
space, though in a large swatch a good idea to return and rank a few
other close matches and let your own eye judge the best. And that's
all there is to it!

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?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

"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

Thanks for providing more detail!

Your project sounds like it was worth the effort you put into it for
its intended purpose. I feel, though, that this goes far beyond
Charlotte's request and so is why I trimmed out 'the fluff'!<g

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

I totally agree!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

"GS" wrote in message
Thanks for providing more detail!

Your project sounds like it was worth the effort you put into it for its
intended purpose. I feel, though, that this goes far beyond Charlotte's
request and so is why I trimmed out 'the fluff'!<g

Yeah I got carried away with the 'proper' way to do it when the simple way
is probably good enough.

Not sure if you tried the example I posted but if you find any differences
in matches with the JavaScript demo it's because it matches against about
100 additional colours not in the list I referred to.

As for 'it's intended purpose', it's main features worked with the old 56
colour palette in I think novel ways but when 2007 arrived...!

Regards,
Peter T