ACA - AutoColorAid by Nielsie95

ACA a.k.a. AutoColorAid

by Nielsie95

This is a snippet which helps you to autocolor something. You enter as much colors as you can get and the script will create an autocolor procedure using RGB, HSL or XYZ.
The script itself will decide which is the best to use :)
It also sets the best ColorToleranceSpeed and Tolerance.
I also integrated the snippet from Boreas which helps you to get the best color from a bitmap :).



http://img521.imageshack.us/img521/5680/akaev3.png


Please comment, suggest and test. :)


Credits to RkRoxPunk for helping me with the name :D
Credits to Wizzup for the ColorToleranceSpeed compare. :)
Credits to Sumilion for the updated AutoColor Function :)
Credits to Tarajunky for getting the best color + tol from the array! :)
Credits to Boreas for the Color from Bitmap :)

older version downloads: 155.

Nielsie95

niel's wheels colour shmuller :D

anywayz...yay first post...worked great for me on the grey MM rocks with 10 colours. well done

Cant check it out now, but I may test it later.
But it looks just great!

It looks like it automatically picked the first number in the series as the generic search color. It would be better if you found the median number and used that, since it should reduce the tolerance needed.

Works well. . .I'm using it for my Chicken Obliterator script. . .Until I can figure out how to do it myself or something :p

Looks real cool; gonna try it out

this looks cool needed this thanks!

Thanks for the great comments :)

Tara:

Maybe you could help me with that one? I've tried getting the best color, but the Results in Tolerance are staying the same. I think it doesn't matter which color is first, or I'm doing something wrong here.

I tried it like this:

SCAR Code:

ColorToleranceSpeed(Cts);
  SetArrayLength(ColCount, Length(Colors));
  for i := 0 to Length(Colors) -1 do
    for c := 0 to Length(Colors) -1 do
    if c <> i then
      ColCount[i] := ColCount[i] + SimC(Colors[i], Colors[c]);

  c := 0;
  for i := 0 to Length(Colors) -1 do
    if Min(ColCount[c], ColCount[i]) <> ColCount[c] then c := i;

  WriteLn('Best Color: '+IntToStr(Colors[c]));

In the example above I got 1190948 as best color.
But I'm getting the same results with Tolerance..

SCAR Code:

ColorToleranceSpeed(Cts);
  SetArrayLength(ColCount, Length(Colors));
  for i := 0 to Length(Colors) -1 do
    for c := 0 to Length(Colors) -1 do
      if SimC(Colors[i], Colors[c]) > ColCount[i] then
        ColCount[i] := SimC(Colors[i], Colors[c]);
 
  c := 0;
  for i := 0 to Length(Colors) -1 do
    if Min(ColCount[c], ColCount[i]) <> ColCount[c] then c := i;
 
  WriteLn('Best Color: '+IntToStr(Colors[c]));

That should work. The way you had it before you added up the total tolerance difference between all the numbers, which is the same for every number in the series. (Like an extreme number might be 5, 10, 90 while a middle number might be 30,35,40, they add up to the same amount but one is much worse than the other) You only want to know the maximum tolerance for each color to each other color. Then you pick the color with the lowest value.

Nice, i needed this thnx.

Wow very nice nielsie. It amazes me how you just came to these forums and started owning everyone :p

BTW you remind me of Boreas, he always codes unique things like this.

He reminds me of Fawki. Can you believe Nielsie actually asked someone how to do something?!!

Quote:

---

Originally Posted by Mjordan

BTW you remind me of Boreas, he always codes unique things like this.

---

Haha, same here.. He also reminds me of Ron/SKy Scripter/The_Rs_Monkey.. :p

That's a nice 'utility' you have there, Nielsie - definitely useful one! Thanks.

By the way Nielsie, can you hear people yelling... "Make form! Make form! Make form!"? I can.. :D

oh thats cool.

Nice work :)

Nice work! Just tested it. Perfect! Although I think the CountColor > 50 should be reduced to around 10 or so... and some people want to search in the main screen, not the minimap. So maybe you could make an option for that?

Form pl0cks?
:p

