Create a new project, create a button named cmdBenchmark, and paste:
Problem: DeltaE(computes the distance between two RGBs) is too slow.
Ideally, I'd like it to remain accurate, but if the speed increase is significant enough I'd be willing to accept a DeltaE that's precise enough(better than RGB, Lab, or Luv, hopefully!*).
The primary goal is being able to compare near and distance colors in an extremely perceptual manner in an extremely short amount of time.
I don't expect this to be done for me... just throw me some advice if you'd think it'd help! Even if it's an entirely different function, please speak up! Questions and comments are also welcome.
Thanks fellas! :wave:
*Perhaps I just need to weight these better?
Code:
Private Const CIEe As Single = 216! / 24389!
Private Const CIEk As Single = 24389! / 27!
Private Const OneThird As Single = 1! / 3!
Private Const TFP7 As Single = 25! ^ 7!
Private Type tRGB
R As Single
G As Single
B As Single
End Type
Private Type tXYZ
x As Single
Y As Single
Z As Single
End Type
Private Type tLAB
L As Single
A As Single
B As Single
End Type
Private Function LABtoXYZ(inLAB As tLAB) As tXYZ
Dim L As Single, A As Single, B As Single
Dim x As Single, Y As Single, Z As Single
'buffer byref variable
L = inLAB.L
A = inLAB.A
B = inLAB.B
'transform
Y = (L + 16!) / 116!
Z = Y - B / 200!
x = A / 500! + Y
If (Z ^ 3!) > CIEe Then Z = Z ^ 3! Else Z = (116! * Z - 16) / CIEk
If L > (CIEk * CIEe) Then Y = ((L + 16!) / 116!) ^ 3! Else Y = L / CIEk
'If (Y ^ 3!) > CIEe Then Y = Y ^ 3! Else Y = (116! * Y - 16) / CIEk
If (x ^ 3!) > CIEe Then x = x ^ 3! Else x = (116! * x - 16) / CIEk
'scale to reference white
LABtoXYZ.x = x * 96.422!
LABtoXYZ.Y = Y * 100!
LABtoXYZ.Z = Z * 82.521!
End Function
Private Function XYZtoLAB(inXYZ As tXYZ) As tLAB
Dim x As Single, Y As Single, Z As Single
'buffer byref variable
x = inXYZ.x
Y = inXYZ.Y
Z = inXYZ.Z
'normalize against reference white D50
x = x / 96.422!
Y = Y / 100!
Z = Z / 82.521!
'transform
If Z > CIEe Then Z = Z ^ OneThird Else Z = (CIEk * Z + 16!) / 116!
If Y > CIEe Then Y = Y ^ OneThird Else Y = (CIEk * Y + 16!) / 116!
If x > CIEe Then x = x ^ OneThird Else x = (CIEk * x + 16!) / 116!
XYZtoLAB.L = (116! * Y) - 16! 'luminance ; 100 = diffuse white
XYZtoLAB.A = 500! * (x - Y) ' - = green; + = magenta(red+blue)
XYZtoLAB.B = 200! * (Y - Z) ' - = blue ; + = yellow(red+green)
End Function
Private Function RGBToXYZ(ByVal RGBValue As Long) As tXYZ
Dim R As Single, G As Single, B As Single
R = (RGBValue And &HFF&) / 255!
G = ((RGBValue And &HFF00&) \ &H100&) / 255!
B = ((RGBValue And &HFF0000) \ &H10000) / 255!
Debug.Print "xyz rgb", R, G, B, Hex(RGBValue)
'gamma/non-linear
If R > 0.04045! Then R = ((R + 0.055!) / 1.055!) ^ 2.4! Else R = R / 12.92!
If G > 0.04045! Then G = ((G + 0.055!) / 1.055!) ^ 2.4! Else G = G / 12.92!
If B > 0.04045! Then B = ((B + 0.055!) / 1.055!) ^ 2.4! Else B = B / 12.92!
'scale
R = R * 100!
G = G * 100!
B = B * 100!
'bradford D50 tristimulus values
RGBToXYZ.x = R * 0.4360747! + G * 0.3850649! + B * 0.1430804!
RGBToXYZ.Y = R * 0.2225045! + G * 0.7168786! + B * 0.0606169!
RGBToXYZ.Z = R * 0.0139322! + G * 0.0971045! + B * 0.7141733!
End Function
Private Function XYZtoRGB(inXYZ As tXYZ) As Long
Dim x As Single, Y As Single, Z As Single
Dim R As Single, G As Single, B As Single
'buffer byref var
x = inXYZ.x / 100!
Y = inXYZ.Y / 100!
Z = inXYZ.Z / 100!
'bradford d50
R = x * 3.133856! + Y * -1.616867! + Z * -0.4906146!
G = x * -0.9787684! + Y * 1.916142! + Z * 0.033454!
B = x * 0.0719453! + Y * -0.2289914! + Z * 1.405243!
If R > 0.0031308! Then R = 1.055! * (R ^ (1! / 2.4!)) - 0.055! Else R = 12.92! * R
If G > 0.0031308! Then G = 1.055! * (G ^ (1! / 2.4!)) - 0.055! Else G = 12.92! * G
If B > 0.0031308! Then B = 1.055! * (B ^ (1! / 2.4!)) - 0.055! Else B = 12.92! * B
'If G < 0 Then G = 0
XYZtoRGB = RGB(R * 255!, G * 255!, B * 255!)
End Function
Private Function RGBtoLAB(ByVal RGBValue As Long) As tLAB
Static Init As Boolean
Static RGB2LABLUT(16777215) As tLAB
If Init = False Then
Dim x As Long
For x = 0& To 16777215
If (x Mod 167772) = 0 Then Form1.Caption = "(1/1) Building RGB to LAB look-up-table " & Round(x / 167772.15, 2) & "%": Form1.Refresh
RGB2LABLUT(x) = XYZtoLAB(RGBToXYZ(x))
Next x
Init = True
Exit Function
End If
RGBtoLAB = RGB2LABLUT(RGBValue)
End Function
Private Sub cmdBenchmark_Click()
Dim x As Long, sTime As Single
sTime = Timer
For x = 0& To 16777215
DeltaE x, &HFFFFFF Xor x
Next x
Form1.Caption = Timer - sTime
End Sub
Private Sub Form_Activate()
Static bInit As Boolean
If bInit = False Then
bint = True
RGBtoLAB 0
End If
End Sub
Private Function DeltaE(ByVal lColor1 As Long, ByVal lColor2 As Long) As Single
'Delta E (CIE 2000)
'http://www.brucelindbloom.com/index.html?Eqn_DeltaE_CIE2000.html
'http://en.wikipedia.org/wiki/Color_difference
Dim tmpXYZ As tXYZ
Dim LAB1 As tLAB, LAB2 As tLAB
Dim lineL As Single, lineC As Single, lineH As Single
Dim C1 As Single, C2 As Single, G As Single
Dim H1 As Single, H2 As Single
Dim deltaH As Single, deltaC As Single
Dim LCP7 As Single
Dim xNt As Long, timeTransform As Double, timeDifference As Double
Dim sngTmp As Single
LAB1 = RGBtoLAB(lColor1)
LAB2 = RGBtoLAB(lColor2)
lineL = ((LAB1.L + LAB2.L) / 2!) - 50!: lineL = lineL * lineL
C1 = Sqr(LAB1.A * LAB1.A + LAB1.B * LAB1.B)
C2 = Sqr(LAB2.A * LAB2.A + LAB2.B * LAB2.B)
lineC = (C1 + C2) / 2!
LCP7 = lineC ^ 7!
G = 1! + (1! - Sqr(LCP7 / (LCP7 + TFP7))) / 2!
LAB1.A = LAB1.A * G
LAB2.A = LAB2.A * G
C1 = Sqr(LAB1.A * LAB1.A + LAB1.B * LAB1.B)
C2 = Sqr(LAB2.A * LAB2.A + LAB2.B * LAB2.B)
lineC = (C1 + C2) / 2!
LCP7 = lineC ^ 7!
H1 = ArcTangent(LAB1.B, LAB1.A)
H2 = ArcTangent(LAB2.B, LAB2.A)
If Abs(H1 - H2) > 180! Then lineH = (H1 + H2 + 360!) / 2! Else lineH = (H1 + H2) / 2!
If Abs(H2 - H1) > 180! Then
If H2 > H1 Then deltaH = H2 - H1 - 360! Else deltaH = H2 - H1 + 360!
Else
deltaH = H2 - H1
End If
deltaH = 2! * Sqr(C1 * C2) * Sin((deltaH / 2!) * FromDeg) * ToDeg
deltaC = (C2 - C1) / (1! + 0.045! * lineC)
deltaH = deltaH / (1! + 0.015! * lineC * (1! - 0.17! * DegCos(lineH - 30!) + 0.24! * DegCos(2! * lineH) + 0.32! * DegCos(3! * lineH + 6!) - 0.2! * DegCos(4! * lineH - 63!)))
DeltaE = Sqr( _
((LAB2.L - LAB1.L) / (1! + (0.015! * lineL) / (Sqr(20! + lineL)))) ^ 2! + _
deltaC * deltaC + deltaH * deltaH + _
(-(2! * Sqr(LCP7 / (LCP7 + TFP7))) * Sin(2! * (30! * Exp(-((lineH - 275!) / 25!) ^ 2!)) * FromDeg) * ToDeg) * deltaC * deltaH)
End FunctionIdeally, I'd like it to remain accurate, but if the speed increase is significant enough I'd be willing to accept a DeltaE that's precise enough(better than RGB, Lab, or Luv, hopefully!*).
The primary goal is being able to compare near and distance colors in an extremely perceptual manner in an extremely short amount of time.
I don't expect this to be done for me... just throw me some advice if you'd think it'd help! Even if it's an entirely different function, please speak up! Questions and comments are also welcome.
Thanks fellas! :wave:
*Perhaps I just need to weight these better?