Add L*a*b CTS (3).

Units/MMLCore/colour_conv.pas

@@ -48,7 +48,8 @@ procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
 function XYZToColor(X, Y, Z: Extended): TColor; inline;
 function HSLToColor(H, S, L: Extended): TColor; inline;
 function BGRToRGB(BGR : TRGB32) : TColor;inline;
-
+procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended);
+procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended);
 
 
 implementation
@@ -336,4 +337,53 @@ begin
   Result := RGBToColor(r, g, b);
 end;
 
+procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended);
+begin
+  X := X / 95.047;
+  Y := Y / 100.000;
+  Z := Z / 108.883;
+
+  if ( X > 0.008856 ) then
+    X := Power(X, 1.0/3.0)
+  else
+    X := ( 7.787 * X ) + ( 16.0 / 116.0 );
+  if ( Y > 0.008856 ) then
+    Y := Power(Y, 1.0/3.0)
+  else
+    Y := ( 7.787 * Y ) + ( 16.0 / 116.0 );
+  if ( Z > 0.008856 ) then
+    Z := Power(Z, 1.0/3.0)
+  else
+    Z := ( 7.787 * Z ) + ( 16.0 / 116.0 );
+
+  L := (116.0 * Y ) - 16.0;
+  a := 500.0 * ( X - Y );
+  b := 200.0 * ( Y - Z );
+end;
+
+procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended);
+begin
+  Y := ( L + 16 ) / 116.0;
+  X := ( a / 500.0 )+ Y;
+  Z := Y - ( b / 200.0 );
+
+  if ( Power(Y, 3) > 0.008856 ) then
+    Y := Power(Y, 3)
+  else
+    Y := ( Y - (16.0 / 116.0 )) / 7.787;
+  if ( Power(X, 3) > 0.008856 ) then
+    X := Power(X, 3)
+  else
+    X := ( X - (16.0 / 116.0) ) / 7.787;
+  if ( Power(Z, 3) > 0.008856 ) then
+    Z := Power(Z, 3)
+  else
+    Z := ( Z - (16.0 / 116.0) ) / 7.787;
+
+
+  X := 95.047 * X;
+  Y := 100.000 * Y;
+  Z := 108.883 * Z;
+end;
+
 end.

Units/MMLCore/finder.pas

@@ -271,7 +271,7 @@ end;
 
 procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
 begin
-  if (nCTS < 0) or (nCTS > 2) then
+  if (nCTS < 0) or (nCTS > 3) then
     raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
   Self.CTS := nCTS;
 end;
@@ -297,6 +297,7 @@ function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
 var
   R1,G1,B1,R2,G2,B2 : Byte;
   H1,S1,L1,H2,S2,L2 : extended;
+  L_1, a_1, b_1, L_2, a_2 ,b_2, X, Y, Z: extended;
 begin
   Result := False;
   ColorToRGB(Color1,R1,G1,B1);
@@ -312,13 +313,30 @@ begin
        RGBToHSL(R2,g2,b2,H2,S2,L2);
        Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
      end;
+  3:
+    begin
+       RGBToXYZ(R1, G1, B1, X, Y, Z);
+       XYZtoCIELab(X, Y, Z, L_1, a_1, b_1);
+       RGBToXYZ(R2, G2, B2, X, Y, Z);
+       XYZtoCIELab(X, Y, Z, L_2, a_2, b_2);
+       Result := (abs(L_1 - L_2) < Tolerance)
+                 and (abs(a_1 - a_2) < Tolerance)
+                 and (abs(b_1 - b_2) < Tolerance);
+    end;
   end;
 end;
 
 
+{
+   XXX: We should really rewrite this. Once we're adding more colour space we'll
+   only be adding more and more parameters. It's really silly to push all those
+   args if we aren't going to use them. We need to make sure the function is
+   actually inlined. Because if it's not, we should go for a different design.
+}
 function ColorSame(var CTS,Tolerance : Integer; var R1,G1,B1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
 var
   H2,S2,L2 : extended;
+  L_1, a_1, b_1, L_2, a_2 ,b_2, X, Y, Z: extended;
 begin
   Result := False;
   case CTS of
@@ -328,6 +346,15 @@ begin
        RGBToHSL(R2,g2,b2,H2,S2,L2);
        Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
      end;
+  3: begin
+       RGBToXYZ(R1, G1, B1, X, Y, Z);
+       XYZtoCIELab(X, Y, Z, L_1, a_1, b_1);
+       RGBToXYZ(R2, G2, B2, X, Y, Z);
+       XYZtoCIELab(X, Y, Z, L_2, a_2, b_2);
+       Result := (abs(L_1 - L_2) < Tolerance)
+                 and (abs(a_1 - a_2) < Tolerance)
+                 and (abs(b_1 - b_2) < Tolerance);
+     end;
   end;
 end;