Quote:

---

Although I think the CountColor > 50 should be reduced to around 10 or so... and some people want to search in the main screen, not the minimap. So maybe you could make an option for that?

---

It's easier to just edit the code after you paste it...

Yeah, I know. But I didn't realize that it was searching the minimap for about ten minutes. I was getting pretty mad :p

nice BTW ;)

Lol Should Have really Made the RGB in order not the color XD

SCAR Code:

program New;

procedure DeleteColorItem(var ColorData : TIntegerArray; Index : Integer);
var
   i : integer;
begin
 if (InRange(Index, 0, GetArrayLength(ColorData)-1)) then
 begin
    for i := index to GetArrayLength(ColorData)-2 do
       ColorData[i] := ColorData[i + 1];
    SetArrayLength(ColorData, GetArrayLength(ColorData)-1);
 end;
end;

procedure DeleteColorValue(var ColorData : TIntegerArray; Value : Integer);
var
   i, Length : integer;
begin
Length := GetArrayLength(ColorData);
  for i := 0 to Length-1 do
  begin
      if (ColorData[i] = Value) then
      begin
         DeleteColorItem(ColorData, i);
         Exit;
      end;
  end;
end;



function OrganizeColors(DataColor : TIntegerArray) : TIntegerArray;
var
  i : integer;
begin
    for i := 0 to GetArrayLength(DataColor)-1 do
    begin
       SetArrayLength(Result, GetArrayLength(Result)+1);
       Result[GetArrayLength(Result)-1] := AMax(DataColor);
       DeleteColorValue(DataColor,  Result[GetArrayLength(Result)-1]);
    end;
end;
                // Finds The Middle 1, 2, 3*, 4, 5
function AMid(Data: TIntegerArray) : Integer;
var
   n : TIntegerArray;
begin
  n := OrganizeColors(Data);
  Result := n[GetArrayLength(n)-1];
end;

function AMin(Data : TIntegerArray) : Integer;
var
  Min, i : integer;
begin
  if (GetArrayLength(Data) = 0) then Exit;
  Min := Data[0];
   for i := 0 to GetArrayLength(Data)-1 do
     if (Data[i] < Min) then
        Min := Data[i];
   Result := Min;
end;



var
   T : TIntegerArray;
   Min, Mid, Max : Integer;
   R, G, B : array [1..3] of Integer;
begin

   SetArrayLength(T, 5);

   T[0] := 10;  // Colors
   T[1] := 20;
   T[2] := 30;
   T[3] := 40;
   T[4] := 50;

   Min := AMin(T);
   Mid := AMid(T);
   Max := AMax(T);

   ColortoRGB(Min, R[1], G[1], B[1]);
   ColortoRGB(Mid, R[2], G[2], B[2]);
   ColortoRGB(Max, R[3], G[3], B[3]);

   writeln('Min Color : R:' + Inttostr(R[1]) +  ' B:' + Inttostr(B[1]) + ' G:' + Inttostr(G[1]));
   writeln('Mid Color : R:' + Inttostr(R[2]) +  ' B:' + Inttostr(B[2]) + ' G:' + Inttostr(G[2]));
   writeln('Max Color : R:' + Inttostr(R[3]) +  ' B:' + Inttostr(B[3]) + ' G:' + Inttostr(G[3]));


  // Writeln('Middle Color = ' + IntToStr(GetMiddle(T)));


end.

Awesome tool, Nielsie! Ill be sure to use it :D Ill let you know how it works out.

Thanks, updated it a bit to use the best color out the array (thanks Tara :))!
Next: Forms! :p

I took the liberty of changing your function a little ... you see, lets say there are 50 pixels with the to be autocolored color .. then it will check all those 50pixels while they are the same color ... so i added a little unique color function to it, see if you want to add it or not. (ps. i havent tested it, but i know the unique color thing works ...)

SCAR Code:

