diff --git a/Projects/Simba/Simba.res b/Projects/Simba/Simba.res index 42c7633..0087bd7 100644 Binary files a/Projects/Simba/Simba.res and b/Projects/Simba/Simba.res differ diff --git a/Units/MMLCore/colour_conv.pas b/Units/MMLCore/colour_conv.pas index 2cbb3e3..de280b7 100644 --- a/Units/MMLCore/colour_conv.pas +++ b/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. diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 37e1bc0..3e2b105 100644 --- a/Units/MMLCore/finder.pas +++ b/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;