moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-23 17:52:16 -05:00
Code Issues Releases Wiki Activity

Add L*a*b CTS (3).

Browse Source
This commit is contained in:
Merlijn Wajer 2011-06-05 19:44:52 +02:00
parent 2e1e786d0e
commit 7a0db25416
3 changed files with 79 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Projects/Simba/Simba.res
View File

Binary file not shown.

52
Units/MMLCore/colour_conv.pas
View File

@ -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.

29
Units/MMLCore/finder.pas
View File

@ -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;