WriteLn(' ');
  WriteLn('function AutoColorIt: Integer;');
  WriteLn('var');
  WriteLn('  '+RangeNames[0]+', '+RangeNames[1]+', '+RangeNames[2]+': '+RangeNames[4]+';');
  WriteLn('  Points: TPointArray;');
  WriteLn('  Colors, UniqueColors: TIntegerArray;');
  WriteLn('  i, a: Integer;');
  WriteLn('  NewColor: Boolean;');
  WriteLn('begin');
  WriteLn('  if not LoggedIn then Exit;');
  WriteLn('  ColorToleranceSpeed('+IntTostr(CTS)+');');
  WriteLn('  FindColorsSpiralTolerance(MMCX, MMCY, Points, '+IntToStr(BColor)+', MMX1, MMY1, MMX2, MMY2, '+IntToStr(Tol[CTS][1] + 2)+');');
  WriteLn('  if Length(Points) < 1 then Exit;');
  WriteLn('  Colors := GetColors(Points);');
  WriteLn(' ');
  WriteLn('  for i := 0 to Length(Colors) -1 do');
  WriteLn('  begin');
  WriteLn('    NewColor := True;');
  WriteLn('    for a := 0 to GetArrayLength(UniqueColors) - 1 do');
  WriteLn('    begin');
  WriteLn('      if(UniqueColors[a] = Colors[i])then');
  WriteLn('       NewColor := False;');
  WriteLn('    end;');
  WriteLn('    if(NewColor)then');
  WriteLn('    begin');
  WriteLn('      SetArrayLength(UniqueColors, GetArrayLength(UniqueColors) + 1);');
  WriteLn('      UniqueColors[GetArrayLength(UniqueColors) - 1] := Colors[i];');
  WriteLn('    end;');
  WriteLn('  end;');
  WriteLn('  for i := 0 to Length(UniqueColors) -1 do');
  WriteLn('  if UniqueColors[i] <> 0 then ');
  WriteLn('  begin');
  WriteLn('    '+RangeNames[3]+'(UniqueColors[i], '+RangeNames[0]+', '+RangeNames[1]+', '+RangeNames[2]+');');
  WriteLn('    if ('+RangeNames[0]+ ' < ' + FloatToStr(Round(Ranges[0][1]) + 2) + ') and ('+RangeNames[0]+ ' > ' + FloatToStr(Round(Ranges[0][0]) - 2) + ') then ');
  WriteLn('      if ('+RangeNames[1]+ ' < ' + FloatToStr(Round(Ranges[1][1]) + 2) + ') and ('+RangeNames[1]+ ' > ' + FloatToStr(Round(Ranges[1][0]) - 2) + ') then ');
  WriteLn('        if ('+RangeNames[2]+ ' < ' + FloatToStr(Round(Ranges[2][1]) + 2) + ') and ('+RangeNames[2]+ ' > ' + FloatToStr(Round(Ranges[2][0]) - 2) + ') then ');
  WriteLn('          if CountColor(UniqueColors[i], MMX1, MMY1, MMX2, MMY2) > 50 then ');
  WriteLn('          begin');
  WriteLn('            WriteLn(''AutColor: ''+IntTostr(UniqueColors[i]))');
  WriteLn('            Result := UniqueColors[i];');
  WriteLn('            Break;');
  WriteLn('          end;');
  WriteLn('  end; ');
  WriteLn(' ');
  WriteLn('  ColorToleranceSpeed(1);');
  WriteLn('end;');

It would also be helpful to know what the maximum tolerance is for the best color.

So after the Best Color line you should add this...

Quote:

---

Writeln('Max Tol = '+IntToStr(ColCount[c]));

---

Then if you want to use that color as a point in a DTM or something, you just use that color and that tolerance + 5 or 10 and it should find the color pretty much every time. The more points you have in the array, the more accurate your color range should be, and the less you need to add to the tolerance. So, if you only have 5 data points you might want to add 15. If you have 60 data points maybe only add 3 or 5.

Thanks! :)

Updated it a little again. Now uses the updated AutoColorTemplate from Sumilion! :)

@Tara: It already showed the max tolerance, I made it a bit more clear now ;)

No problem :)

Too bad ACA didnt do the trick for me ... my color is too complicated :)

