moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 10:42:20 -05:00
Code Issues Releases Wiki Activity

Added CountColorTolerance + SimilarColors.

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@71 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-09-18 22:41:05 +00:00
parent 68c49e0774
commit abe7c1f8a2
3 changed files with 369 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,3 +27,8 @@ function SimilarColors(Col1,Col2,Tol : integer) : boolean;
begin; begin;
Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol); Result := CurrThread.Client.MFinder.SimilarColors(Col1,Col2,Tol);
end; end;
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
begin;
result := CurrThread.Client.MFinder.CountColorTolerance(color,xs,ys,xe,ye,tolerance);
end;

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

@ -7,11 +7,13 @@ Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); 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(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean'); Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);'); Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);'); Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');

668
Units/MMLCore/finder.pas
View File

@ -1,306 +1,362 @@
unit finder; unit finder;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, MufasaTypes; // Types Classes, SysUtils, MufasaTypes; // Types
{ TMFinder Class } { TMFinder Class }
{ {
Should be 100% independant, as all platform dependant code is in the Should be 100% independant, as all platform dependant code is in the
Window and Input classes. Window and Input classes.
Let's try not to use any OS-specific defines here? ;) Let's try not to use any OS-specific defines here? ;)
} }
type type
TMFinder = class(TObject) TMFinder = class(TObject)
constructor Create(aClient: TObject); constructor Create(aClient: TObject);
destructor Destroy; override; destructor Destroy; override;
private private
Procedure UpdateCachedValues(NewWidth,NewHeight : integer); Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
procedure DefaultOperations(var x1,y1,x2,y2 : integer); procedure DefaultOperations(var x1,y1,x2,y2 : integer);
public public
procedure SetToleranceSpeed(nCTS: Integer); function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean; procedure SetToleranceSpeed(nCTS: Integer);
// Possibly turn x, y into a TPoint var. function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean; // Possibly turn x, y into a TPoint var.
function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean; 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;
function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
protected function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
Client: TObject; protected
CachedWidth, CachedHeight : integer; Client: TObject;
ClientTPA : TPointArray; CachedWidth, CachedHeight : integer;
hueMod, satMod: Extended; ClientTPA : TPointArray;
CTS: Integer; hueMod, satMod: Extended;
CTS: Integer;
end;
end;
implementation
uses implementation
Client, // For the Client Casts. uses
colour_conv // For RGBToColor, etc. Client, // For the Client Casts.
; colour_conv // For RGBToColor, etc.
;
constructor TMFinder.Create(aClient: TObject);
constructor TMFinder.Create(aClient: TObject);
begin
inherited Create; begin
inherited Create;
Self.Client := aClient;
Self.CTS := 1; Self.Client := aClient;
Self.hueMod := 0.2; Self.CTS := 1;
Self.satMod := 0.2; Self.hueMod := 0.2;
Self.satMod := 0.2;
end;
end;
destructor TMFinder.Destroy;
begin destructor TMFinder.Destroy;
begin
inherited;
end; inherited;
end;
procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
begin procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
if (nCTS < 0) or (nCTS > 2) then begin
raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]); if (nCTS < 0) or (nCTS > 2) then
Self.CTS := nCTS; raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
end; Self.CTS := nCTS;
end;
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
var function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
R1,G1,B1,R2,G2,B2 : Byte; var
H1,S1,L1,H2,S2,L2 : extended; R1,G1,B1,R2,G2,B2 : Byte;
begin H1,S1,L1,H2,S2,L2 : extended;
Result := False; begin
ColorToRGB(Color1,R1,G1,B1); Result := False;
ColorToRGB(Color2,R2,G2,B2); ColorToRGB(Color1,R1,G1,B1);
if Color1 = Color2 then ColorToRGB(Color2,R2,G2,B2);
Result := true if Color1 = Color2 then
else Result := true
case CTS of else
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); case CTS of
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
2: begin 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
RGBToHSL(R1,g1,b1,H1,S1,L1); 2: begin
RGBToHSL(R2,g2,b2,H2,S2,L2); RGBToHSL(R1,g1,b1,H1,S1,L1);
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); RGBToHSL(R2,g2,b2,H2,S2,L2);
end; Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
end; end;
end; end;
end;
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
begin
CachedWidth := NewWidth; function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
CachedHeight := NewHeight; var
SetLength(ClientTPA,NewWidth * NewHeight); H2,S2,L2 : extended;
end; begin
Result := False;
procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer); case CTS of
var 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
w,h : integer; 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
begin 2: begin
{ if x1 > x2 then RGBToHSL(R1,g1,b1,H1,S1,L1);
Swap(x1,x2); RGBToHSL(R2,g2,b2,H2,S2,L2);
if y1 > y2 then Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
Swap(y1,y2);} end;
if x1 < 0 then end;
// x1 := 0; end;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct x1: %d.', [x1]); procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
if y1 < 0 then begin
// y1 := 0; CachedWidth := NewWidth;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + CachedHeight := NewHeight;
'correct y1: %d.', [y1]); SetLength(ClientTPA,NewWidth * NewHeight);
end;
TClient(Self.Client).MWindow.GetDimensions(w,h);
if (w <> CachedWidth) or (h <> CachedHeight) then procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer);
UpdateCachedValues(w,h); var
if x2 >= w then w,h : integer;
// x2 := w-1; begin
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + { if x1 > x2 then
'correct x2: %d.', [x2]); Swap(x1,x2);
if y2 >= h then if y1 > y2 then
// y2 := h-1; Swap(y1,y2);}
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + if x1 < 0 then
'correct y2: %d.', [y2]); // x1 := 0;
end; raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct x1: %d.', [x1]);
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean; if y1 < 0 then
var // y1 := 0;
PtrData: TRetData; raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
Ptr: PRGB32; 'correct y1: %d.', [y1]);
PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy: Integer; TClient(Self.Client).MWindow.GetDimensions(w,h);
if (w <> CachedWidth) or (h <> CachedHeight) then
begin UpdateCachedValues(w,h);
if x2 >= w then
// checks for valid x1,y1,x2,y2? (may involve GetDimensions) // x2 := w-1;
DefaultOperations(x1,y1,x2,y2); raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct x2: %d.', [x2]);
// calculate delta x and y if y2 >= h then
dX := x2 - x1; // y2 := h-1;
dY := y2 - y1; raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct y2: %d.', [y2]);
//next, convert the color to r,g,b end;
ColorToRGB(Color, clR, clG, clB);
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1); var
PtrData: TRetData;
// Do we want to "cache" these vars? Ptr: PRGB32;
// We will, for now. Easier to type. PtrInc: Integer;
Ptr := PtrData.Ptr; clR, clG, clB : byte;
PtrInc := PtrData.IncPtrWith; dX, dY, xx, yy: Integer;
h,s,l,hmod,smod : extended;
for yy := y1 to y2 do Ccts : integer;
begin; begin
for xx := x1 to x2 do DefaultOperations(xs, ys, xe, ye);
begin; dX := xe - xs;
// Colour comparison here. Possibly with tolerance? ;) dY := ye - ys;
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then ColorToRGB(Color, clR, clG, clB);
begin PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
Result := True; Ptr := PtrData.Ptr;
x := xx; PtrInc := PtrData.IncPtrWith;
y := yy; CCts := Self.CTS;
result := 0;
TClient(Client).MWindow.FreeReturnData; if cts = 2 then
Exit; begin;
end; RGBToHSL(clR,clG,clB,h,s,l);
Inc(Ptr); hmod := Self.hueMod;
end; smod := Self.satMod;
Inc(Ptr, PtrInc) end;
end; for yy := ys to ye do
begin;
TClient(Client).MWindow.FreeReturnData; for xx := xs to xe do
end; begin;
if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean; inc(result);
var Inc(Ptr);
PtrData: TRetData; end;
Ptr: PRGB32; Inc(Ptr, PtrInc)
PtrInc: Integer; end;
dX, dY, clR, clG, clB, xx, yy: Integer; TClient(Client).MWindow.FreeReturnData;
H1, S1, L1, H2, S2, L2: Extended; end;
label Hit; function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
label Miss; var
PtrData: TRetData;
begin Ptr: PRGB32;
PtrInc: Integer;
// checks for valid x1,y1,x2,y2? (may involve GetDimensions) dX, dY, clR, clG, clB, xx, yy: Integer;
DefaultOperations(x1,y1,x2,y2);
begin
// calculate delta x and y
dX := x2 - x1; // checks for valid x1,y1,x2,y2? (may involve GetDimensions)
dY := y2 - y1; DefaultOperations(x1,y1,x2,y2);
//next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); // calculate delta x and y
ColorToHSL(Color, H1, S1, L1); dX := x2 - x1;
dY := y2 - y1;
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
//next, convert the color to r,g,b
// Do we want to "cache" these vars? ColorToRGB(Color, clR, clG, clB);
// We will, for now. Easier to type.
Ptr := PtrData.Ptr; PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
PtrInc := PtrData.IncPtrWith;
// Do we want to "cache" these vars?
case CTS of // We will, for now. Easier to type.
0: Ptr := PtrData.Ptr;
for yy := y1 to y2 do PtrInc := PtrData.IncPtrWith;
begin
for xx := x1 to x2 do for yy := y1 to y2 do
begin begin;
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then for xx := x1 to x2 do
goto Hit; begin;
inc(Ptr); // Colour comparison here. Possibly with tolerance? ;)
end; if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
Inc(Ptr, PtrInc); begin
end; Result := True;
x := xx;
1: y := yy;
for yy := y1 to y2 do
begin TClient(Client).MWindow.FreeReturnData;
for xx := x1 to x2 do Exit;
begin end;
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then Inc(Ptr);
goto Hit; end;
inc(ptr); Inc(Ptr, PtrInc)
end; end;
Inc(Ptr, PtrInc);
end; TClient(Client).MWindow.FreeReturnData;
2: end;
begin
for yy := y1 to y2 do function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
for xx := x1 to x2 do var
begin PtrData: TRetData;
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); Ptr: PRGB32;
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then PtrInc: Integer;
goto Hit; dX, dY, clR, clG, clB, xx, yy: Integer;
inc(Ptr); H1, S1, L1, H2, S2, L2: Extended;
end;
Inc(Ptr, PtrInc); label Hit;
end; label Miss;
end;
Result := False; begin
TClient(Client).MWindow.FreeReturnData;
Exit; // checks for valid x1,y1,x2,y2? (may involve GetDimensions)
DefaultOperations(x1,y1,x2,y2);
Hit:
Result := True; // calculate delta x and y
x := xx; dX := x2 - x1;
y := yy; dY := y2 - y1;
TClient(Client).MWindow.FreeReturnData; //next, convert the color to r,g,b
end; ColorToRGB(Color, clR, clG, clB);
ColorToHSL(Color, H1, S1, L1);
function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
var PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
PtrData: TRetData;
Ptr: PRGB32; // Do we want to "cache" these vars?
PtrInc: Integer; // We will, for now. Easier to type.
dX, dY, clR, clG, clB, xx, yy, i: Integer; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith;
begin
DefaultOperations(x1,y1,x2,y2); case CTS of
0:
dX := x2 - x1; for yy := y1 to y2 do
dY := y2 - y1; begin
for xx := x1 to x2 do
I := 0; begin
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
ColorToRGB(Color, clR, clG, clB); goto Hit;
inc(Ptr);
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1); end;
Inc(Ptr, PtrInc);
Ptr := PtrData.Ptr; end;
PtrInc := PtrData.IncPtrWith;
1:
for yy := y1 to y2 do for yy := y1 to y2 do
begin; begin
for xx := x1 to x2 do for xx := x1 to x2 do
begin; begin
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
begin goto Hit;
Self.ClientTPA[I] := Point(xx, yy); inc(ptr);
Inc(I); end;
end; Inc(Ptr, PtrInc);
Inc(Ptr); end;
end; 2:
Inc(Ptr, PtrInc); begin
end; for yy := y1 to y2 do
for xx := x1 to x2 do
SetLength(TPA, I); begin
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint)); if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
goto Hit;
Result := I > 0; inc(Ptr);
end;
TClient(Client).MWindow.FreeReturnData; Inc(Ptr, PtrInc);
end; end;
end;
end. Result := False;
TClient(Client).MWindow.FreeReturnData;
Exit;
Hit:
Result := True;
x := xx;
y := yy;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
var
PtrData: TRetData;
Ptr: PRGB32;
PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy, i: Integer;
begin
DefaultOperations(x1,y1,x2,y2);
dX := x2 - x1;
dY := y2 - y1;
I := 0;
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith;
for yy := y1 to y2 do
begin;
for xx := x1 to x2 do
begin;
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
begin
Self.ClientTPA[I] := Point(xx, yy);
Inc(I);
end;
Inc(Ptr);
end;
Inc(Ptr, PtrInc);
end;
SetLength(TPA, I);
Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint));
Result := I > 0;
TClient(Client).MWindow.FreeReturnData;
end;
end.