About the Chromaticity Diagram

The coordinates x, y and z are called the chromaticity coordinates. These are related to x_bar, y_bar and z_bar which are called the spectral tristimulus values (or color matching functions) chosen by the CIE for reasons of convenience in colorimetric computations. R, G and B are the red, green and blue tristimulus values. These three sets of three values (or functions) are all related by matix operations.

Basic Code


Translated by William Lowerre
 
Sub drawmap()
Dim slope As Single, s1 As Single, s2 As Single, t1 As Single, t2 As Single, zr As Single
Dim zg As Single, zb As Single, zw As Single, xw As Single, yw As Single
Dim xr As Single, yr As Single, xb As Single, yb As Single, xg As Single, yg As Single
Dim rmax As Single
Dim m, n, l
Dim ICV(800, 800, 3)
Dim gam
Dim ii, jj, kk, j
Dim i1
Dim i2
Dim j1
Dim j2
Dim stepper
Dim stepperj
Dim s
Dim jtest
Dim itest
Dim i
Dim r As Single, g As Single, b As Single, xc As Single, yc As Single, zc As Single
'      Chromaticity Coodinates (x and y) for wavelenghts in 5 nm
'      increments from 380 nm to 780 nm.
 
    Dim wXY(1 To 2, 1 To 82) As Single
    
     wXY(1, 1) = 0.1741
     wXY(2, 1) = 0.005
     
     wXY(1, 2) = 0.174
     wXY(2, 2) = 0.005
     wXY(1, 3) = 0.1738
     wXY(2, 3) = 0.0049
     wXY(1, 4) = 0.1736
     wXY(2, 4) = 0.0049
     wXY(1, 5) = 0.1733
     wXY(2, 5) = 0.0048
     wXY(1, 6) = 0.173
     wXY(2, 6) = 0.0048
     wXY(1, 7) = 0.1726
     wXY(2, 7) = 0.0048
     wXY(1, 8) = 0.1721
     wXY(2, 8) = 0.0048
     wXY(1, 9) = 0.1714
     wXY(2, 9) = 0.0051
     wXY(1, 10) = 0.1703
     wXY(2, 10) = 0.0058
     wXY(1, 11) = 0.1689
     wXY(2, 11) = 0.0069
     wXY(1, 12) = 0.1669
     wXY(2, 12) = 0.0086
     wXY(1, 13) = 0.1644
     wXY(2, 13) = 0.0109
     wXY(1, 14) = 0.1611
     wXY(2, 14) = 0.0138
     wXY(1, 15) = 0.1566
     wXY(2, 15) = 0.0177
     wXY(1, 16) = 0.151
     wXY(2, 16) = 0.0227
     wXY(1, 17) = 0.144
     wXY(2, 17) = 0.0297
     wXY(1, 18) = 0.1355
     wXY(2, 18) = 0.0399
     wXY(1, 19) = 0.1241
     wXY(2, 19) = 0.0578
     wXY(1, 20) = 0.1096
     wXY(2, 20) = 0.0868
     wXY(1, 21) = 0.0913
     wXY(2, 21) = 0.1327
     wXY(1, 22) = 0.0687
     wXY(2, 22) = 0.2007
     wXY(1, 23) = 0.0454
     wXY(2, 23) = 0.295
          
     wXY(1, 24) = 0.0235
     wXY(2, 24) = 0.4127
     