It's more supposed to give you hints on colors, tolerance, tolerancespeed etc..
The AutoColorFunction is a nice addition, but is too global too really autocolor :)

btw: Mind telling me what those colors are? :p

The color of the copper rocks on the minimap :p

Quote:

---

Originally Posted by Sumilion

The color of the copper rocks on the minimap :p

---

alright so i tried brute force auto coloring a few days ago and i noticed it does not work on most colors as in some worlds alright its fine color is almost the same but some worlds the colors is COMPLETELY different although it might still be possible what if you made it auto color differently depending on the world your at?

Quote:

---

Originally Posted by Sumilion

Too bad ACA didnt do the trick for me ... my color is too complicated :)

---

Just wanted to try it out myself :p
Works for me :). If you haven't got an autocolor procedure yourself already, you might want to change the last bit to use HSL (max luminance).. Fully based on the AutoColor procedure from ACA. :)

SCAR Code:

function AutoColorIt: Integer;
var
  R, G, B: Integer;
  Points: TPointArray;
  Colors, UniqueColors: TIntegerArray;
  i, a: Integer;
  NewColor: Boolean;
begin
  if not LoggedIn then Exit;
  ColorToleranceSpeed(0);
  FindColorsSpiralTolerance(MMCX, MMCY, Points, 3232641, MMX1, MMY1, MMX2, MMY2, 36);
  if Length(Points) < 1 then Exit;
  Colors := GetColors(Points);

  for i := 0 to Length(Colors) -1 do
  begin
    NewColor := True;
    for a := 0 to GetArrayLength(UniqueColors) - 1 do
    begin
      if(UniqueColors[a] = Colors[i])then
      begin
        NewColor := False;
        Break;
      end;
    end;
    if(NewColor)then
    begin
      SetArrayLength(UniqueColors, GetArrayLength(UniqueColors) + 1);
      UniqueColors[GetArrayLength(UniqueColors) - 1] := Colors[i];
    end;
  end;
  SetArrayLength(Colors, 0);
  for i := 0 to Length(UniqueColors) -1 do
  if UniqueColors[i] <> 0 then
  begin
    ColorToRGB(UniqueColors[i], R, G, B);
    if (R < 158) and (R > 107) then
      if (G < 103) and (G > 61) then
        if (B < 82) and (B > 27) then
          if CountColor(UniqueColors[i], MMX1, MMY1, MMX2, MMY2) > 50 then
          begin
            SetArrayLength(Colors, Length(Colors) +1);
            Colors[Length(Colors) -1] := UniqueColors[i];
          end;
  end;

  a := 0;
  if Length(Colors) < 1 then Exit;
  for i := 0 to GetArrayLength(Colors) -1 do
    if Max(a, Colors[i]) <> a then a := Colors[i];
    //WriteLn('['+IntToStr(i)+'] Color: '+IntToStr(Colors[i]));

  Result := a;
  WriteLn('AutoColor: '+IntToStr(a));
  ColorToleranceSpeed(1);
end;

Colors I used:

Code:

---

procedure SetupColors;
begin
  Colors :=
 [4940956, 2970508, 4087437, 2904953, 4284815, 2965625, 4088199, 1919856, 3035757,
  2441070, 3957144, 4741772, 3232641, 2902133, 5267860, 3295088, 3758479, 2706034,
  4218516, 1918317, 4612493, 4677005, 4351370, 4544918, 3690640, 2573945, 2181240];    //Set your colors in here and hit play!
end;

---

Omg, stop coming out with so much ownage stuff! You make the rest of us look bad :P

Quote:

---

Originally Posted by nielsie95

Just wanted to try it out myself :p
Works for me :). If you haven't got an autocolor procedure yourself already, you might want to change the last bit to use HSL (max luminance).. Fully based on the AutoColor procedure from ACA. :)

SCAR Code:

function AutoColorIt: Integer;
var
  R, G, B: Integer;
  Points: TPointArray;
  Colors, UniqueColors: TIntegerArray;
  i, a: Integer;
  NewColor: Boolean;
