1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-24 02:02:17 -05:00

Completed first CTS rework.

This commit is contained in:
Merlijn Wajer 2011-06-13 20:38:00 +02:00
parent 7a412d1670
commit 5bf7d8beea

View File

@ -870,10 +870,68 @@ var
PtrData: TRetData; PtrData: TRetData;
Ptr: PRGB32; Ptr: PRGB32;
PtrInc: Integer; PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy: Integer; dX, dY, clR, clG, clB: Integer;
xy: TPoint;
function cts0: tpoint;
var xx, yy: integer;
begin
for yy := ys to ye do
begin
for xx := xs to xe do
begin
if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and
(Abs(clR-Ptr^.R) <= Tol)) then
exit(Point(xx, yy));
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
result.x := -1; result.y := -1;
end;
function cts1: tpoint;
var xx, yy: integer;
begin
Tol := Sqr(Tol);
for yy := ys to ye do
begin
for xx := xs to xe do
begin
if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then
exit(Point(xx, yy));
inc(ptr);
end;
Inc(Ptr, PtrInc);
end;
result.x := -1; result.y := -1;
end;
function cts2: tpoint;
var xx, yy: integer;
H1, S1, L1, H2, S2, L2: Extended; H1, S1, L1, H2, S2, L2: Extended;
HueXTol, SatXTol: Extended; HueXTol, SatXTol: Extended;
label Hit; begin
RGBToHSL(clR,clG,clB,H1,S1,L1);
HueXTol := hueMod * Tol;
SatXTol := satMod * Tol;
for yy := ys to ye do
begin
for xx := xs to xe do
begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then
exit(Point(xx, yy));
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
result.x := -1; result.y := -1;
end;
begin begin
Result := false; Result := false;
@ -885,8 +943,6 @@ begin
dY := ye - ys; dY := ye - ys;
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
if Cts = 2 then
RGBToHSL(clR,clG,clB,H1,S1,L1);
PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1); PtrData := TClient(Client).IOManager.ReturnData(xs, ys, dX + 1, dY + 1);
@ -896,61 +952,22 @@ begin
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
case CTS of case CTS of
0: 0: xy := cts0();
for yy := ys to ye do 1: xy := cts1();
2: xy := cts2();
end;
if (xy.x = -1) and (xy.y = -1) then
begin begin
for xx := xs to xe do
begin
if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then
goto Hit;
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
1:
begin
Tol := Sqr(Tol);
for yy := ys to ye do
begin
for xx := xs to xe do
begin
if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then
goto Hit;
inc(ptr);
end;
Inc(Ptr, PtrInc);
end;
end;
2:
{ Can be optimized a lot... RGBToHSL isn't really inline, }
begin
HueXTol := hueMod * Tol;
SatXTol := satMod * Tol;
for yy := ys to ye do
begin
for xx := xs to xe do
begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
if ((abs(H1 - H2) <= HueXTol) and (abs(S1 - S2) <= SatXTol) and (abs(L1 - L2) <= Tol)) then
goto Hit;
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
end;
end;
Result := False; Result := False;
TClient(Client).IOManager.FreeReturnData; TClient(Client).IOManager.FreeReturnData;
Exit; Exit;
end else
Hit: begin
Result := True; Result := True;
x := xx; x := xy.x;
y := yy; y := xy.y;
TClient(Client).IOManager.FreeReturnData; TClient(Client).IOManager.FreeReturnData;
end;
end; end;
function TMFinder.FindColoredAreaTolerance(var x, y: Integer; Color, xs, ys, xe, ye, MinArea, tol: Integer): Boolean; function TMFinder.FindColoredAreaTolerance(var x, y: Integer; Color, xs, ys, xe, ye, MinArea, tol: Integer): Boolean;