wXY(1, 25) = 0.0082
wXY(2, 25) = 0.5384
     wXY(1, 26) = 0.0039
     wXY(2, 26) = 0.6548
     wXY(1, 27) = 0.0139
     wXY(2, 27) = 0.7502
     wXY(1, 28) = 0.0389
     wXY(2, 28) = 0.812
     wXY(1, 29) = 0.0743
     wXY(2, 29) = 0.8338
     wXY(1, 30) = 0.1142
     wXY(2, 30) = 0.8262
     wXY(1, 31) = 0.1547
     wXY(2, 31) = 0.8059
     wXY(1, 32) = 0.1929
     wXY(2, 32) = 0.7816
     wXY(1, 33) = 0.2296
     wXY(2, 33) = 0.7543
     wXY(1, 34) = 0.2658
     wXY(2, 34) = 0.7243
     wXY(1, 35) = 0.3016
     wXY(2, 35) = 0.6923
     wXY(1, 36) = 0.3373
     wXY(2, 36) = 0.6589
     wXY(1, 37) = 0.3731
     wXY(2, 37) = 0.6245
     wXY(1, 38) = 0.4087
     wXY(2, 38) = 0.5896
     wXY(1, 39) = 0.4441
     wXY(2, 39) = 0.5547
     wXY(1, 40) = 0.4788
     wXY(2, 40) = 0.5202
     wXY(1, 41) = 0.5125
     wXY(2, 41) = 0.4866
     wXY(1, 42) = 0.5448
     wXY(2, 42) = 0.4544
     wXY(1, 43) = 0.5752
     wXY(2, 43) = 0.4242
     wXY(1, 44) = 0.6029
     wXY(2, 44) = 0.3965
     wXY(1, 45) = 0.627
     wXY(2, 45) = 0.3725
     wXY(1, 46) = 0.6482
     wXY(2, 46) = 0.3514
     wXY(1, 47) = 0.6658
     wXY(2, 47) = 0.334
     wXY(1, 48) = 0.6801
     wXY(2, 48) = 0.3197
     wXY(1, 49) = 0.6915
     wXY(2, 49) = 0.3083
     wXY(1, 50) = 0.7006
     wXY(2, 50) = 0.2993
     wXY(1, 51) = 0.7079
     wXY(2, 51) = 0.292
     wXY(1, 52) = 0.714
     wXY(2, 52) = 0.2859
     wXY(1, 53) = 0.719
     wXY(2, 53) = 0.2809
     wXY(1, 54) = 0.723
     wXY(2, 54) = 0.277
     wXY(1, 55) = 0.726
     wXY(2, 55) = 0.274
     wXY(1, 56) = 0.7283
     wXY(2, 56) = 0.2717
     wXY(1, 57) = 0.73
     wXY(2, 57) = 0.27
     wXY(1, 58) = 0.7311
     wXY(2, 58) = 0.2689
     wXY(1, 59) = 0.732
     wXY(2, 59) = 0.268
     wXY(1, 60) = 0.7327
     wXY(2, 60) = 0.2673
     wXY(1, 61) = 0.7334
     wXY(2, 61) = 0.2666
     wXY(1, 62) = 0.734
     wXY(2, 62) = 0.266
     wXY(1, 63) = 0.7344
     wXY(2, 63) = 0.2656
     wXY(1, 64) = 0.7346
     wXY(2, 64) = 0.2654
     wXY(1, 65) = 0.7347
     wXY(2, 65) = 0.2653
     wXY(1, 66) = 0.7347
     wXY(2, 66) = 0.2653
     wXY(1, 67) = 0.7347
     wXY(2, 67) = 0.2653
     wXY(1, 68) = 0.7347
     wXY(2, 68) = 0.2653
     wXY(1, 69) = 0.7347
     wXY(2, 69) = 0.2653
     wXY(1, 70) = 0.7347
     wXY(2, 70) = 0.2653
     wXY(1, 71) = 0.7347
     wXY(2, 71) = 0.2653
     wXY(1, 72) = 0.7347
     wXY(2, 72) = 0.2653
     wXY(1, 73) = 0.7347
     wXY(2, 73) = 0.2653
     wXY(1, 74) = 0.7347
     wXY(2, 74) = 0.2653
     wXY(1, 75) = 0.7347
     wXY(2, 75) = 0.2653
     wXY(1, 76) = 0.7347
     wXY(2, 76) = 0.2653
     wXY(1, 77) = 0.7347
     wXY(2, 77) = 0.2653
     wXY(1, 78) = 0.7347
     wXY(2, 78) = 0.2653
     wXY(1, 79) = 0.7347
     wXY(2, 79) = 0.2653
     wXY(1, 80) = 0.7347
     wXY(2, 80) = 0.2653
     wXY(1, 81) = 0.7347
     wXY(2, 81) = 0.2653
 
       wXY(1, 82) = wXY(1, 1)
       wXY(2, 82) = wXY(2, 1)