begin
  if not LoggedIn then Exit;
  ColorToleranceSpeed(0);
  FindColorsSpiralTolerance(MMCX, MMCY, Points, 3232641, MMX1, MMY1, MMX2, MMY2, 36);
  if Length(Points) < 1 then Exit;
  Colors := GetColors(Points);

  for i := 0 to Length(Colors) -1 do
  begin
    NewColor := True;
    for a := 0 to GetArrayLength(UniqueColors) - 1 do
    begin
      if(UniqueColors[a] = Colors[i])then
      begin
        NewColor := False;
        Break;
      end;
    end;
    if(NewColor)then
    begin
      SetArrayLength(UniqueColors, GetArrayLength(UniqueColors) + 1);
      UniqueColors[GetArrayLength(UniqueColors) - 1] := Colors[i];
    end;
  end;
  SetArrayLength(Colors, 0);
  for i := 0 to Length(UniqueColors) -1 do
  if UniqueColors[i] <> 0 then
  begin
    ColorToRGB(UniqueColors[i], R, G, B);
    if (R < 158) and (R > 107) then
      if (G < 103) and (G > 61) then
        if (B < 82) and (B > 27) then
          if CountColor(UniqueColors[i], MMX1, MMY1, MMX2, MMY2) > 50 then
          begin
            SetArrayLength(Colors, Length(Colors) +1);
            Colors[Length(Colors) -1] := UniqueColors[i];
          end;
  end;

  a := 0;
  if Length(Colors) < 1 then Exit;
  for i := 0 to GetArrayLength(Colors) -1 do
    if Max(a, Colors[i]) <> a then a := Colors[i];
    //WriteLn('['+IntToStr(i)+'] Color: '+IntToStr(Colors[i]));

  Result := a;
  WriteLn('AutoColor: '+IntToStr(a));
  ColorToleranceSpeed(1);
end;

Colors I used:

Code:

---

procedure SetupColors;
begin
  Colors :=
 [4940956, 2970508, 4087437, 2904953, 4284815, 2965625, 4088199, 1919856, 3035757,
  2441070, 3957144, 4741772, 3232641, 2902133, 5267860, 3295088, 3758479, 2706034,
  4218516, 1918317, 4612493, 4677005, 4351370, 4544918, 3690640, 2573945, 2181240];    //Set your colors in here and hit play!
end;

---

---

Thats one sick array of colors :)

I had 10, from the same part of rock, from 10 different applets. Ill test it out and see how great it is :p, if it works well, you'll get a special place in my heart ;)

This is awsome dude. I get this error...

Quote:

---

Failed when compiling
Line 36: [Error] (36:13): Unknown type 'TStringArray' in script

---

What SRL am i supposed to be on?

Quote:

---

Originally Posted by Sumilion

The color of the copper rocks on the minimap :p

---

FindStoneColor will find the brown rocks on the minimap. I don't know if you're looking for that or something different, though...

FindRockColor finds the normal gray rocks on the minimap.

There is a FindStoneColor =O since when ? =S

3.8, don't you read the release notes?? :p

Quote:

---

Originally Posted by tarajunky

3.8, don't you read the release notes?? :p

---

Was probably during my exams :p

You know what, ill just give you both a special place in my heart :)

Quote:

---

Originally Posted by nielsie95

[SCAR] ColorToleranceSpeed(0);
FindColorsSpiralTolerance(MMCX, MMCY, Points, 5591896, MMX1, MMY1, MMX2, MMY2, 34);
if Length(Points) < 1 then Exit;

---

Hmm... now if it wont find it ... CTS will remain 0, bug ?

Sumilion, are you shuor u wanna say "50 pixels" thats huge!

No its not ... 50 pixels is (almost) a 7x7 square ... that all around the MM isnt much ...

Quote:

---

Originally Posted by lalaji

This is awsome dude. I get this error...


What SRL am i supposed to be on?

---

Oh damm.. it dosent use SRL. I feel so stupid.

So why do i get this error?

Quote:

---

Failed when compiling
Line 36: [Error] (36:13): Unknown type 'TStringArray' in script

---

Do you use Scar Divi?

I am pretty sure he isn't, as I get that error with v2.03.