Hey all. I am sure many of you liked ACA v 2 by Nielsie95 and Sumilion. I'm from it was delighted. But unfortunately the program have not been updated and is completely cross-platform. A few days ago I was contacted to Niels and asked source code of this utility. Received a positive response to the request, and after a few days of work, I present to you ACA remake.
Written in Lazarus + FPC, based on ACA2 and ACA v 3 source code. The program uses search colors algorithms from Simba.
Last update: 13.10.2014
Status: Win stable, *nix beta.
Credits:
Nielsie95 and Sumilion for ACA2 and wonderful readable code.
Nielsie95 for ACA v 3 and ACA2 source code.
Features:
Tolerance calculator
Optionable ColorToleranceSpeed
Client window - a image copied from your screen, allowing you to pick colors from it
Color Marking
Custom search area for Marking Colors
Bitmap saving
Bitmap loading
AutoColor function generator
FindObject function generator
Multi-colors profiles
CTS0,1,2,3 supported
Crossplatform, can be easely integrated to Simba.
The DX Apps grabbing support.
Screenshots:
Windows:
Linux:
Generated code:
Simba Code:
program AutoColor;
{$I SRL\SRL.simba}
function RedBox : Integer;
var
arP: TPointArray;
arC: TIntegerArray;
tmpCTS, i, arL: Integer;
H, S, L: Extended;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.08, 1.75);
FindColorsSpiralTolerance(640, 512, arP, 16043446, 0, 0, 1280, 1024, 8);
if (Length(arP) = 0) then
begin
Writeln('Failed to find the color, no result.');
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
Exit;
end;
arC := GetColors(arP);
ClearSameIntegers(arC);
arL := High(arC);
for i := 0 to arL do
begin
ColorToHSL(arC[i], H, S, L);
if (H >= 60.28) and (H <= 60.38) and (S >= 68.97) and (S <= 90.26) and (L >= 74.69) and (L <= 91.98) then
begin
ColorToXYZ(arC[i], X, Y, Z);
if (X >= 43.15) and (X <= 74.37) and (Y >= 44.73) and (Y <= 78.30) and (Z >= 84.94) and (Z <= 104.14) then
begin
Result := arC[i];
Writeln('AutoColor = ' + IntToStr(arC[i]));
Break;
end;
end;
end;
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
if (i = arL + 1) then
Writeln('AutoColor failed in finding the color.');
end;
function LazIcon : Integer;
var
arP: TPointArray;
arC: TIntegerArray;
tmpCTS, i, arL: Integer;
H, S, L: Extended;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(3);
SetColorSpeed3Modifiers(1,8);
FindColorsSpiralTolerance(640, 512, arP, 16043446, 0, 0, 1280, 1024, 8);
if (Length(arP) = 0) then
begin
Writeln('Failed to find the color, no result.');
ColorToleranceSpeed(tmpCTS);
Exit;
end;
arC := GetColors(arP);
ClearSameIntegers(arC);
arL := High(arC);
for i := 0 to arL do
begin
ColorToHSL(arC[i], H, S, L);
if (H >= 60.28) and (H <= 60.38) and (S >= 68.97) and (S <= 90.26) and (L >= 74.69) and (L <= 91.98) then
begin
ColorToXYZ(arC[i], X, Y, Z);
if (X >= 43.15) and (X <= 74.37) and (Y >= 44.73) and (Y <= 78.30) and (Z >= 84.94) and (Z <= 104.14) then
begin
Result := arC[i];
Writeln('AutoColor = ' + IntToStr(arC[i]));
Break;
end;
end;
end;
ColorToleranceSpeed(tmpCTS);
if (i = arL + 1) then
Writeln('AutoColor failed in finding the color.');
end;
begin
SetupSRL;
RedBox;
LazIcon;
end.
Simba Code:
program FindObjects;
{$I SRL\SRL.simba}
var
x, y: Integer;
function RedBox(var x,y: integer) : Integer;
var
arP, arAP: TPointArray;
arC, arUC: TIntegerArray;
ararP: T2DPointArray;
tmpCTS, i, j, arL, arL2: Integer;
P: TPoint;
H, S, L: Extended;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(2);
SetColorSpeed2Modifiers(0.08, 1.75);
if not(FindColorsTolerance(arP, 16043446, MSX1, MSY1, MSX2, MSY2, 8)) then
begin
Writeln('Failed to find the color, no object found.');
ColorToleranceSpeed(tmpCTS);
SetColorSpeed2Modifiers(0.2, 0.2);
Exit;
end;
arC := GetColors(arP);
arUC := arC;
ClearSameIntegers(arUC);
arL := High(arUC);
arL2 := High(arC);
for i := 0 to arL do
begin
ColorToHSL(arC[i], H, S, L);
if (H >= 60.28) and (H <= 60.38) and (S >= 68.97) and (S <= 90.26) and (L >= 74.69) and (L <= 91.98) then
begin
ColorToXYZ(arC[i], X, Y, Z);
if (X >= 43.15) and (X <= 74.37) and (Y >= 44.73) and (Y <= 78.30) and (Z >= 84.94) and (Z <= 104.14) then
begin
for j := 0 to arL2 do
begin
if (arUC[i] = arC[j]) then
begin
SetLength(arAP, Length(arAP) + 1);
arAP[High(arAP)] := arP[j];
end;
end;
end;
end;
end;
function LazIcon(var x,y: integer) : Integer;
var
arP, arAP: TPointArray;
arC, arUC: TIntegerArray;
ararP: T2DPointArray;
tmpCTS, i, j, arL, arL2: Integer;
P: TPoint;
H, S, L: Extended;
X, Y, Z: Extended;
begin
tmpCTS := GetColorToleranceSpeed;
ColorToleranceSpeed(3);
SetColorSpeed3Modifiers(1,8);
if not(FindColorsTolerance(arP, 16043446, MSX1, MSY1, MSX2, MSY2, 8)) then
begin
Writeln('Failed to find the color, no object found.');
ColorToleranceSpeed(tmpCTS);
Exit;
end;
arC := GetColors(arP);
arUC := arC;
ClearSameIntegers(arUC);
arL := High(arUC);
arL2 := High(arC);
for i := 0 to arL do
begin
ColorToHSL(arC[i], H, S, L);
if (H >= 60.28) and (H <= 60.38) and (S >= 68.97) and (S <= 90.26) and (L >= 74.69) and (L <= 91.98) then
begin
ColorToXYZ(arC[i], X, Y, Z);
if (X >= 43.15) and (X <= 74.37) and (Y >= 44.73) and (Y <= 78.30) and (Z >= 84.94) and (Z <= 104.14) then
begin
for j := 0 to arL2 do
begin
if (arUC[i] = arC[j]) then
begin
SetLength(arAP, Length(arAP) + 1);
arAP[High(arAP)] := arP[j];
end;
end;
end;
end;
end;
begin
SetupSRL;
LazIcon(x,y);
LazIcon(x,y);
end.
Source code can be found here:
http://github.com/CynicRus/ACARemake
Cheers,
Cynic.