'c
'c      Chromaticity Coordinates for Red, Green, Blue and White
'c
       xr = 0.64
       yr = 0.33
       xg = 0.29
       yg = 0.6
       xb = 0.15
       yb = 0.06
       xw = 0.3127
       yw = 0.3291
       zr = 1 - (xr + yr)
       zg = 1 - (xg + yg)
       zb = 1 - (xb + yb)
       zw = 1 - (xw + yw)
       
       m = 300
       n = m
       
       l = 255
       gam = 0.8
       gam = Val(Text6.Text)
'c
'c      Draw tongue outline
'c
 

       For ii = 1 To m
        For jj = 1 To n
         For kk = 1 To 3
           ICV(ii, jj, kk) = 0
         Next
        Next
       Next
On Error Resume Next
       For j = 1 To 81
       
         s1 = (m) * wXY(1, j)
         s2 = (m) * wXY(1, j + 1)
         t1 = (n) * (1 - wXY(2, j))
         t2 = (n) * (1 - wXY(2, j + 1))
         slope = (t2 - t1) / (s2 - s1)
         i1 = Int(s1)
         i2 = Int(s2)
         stepper = 1
         If (i2 < i1) Then stepper = -1
         For ii = i1 To i2 Step stepper
         
          s = (ii)
          j1 = j2
          j2 = Int(t1 + slope * (s - s1))
          If ((j1 <> 0) And (j2 <> 0)) Then
          stepperj = 1
          If j2 < j1 Then stepperj = -1
           For jj = j1 To j2 Step stepperj
            For kk = 1 To 3
             ICV(ii, jj, kk) = 1
            Next
'Picturergb.PSet (ii * 2, jj * 2), RGB(255, 255, 255)
         
           Next
          End If
         Next
       Next
       
'MsgBox ("")
'c      Calculate RGB Values for x and y coordinates
'c
       For j = 1 To n
        jtest = 0
        For i = 1 To m
         If ((ICV(i, j, 1) = 1) And (ICV(i + 1, j, 1) = 0)) Then jtest = jtest + 1
         
        Next
        If (jtest = 2) Then
        itest = 0
        For i = 1 To m
         If ((ICV(i, j, 1) = 1) And (ICV(i + 1, j, 1) = 0)) Then itest = itest + 1
         
         If (itest = 1) Then
         xc = i / m
         yc = 1 - (j / n)
         
         zc = 1 - (xc + yc)
         r = XYZTOR(xr, yr, zr, xg, yg, zg, xb, yb, zb, xc, yc, zc, r, g, b)
         g = XYZTOg(xr, yr, zr, xg, yg, zg, xb, yb, zb, xc, yc, zc, r, g, b)
         b = XYZTOb(xr, yr, zr, xg, yg, zg, xb, yb, zb, xc, yc, zc, r, g, b)
         
         rmax = 0.000001
         If (r > rmax) Then rmax = r
         If (g > rmax) Then rmax = g
         If (b > rmax) Then rmax = b
         'ICV(i, j, 1) = Int((l) * (r / rmax))
         'ICV(i, j, 2) = Int((l) * (g / rmax))
         'ICV(i, j, 3) = Int((l) * (b / rmax))
         r = Int(255 * ((r / rmax) ^ gam))
         g = Int(255 * ((g / rmax) ^ gam))
         b = Int(255 * ((b / rmax) ^ gam))
         
                 Picturergb.PSet (i, j), RGB(r, g, b)
                 'Picturergb.PSet (i * 2 + 1, j * 2), RGB(r, g, b)
                 'Picturergb.PSet (i * 2, j * 2 + 1), RGB(r, g, b)
                 'Picturergb.PSet (i * 2 + 1, j * 2 + 1), RGB(r, g, b)
      
         End If
        Next
        
        End If
       Next
       'Picturergb.Refresh
