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);');

56
Units/MMLCore/finder.pas
View File

@ -24,6 +24,7 @@ type
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
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
procedure SetToleranceSpeed(nCTS: Integer); procedure SetToleranceSpeed(nCTS: Integer);
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean; function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var. // Possibly turn x, y into a TPoint var.
@ -94,6 +95,23 @@ begin
end; end;
end; end;
function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
var
H2,S2,L2 : extended;
begin
Result := False;
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); procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
begin begin
CachedWidth := NewWidth; CachedWidth := NewWidth;
@ -131,6 +149,44 @@ begin
'correct y2: %d.', [y2]); 'correct y2: %d.', [y2]);
end; end;
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
var
PtrData: TRetData;
Ptr: PRGB32;
PtrInc: Integer;
clR, clG, clB : byte;
dX, dY, xx, yy: Integer;
h,s,l,hmod,smod : extended;
Ccts : integer;
begin
DefaultOperations(xs, ys, xe, ye);
dX := xe - xs;
dY := ye - ys;
ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith;
CCts := Self.CTS;
result := 0;
if cts = 2 then
begin;
RGBToHSL(clR,clG,clB,h,s,l);
hmod := Self.hueMod;
smod := Self.satMod;
end;
for yy := ys to ye do
begin;
for xx := xs to xe do
begin;
if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
inc(result);
Inc(Ptr);
end;
Inc(Ptr, PtrInc)
end;
TClient(Client).MWindow.FreeReturnData;
end;
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean; function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
var var
PtrData: TRetData; PtrData: TRetData;