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

Fixed Finder

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@54 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-09-13 18:19:33 +00:00
parent c2c6f2e09a
commit ade23dff0d
4 changed files with 567 additions and 538 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Units/MMLAddon/PSInc/Wrappers/colour.inc
View File

@ -12,3 +12,8 @@ procedure SetColorToleranceSpeed(cts: Integer);
begin
CurrThread.Client.MFinder.SetToleranceSpeed(cts);
end;
function SimilarColors(Col1,Col2,Tol : integer) : boolean;
begin;
Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol);
end;

1
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -8,6 +8,7 @@ Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');

33
Units/MMLCore/finder.pas
View File

@ -25,7 +25,7 @@ type
procedure DefaultOperations(var x1,y1,x2,y2 : integer);
public
procedure SetToleranceSpeed(nCTS: Integer);
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var.
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
@ -65,11 +65,33 @@ end;
procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
begin
if (CTS < 0) or (CTS > 2) then
cts := 1;
if (nCTS < 0) or (nCTS > 2) then
raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
Self.CTS := nCTS;
end;
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
var
R1,G1,B1,R2,G2,B2 : Byte;
H1,S1,L1,H2,S2,L2 : extended;
begin
Result := False;
ColorToRGB(Color1,R1,G1,B1);
ColorToRGB(Color2,R2,G2,B2);
if Color1 = Color2 then
Result := true
else
case CTS of
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
2: begin
RGBToHSL(R1,g1,b1,H1,S1,L1);
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;
end;
end;
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
begin
CachedWidth := NewWidth;
@ -184,6 +206,7 @@ begin
begin
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
goto Hit;
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
@ -195,6 +218,7 @@ begin
begin
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
goto Hit;
inc(ptr);
end;
Inc(Ptr, PtrInc);
end;
@ -206,6 +230,7 @@ begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
goto Hit;
inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
@ -215,11 +240,9 @@ begin
Exit;
Hit:
Result := True;
x := xx;
y := yy;
TClient(Client).MWindow.FreeReturnData;
end;