End Sub
Function XYZTOR(xr As Single, yr As Single, zr As Single, xg As Single, yg As Single, zg As Single, xb As Single, yb As Single, zb As Single, xc As Single, yc As Single, zc As Single, r As Single, g As Single, b As Single) As Single
      
       r = (-(xg * yc * zb) + (xc * yg * zb) + (xg * yb * zc) - (xb * yg * zc) - (xc * yb * zg) + (xb * yc * zg)) / ((xr * yg * zb) - (xg * yr * zb) - (xr * yb * zg) + (xb * yr * zg) + (xg * yb * zr) - (xb * yg * zr))
    '   g = (xr * yc * zb - xc * yr * zb - xr * yb * zc + xb * yr * zc + xc * yb * zr - xb * yc * zr) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
     '  b = (xr * yg * zc - xg * yr * zc - xr * yc * zg + xc * yr * zg + xg * yc * zr - xc * yg * zr) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
             
       If (r < 0) Then r = 0
'       If (g < 0) Then g = 0
 '      If (b < 0) Then b = 0
       If (r > 1) Then r = 1
  '     If (g > 1) Then g = 1
   '    If (b > 1) Then b = 1
 
XYZTOR = r
End Function
Function XYZTOg(xr As Single, yr As Single, zr As Single, xg As Single, yg As Single, zg As Single, xb As Single, yb As Single, zb As Single, xc As Single, yc As Single, zc As Single, r As Single, g As Single, b As Single) As Single
      
  '     r = (-xg * yc * zb + xc * yg * zb + xg * yb * zc - xb * yg * zc - xc * yb * zg + xb * yc * zg) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
       g = ((xr * yc * zb) - (xc * yr * zb) - (xr * yb * zc) + (xb * yr * zc) + (xc * yb * zr) - (xb * yc * zr)) / ((xr * yg * zb) - (xg * yr * zb) - (xr * yb * zg) + (xb * yr * zg) + (xg * yb * zr) - (xb * yg * zr))
   '    b = (xr * yg * zc - xg * yr * zc - xr * yc * zg + xc * yr * zg + xg * yc * zr - xc * yg * zr) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
    '   If (r < 0) Then r = 0
       If (g < 0) Then g = 0
     '  If (b < 0) Then b = 0
      ' If (r > 1) Then r = 1
       If (g > 1) Then g = 1
       'If (b > 1) Then b = 1
      
XYZTOg = g
End Function
Function XYZTOb(xr As Single, yr As Single, zr As Single, xg As Single, yg As Single, zg As Single, xb As Single, yb As Single, zb As Single, xc As Single, yc As Single, zc As Single, r As Single, g As Single, b As Single) As Single
      
'       r = (-xg * yc * zb + xc * yg * zb + xg * yb * zc - xb * yg * zc - xc * yb * zg + xb * yc * zg) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
 '      g = (xr * yc * zb - xc * yr * zb - xr * yb * zc + xb * yr * zc + xc * yb * zr - xb * yc * zr) / (xr * yg * zb - xg * yr * zb - xr * yb * zg + xb * yr * zg + xg * yb * zr - xb * yg * zr)
       b = ((xr * yg * zc) - (xg * yr * zc) - (xr * yc * zg) + (xc * yr * zg) + (xg * yc * zr) - (xc * yg * zr)) / ((xr * yg * zb) - (xg * yr * zb) - (xr * yb * zg) + (xb * yr * zg) + (xg * yb * zr) - (xb * yg * zr))
       'If (r < 0) Then r = 0
       'If (g < 0) Then g = 0
       If (b < 0) Then b = 0
       'If (r > 1) Then r = 1
       'If (g > 1) Then g = 1
       If (b > 1) Then b = 1
      
XYZTOb = b
End Function