1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
| Subroutine DISTANCE_CIEDE2000_LAB( cLAB1 As t_LAB, cLAB2 As t_LAB ) Double
Dim Dist As Double
Dim DE As Double
Dim L1, a1, b1, L2, a2, b2 As Double
Dim kL, kC, kH As Double
Dim K1, K2 As Double
Dim SL, SC, SH As Double
Dim ap1, ap2, bp1, bp2 As Double
Dim C, C1, C2, Cp, Cp1, Cp2 As Double
Dim G As Double
Dim Lp, Hp As Double
Dim hp1, hp2 As Double
Dim DLp, DCp, Dhp, DGHp As Double
Dim DTheta, RC, RT As Double
Dim T, F As Double
Dim cLAB As t_LAB
kL = 1
kC = 1
kH = 1
K1 = 0.045
K2 = 0.015
L1 = cLAB1.L
a1 = cLAB1.A
b1 = cLAB1.B
bp1 = b1
L2 = cLAB2.L
a2= cLAB2.A
b2 = cLAB2.B
bp2 = b2
C1 = Sqrt( a1^2 + b1^2 )
C2 = Sqrt( a2^2 + b2^2 )
DLp = L2 - L1
Lp = (L1+L2)/2
C = (C1+C2)/2
G = (1/2)*( 1 - Sqrt( (C^7)/(C^7+25^7) ) )
ap1 = a1*( 1 + G )
ap2 = a2*( 1 + G )
Cp1 = Sqrt( ap1^2 + b1^2)
Cp2 = Sqrt( ap2^2 + b2^2)
Cp = (Cp1+Cp2)/2
DCp = Abs(Cp2 - Cp1)
if bp1 > 0 Then
hp1 = aTan2(bp1, ap1)*180/Pi
else
hp1 = aTan2(bp1, ap1)*180/Pi + 360
end if
if bp2 > 0 Then
hp2 = aTan2(bp2, ap2)*180/Pi
else
hp2 = aTan2(bp2, ap2)*180/Pi + 360
end if
if Abs(hp1 - hp2) > 180 Then
Hp = (hp1 + hp2 - 360)/2
else
Hp = (hp1 + hp2)/2
end if
T = 1 - 0.17*Cos( (Hp - 30)*Pi/180 ) + 0.24*Cos( 2*Hp*Pi/180 ) + 0.32*Cos( (3*Hp + 6)*Pi/180 ) - 0.2*Cos( (4*Hp - 63)*Pi/180 )
if Abs(hp2 - hp1) <= 180 Then
Dhp = Abs(hp2 - hp1)
elseif hp2 - hp1 > 180 AND hp2 <= hp1 Then
Dhp = hp2 - hp1 + 360
else
Dhp = hp2 - hp1 - 360
end if
DGHp = 2*Sqrt(Cp1*Cp2)*Sin(Pi*Dhp/180/2)
SL = 1 + 0.015*( (Lp - 50)^2 ) / Sqrt( 20 + (Lp - 50)^2 )
SC = 1 + 0.045*Cp
SH = 1 + 0.015*Cp*T
DTheta = 30*Exp( -((Hp - 275)/25)^2 ) // !!! 60° dans Wikipedia!
RC = 2*Sqrt( (Cp^7)/ (Cp^7 + 25^7) )
RT = -Sin( 2*DTHeta*Pi/180 )*RC
DE = Sqrt( (DLp/(kL*SL))^2 + (DCp/(kC*SC))^2 + (DGHp/(kH*SH))^2 + RT*(DCp/(kC*SC))*DGHp/(kH*SH) )
Dist = DE
Return Dist
EndSub |
Partager