SCAR Code:
// functions by iloveit8
// formatted by Ron
{.include SRL/SRL.scar}
var
MyColorArray : Array of Integer;
procedure FindMiddle(var X, Y : integer; A : Array of Tpoint);
var
I, n : integer;
begin
X := 0;
Y := 0;
for I := 0 to GetArrayLength(A) - 1 do
begin
X := A[i].X + X;
Y := A[i].Y + Y;
end;
X := Round(X / GetArrayLength(A));
Y := Round(Y / GetArrayLength(A));
end;
function ClosestGroup(A : Array of Array of TPoint) : Array of TPoint;
var
B, I, X, Y : Integer;
begin
FindMiddle(X, Y, A[0]);
B := Distance(X, Y, 259, 144);
for I := 1 to GetArrayLength(A) - 1 do
if (Abs(X - 259) < B) and (Abs(Y - 144) < B) then
begin
FindMiddle(X, Y, A[i]);
B := Distance(X, Y, 259, 144);
Result := A[i];
end;
end;
function FurthestGroup(A : Array of Array of TPoint) : Array of TPoint;
var
B, I, X, Y : Integer;
begin
B := 0;
for I := 0 to GetArrayLength(A) - 1 do
if (Abs(X - 259) > B) and (Abs(Y - 144) > B) then
begin
FindMiddle(X, Y, A[i]);
B := Distance(X, Y, 259, 144);
Result := A[i];
end;
end;
function RemoveLowerDistancePointGroups(A : Array of Array of TPoint; Distance: integer) : Array Of Array Of TPoint;
var
RV, I, X, Y: Integer;
begin
RV := 0;
for I := 0 To GetArrayLength(A) do
begin
FindMiddle(X, Y, A[i]);
if (Abs(X - 259) > Distance) and (Abs(Y - 144) > Distance) then
begin
RV := RV + 1;
SetArrayLength(Result, RV);
Result[RV - 1] := A[i];
end;
end;
end;
function RemoveHigherDistancePointGroups(A : Array of Array of TPoint; Distance: integer) : Array Of Array Of TPoint;
var
RV, I, X, Y: Integer;
begin
RV := 0;
for I := 0 To GetArrayLength(A) do
begin
FindMiddle(X, Y, A[i]);
if (Abs(X - 259) < Distance) and (Abs(Y - 144) < Distance) then
begin
RV := RV + 1;
SetArrayLength(Result, RV);
Result[RV - 1] := A[i];
end;
end;
end;
function SplitText(A : String) : Array of String;
var
LastLetter, I : Integer;
begin
LastLetter := 1;
SetArrayLength(Result, 0);
for I := 1 to Length(A) do
if (A[i] = ',') or (A[i] = ';') then
begin
SetArrayLength(Result, GetArrayLength(Result) + 1);
Result[GetArrayLength(Result) - 1] := Copy(A, LastLetter, I - LastLetter);
LastLetter := I + 1;
end;
end;
procedure ClickGroup(A : Array of TPoint; Left : boolean);
var
X, Y: integer;
begin
FindMiddle(X, Y, A);
Mouse(X, Y, 2, 2, Left);
end;
function BiggestGroup(A : Array of Array of TPoint) : Array of TPoint;
var
B, I : Integer;
begin
B := 0
for I := 0 to GetArrayLength(A) - 1 do
if GetArrayLength(A[i]) > B then
begin
B := GetArrayLength(A[i]);
Result := A[i];
end;
end;
function SmallestGroup(A : Array of Array of TPoint) : Array of TPoint;
var
B, I : Integer;
begin
B := GetArrayLength(A[0]);
for I := 1 to GetArrayLength(A) - 1 do
if GetArrayLength(A[i]) < B then
begin
B := GetArrayLength(A[i]);
Result := A[i];
end;
end;
function RemoveBigPointGroups(A : Array of Array of TPoint; HowBig : integer): Array of Array of TPoint;
var
RV, I : Integer;
begin
RV := 0;
for I := 0 to GetArrayLength(A) - 1 do
if GetArrayLength(A[i]) <= HowBig then
begin
RV := RV + 1;
SetArrayLength(Result, RV);
Result[RV - 1] := A[i];
end;
end;
function RemoveSmallPointGroups(A : Array of Array of TPoint; HowSmall : integer): Array of Array of TPoint;
var
RV, I : Integer;
begin
RV := 0;
for I := 0 to GetArrayLength(A) - 1 do
if GetArrayLength(A[i]) >= HowSmall then
begin
RV := RV + 1;
SetArrayLength(Result, RV);
Result[RV - 1] := A[i];
end;
end;
procedure AddTPointArray(var Array1 : Array Of TPoint; Array2 : array of TPoint );
var
I, I2 : Integer;
begin
I2 := GetArrayLength(Array1);
SetArrayLength(Array1, GetArrayLength(Array1) + GetArrayLength(Array2));
if GetArrayLength(Array2) <> 0 then
for I := 0 to GetArrayLength(Array2) - 1 do
Array1[I + I2] := Array2[i];
end;
function IsWithinRangeTPointArray(A : array of TPoint; ALength: integer; D : Integer; B: TPoint) : boolean;
var
I : integer;
begin
for I := ALength - 1 downto 0 do
if (Abs(B.x - A[i].x) <= D) And (Abs(B.y - A[i].y) <= D) then //Wizzup? ty:)
begin
Result := True;
exit;
end;
end;
function IsTPointInArray(A : Array of TPoint; B : TPoint; ALength : integer): Boolean;
var
I : integer;
begin
for I := 0 To ALength - 1 do
if (A[i].X = B.X) and (A[i].Y = B.Y) then
begin
Result := True;
Exit;
end;
end;
function SubstractTPointArray(var ALength : integer; A, B: Array of TPoint; BLength: integer) : Array of TPoint;//A - B
var
I, Resultvariable : Integer;
begin
Resultvariable := 0;
SetArrayLength(Result, 0);
for I := 0 To ALength - 1 do
if Not IsTPointInArray(B, A[i], BLength) then
begin
Resultvariable := Resultvariable + 1;
SetArrayLength(Result, Resultvariable);
Result[Resultvariable - 1] := A[i];
end;
ALength := Resultvariable;
end;
procedure SpeedItUpWithAccuracy(var A : Array Of TPoint; Acc, Acc2: integer);
var
Tempvariable, I : integer;
Temp: Array of TPoint;
begin
Tempvariable := 0;
SetArrayLength(Temp, 0);
for I := 0 to GetArrayLength(A) - 1 do
if I mod Acc2 = 0 then
if not IsWithinRangeTPointArray(Temp, Tempvariable, Acc, A[i]) then
begin
Tempvariable := Tempvariable + 1;
SetArrayLength(Temp, Tempvariable);
Temp[Tempvariable - 1] := A[i];
end;
A := Temp;
end;
function FindGroups(WhichPoints : Array Of TPoint; MaxDistance, Accuracy, Accuracy2 : Integer) : Array of Array of TPoint;
var
I, Resultvariable, TempResultvariable, WhichPointsvariable: Integer;
begin
SetArrayLength(Result, 0);
Resultvariable := 0;
SpeedItUpWithAccuracy(WhichPoints, Accuracy, Accuracy2);
if GetArrayLength(WhichPoints) = 0 then exit;
repeat
WhichPointsvariable := GetArrayLength(WhichPoints);
Resultvariable := Resultvariable + 1;
SetArrayLength(Result, Resultvariable);
TempResultvariable := 1;
SetArrayLength(Result[Resultvariable - 1], 1);
Result[Resultvariable - 1][0] := WhichPoints[0];
for I := 1 to WhichPointsvariable - 1 do
begin
if IsWithinRangeTPointArray(Result[Resultvariable - 1], TempResultvariable, MaxDistance, WhichPoints[i]) then
begin
TempResultvariable := TempResultvariable + 1;
SetArrayLength(Result[Resultvariable - 1], TempResultvariable);
Result[Resultvariable - 1][TempResultvariable - 1] := WhichPoints[i];
end;
end;
WhichPoints := SubstractTPointArray(WhichPointsvariable, WhichPoints, Result[Resultvariable - 1], TempResultvariable);
until(GetArrayLength(WhichPoints) = 0);
end;
function LoveObjectFinder(Colors : Array of Integer; Sort : String) : Boolean;
var
WWC, WWC2, Dev : Boolean;
I, A,Tol, MaxDist, AccA, AccB, TempI, ColorMarker, FindGroupsMarker : Integer;
HueMod, SatMod : extended;
SplittedText : Array of String;
FoundPoints, FoundPoints2 ,FinalGroup : array of TPoint;
TwoDArrayOfTPoints: array of array of TPoint;
begin
HueMod := 0.2;
SatMod := 0.2;
Tol := 10;
MaxDist := 10;
AccA := 5;
AccB := 50;
SplittedText := SplitText(Sort);
for I := 0 To GetArrayLength(SplittedText) - 1 do
if (LowerCase(GetLetters(SplittedText[i])) = 'biggest') or (LowerCase(GetLetters(SplittedText[i])) = 'smallest') or (LowerCase(GetLetters(SplittedText[i])) = 'closest') or (LowerCase(GetLetters(SplittedText[i])) = 'furthest') then
WWC := True;
if not WWC then
Exit;
for I := 0 To GetArrayLength(SplittedText) - 1 do
if (LowerCase(GetLetters(SplittedText[i])) = 'clickleft') or (LowerCase(GetLetters(SplittedText[i])) = 'clickright') then
WWC2 := True;
if not WWC2 then
Exit;
for I := 0 to GetArrayLength(SplittedText) - 1 do
Case LowerCase(GetLetters(SplittedText[i])) of
'huemod' : HueMod := StrToInt(GetNumbers(SplittedText[i])) div IntPow(10,Length(GetNumbers(SplittedText[i])) - 1);
'satmod' : SatMod := StrToInt(GetNumbers(SplittedText[i])) div IntPow(10,Length(GetNumbers(SplittedText[i])) - 1);
'tol' : Tol := StrToInt(GetNumbers(SplittedText[i]));
'maxdist' : MaxDist := StrToInt(GetNumbers(SplittedText[i]));
'acca' : AccA := StrToInt(GetNumbers(SplittedText[i]));
'accb' : AccB := StrToInt(GetNumbers(SplittedText[i]));
'dev' : Dev := True;
end;
if AccA > MaxDist then
begin
TempI := AccA;
AccA := MaxDist;
MaxDist := TempI;
end;
ColorToleranceSpeed(2);
SetColorspeed2Modifiers(HueMod, SatMod);
if dev then
CopyClientToBitmap(TheBitMap, MSX1, MSY1, MSX2, MSY2);
if dev then
ColorMarker:= GetTimeRunning;
for A := 0 to GetArrayLength(Colors) - 1 do
begin
FindColorsSpiralTolerance(259, 144, FoundPoints2, Colors[A], MSX1, MSY1, MSX2, MSY2, 15);
AddTPointArray(FoundPoints, FoundPoints2);
end;
if dev then
WriteLn('Colorfinding took: ' + IntToStr(GetTimeRunning - ColorMarker) + 'ms.');
if dev then
FindGroupsMarker := GetTimeRunning;
TwoDArrayOfTPoints := FindGroups(FoundPoints, MaxDist, AccA, AccB);
if dev then
WriteLn('FindGroups took: ' + IntToStr(GetTimeRunning - FindGroupsMarker) + 'ms.');
if GetArrayLength(TwoDArrayOfTPoints) = 0 then
Exit;
for I := 0 to GetArrayLength(SplittedText) - 1 do
begin
if GetArrayLength(TwoDArrayOfTPoints) = 0 then
Exit;
if GetArrayLength(FinalGroup) = 0 then
Exit;
if LowerCase(GetLetters(SplittedText[i])) = 'removeamount' then
begin
if GetOthers(SplittedText[i]) = '<' then
RemoveSmallPointGroups(TwoDArrayOfTPoints, StrToInt(GetNumbers(SplittedText[i])));
if GetOthers(SplittedText[i]) = '>' then
RemoveBigPointGroups(TwoDArrayOfTPoints, StrToInt(GetNumbers(SplittedText[i])));
end;
if LowerCase(GetLetters(SplittedText[i])) = 'removedistance' then
begin
if GetOthers(SplittedText[i]) = '<' then
RemoveLowerDistancePointGroups(TwoDArrayOfTPoints, StrToInt(GetNumbers(SplittedText[i])));
if GetOthers(SplittedText[i]) = '>' then
RemoveHigherDistancePointGroups(TwoDArrayOfTPoints, StrToInt(GetNumbers(SplittedText[i])));
end;
Case LowerCase(SplittedText[i]) of
'biggest' : FinalGroup := BiggestGroup(TwoDArrayOfTPoints);
'smallest' : FinalGroup := SmallestGroup(TwoDArrayOfTPoints);
'closest' : FinalGroup := ClosestGroup(TwoDArrayOfTPoints);
'furthest' : FinalGroup := FurthestGroup(TwoDArrayOfTPoints);
'clickleft' : ClickGroup(FinalGroup, True);
'clickright' : ClickGroup(FinalGroup, False);
end;
end;
Result := True;
if dev then
begin
for AI := 0 To GetArrayLength(TwoDArrayOfTPoints) - 1 do
begin
Color := Round((16581375/GetArrayLength(TwoDArrayOfTPoints)) * (I + 1));
for BI := 0 to GetArrayLength(TwoDArrayOfTPoints[AI]) - 1 do
FastSetPixel(TheBitMap, TwoDArrayOfTPoints[AI][BI].x - MSX1, TwoDArrayOfTPoints[AI][BI].y - MSY1, Color);
end;
SaveBitMap(TheBitMap,'C:/TheBitMap.bmp');
end;
end;
begin
ActivateClient;
Wait(1000);
SetArrayLength(MyColorArray, 4);
MyColorArray[0] := 0;
MyColorArray[1] := 0;
MyColorArray[2] := 0;
MyColorArray[3] := 0;
LoveObjectFinder(MyColorArray, 'HueMod:0.2,SatMod:0.2,Tol:2,MaxDist:10,AccA:9,AccB:10,RemoveAmount<3,Biggest,ClickRight;');
end.