ListUniqueColours & FindUniqueSymbolColour

**Daniel** · 08-23-2009, 10:49 AM

Can be useful.

Append to "\SRL\core\AutoColor.scar":

scar Code:

{*******************************************************************************
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
By: Dan's The Man
Description: Results a list of all the unique colours found within x1, y1 and x2,
             y2.
*******************************************************************************}
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
var
  cL, rL: Integer;
begin
  cL := 0;
  rL := 0;
  repeat
    if(CountColor(cL, x1, y1, x2, y2) = 1) then
    begin
      SetLength(Result, rL + 1);
      Result[rL] := cL;
      Inc(rL);
    end;
    Inc(cL);
  Until(cL > 16777215);
end;

{*******************************************************************************
function FindUniqueSymbolColour(BMP: Integer; x1, y1, x2, y2: Integer): Integer;
By: Dan's The Man
Description: Returns a unique colour from the bitmap BMP, results -1 if none
             found.
*******************************************************************************}
function FindUniqueSymbolColour(BMP: Integer; x1, y1, x2, y2: Integer): Integer;
var
  clw, clh, fx, fy: Integer;
  I, D: Integer;
  cmx, cmy: Integer;
  fB: Boolean;
begin
  Result := -1;
  GetBitmapSize(BMP, clw, clh);
  GetClientDimensions(cmx, cmy);
  if(FindBitmapIn(BMP, fx, fy, x1, y1, x2, y2)) then
  begin
    clw := fx + clw;
    clh := fy + clh;
    for I := fy to clh do
      for D := fx to clw do
      begin
        Result := GetColor(I, D);
        if(CountColor(Result, 0, 0, cmx, cmy) = 1) then
          Exit;
      end;
  end;
end;

**ian.** · 08-23-2009, 10:56 AM

[Runtime Error] : Out Of Range in line 10 in script

That's what I get when I try to run it. :/

**noidea** · 08-23-2009, 11:00 AM

SCAR Code:

{*******************************************************************************
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
By: Dan's The Man
Description: Results a list of all the unique colours found within x1, y1 and x2,
             y2.
*******************************************************************************}
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
var
  cL: Integer;
begin
  cL := 0;
  repeat
    if(CountColor(cL, x1, y1, x2, y2) = 1) then
    begin
      SetArrayLength(Result, Length(Result) + 1);
      Result[Length(result)] := cL;
    end;
    Inc(cL);
  Until(cL > 16777215);
end;

I also eliminated a var

**Daniel** · 08-23-2009, 11:01 AM

Originally Posted by ian.

[Runtime Error] : Out Of Range in line 10 in script

That's what I get when I try to run it. :/

Right.

Fixed

Originally Posted by noidea

SCAR Code:

{*******************************************************************************
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
By: Dan's The Man
Description: Results a list of all the unique colours found within x1, y1 and x2,
             y2.
*******************************************************************************}
function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
var
  cL: Integer;
begin
  cL := 0;
  repeat
    if(CountColor(cL, x1, y1, x2, y2) = 1) then
    begin
      SetArrayLength(Result, Length(Result) + 1);
      Result[Length(result)] := cL;
    end;
    Inc(cL);
  Until(cL > 16777215);
end;

I also eliminated a var

Mine be a tad bit faster

But thanks anyways

(BTW, i had noidea you could do that?

)

**MylesMadness** · 08-23-2009, 11:05 AM

SCAR Code:

function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;
var
  P: TPointArray;
begin
  FindColorsTolerance(P, 0, x1, y1, x2, y2, 442{max CTS 1 tol, I think its that});
  Result:=GetColors(P);
  ClearSameIntegers(Result);
end;

**noidea** · 08-23-2009, 11:05 AM

Originally Posted by Dan's The Man

Right.

Fixed

Mine be a tad bit faster

But thanks anyways

(BTW, i had noidea you could do that?

)

Yea i was about to edit it and store High() in a var, because EC! tells me its faster. but I refreshed and saw that you already fixed.

btw I really like that function ^.^ I feel it could be used

**tarajunky** · 08-23-2009, 12:05 PM

From 2006. Still going strong.

Maybe I'll add this one to the repos...

Code:

function FindUniqueMMSymbolColor(Name:string):boolean;
var x1,y1,x2,y2,TestColor,x,y,L,i,Symbol:integer;
var Points:array of TPoint;
var UniqueColor:boolean;
begin
  if not(LoggedIn) then Exit;
  SymbolAccuracy:=0.6;
  if FindSymbol(x,y,'churn') then
  begin
    Writeln('Churn symbol found at '+IntToStr(x)+','+IntToStr(y));
    Symbol := BitmapFromString(15, 15, 'z78DA3330C00B0CF142' +
       '5201925E4753470B27134C255071E26DC16B1A2E80620B95CC24C' +
       'A7CF2C20D574852C9B514853F056960289A4C9370A65DDAA0757A' +
       'A65D1EA475B941D5B20E00B5A601F8');
    if x-20<MMX1 then x:=MMX1+20;
    if y-20<MMY1 then y:=MMY1+20;
    if x+20>MMX2 then x:=MMX2-20;
    if y+20>MMY2 then y:=MMY2-20;
    if FindBitmapToleranceIn(Symbol,x1,y1,x-20,y-20,x+20,y+20,100) then
    begin
      Writeln('Found BMP at '+IntToStr(x1)+','+IntToStr(y1));
      x:=x1+7;
      y:=y1+7;
      x2:=x1+14;
      y2:=y1+14;
    end else
    begin
      Writeln('No BMP found');
      x1:=x-8;
      y1:=y-8;
      x2:=x+15;
      y2:=y+15;
    end;
    FreeBitmap(Symbol);
    Result:=True;
    if (lowercase(Name)='churn') then
    begin
      Writeln('Searching '+IntToStr(x1)+','+IntToStr(y1)+'  '+IntToStr(x2)+','+IntToStr(y2));
      FindColorsSpiralTolerance(x,y,Points,1588313,X1,Y1,X2,Y2,60);
      UniqueColor:=True;
      L:=GetArrayLength(Points);
      for i:= 0 to L-1 do
      begin
        Wait(1);
        UniqueColor:=True;
        TestColor:=GetColor(Points[i].x,Points[i].y);
        if Findcolor(tmpx,tmpy,TestColor,MMX1,MMY1,x1-1,MMY2) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x2+1,MMY1,MMX2,MMY2) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x1,MMY1,x2,y1-1) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x1,y2+1,x2,MMY2) then UniqueColor:=False;
        if (UniqueColor) then
        begin
          ChurnColor:=Testcolor;
          Writeln('Unique Symbol Color '+inttostr(TestColor)+' found at '+inttostr(x)+', '+inttostr(y));
          ChurnX:=x;
          ChurnY:=y;
          Exit;
        end;
      end;
      Writeln('No unique symbol colors found!?');
      ChurnColor:=0;
    end;
  end else
  begin
    Writeln('No symbol detected on Minimap!');
    Result:=False;
  end;
end;

**noidea** · 08-23-2009, 12:07 PM

There wont always be a churn symbol Tara ~.^

**Daniel** · 08-23-2009, 01:07 PM

Originally Posted by tarajunky

From 2006. Still going strong.

Maybe I'll add this one to the repos...

Code:

function FindUniqueMMSymbolColor(Name:string):boolean;
var x1,y1,x2,y2,TestColor,x,y,L,i,Symbol:integer;
var Points:array of TPoint;
var UniqueColor:boolean;
begin
  if not(LoggedIn) then Exit;
  SymbolAccuracy:=0.6;
  if FindSymbol(x,y,'churn') then
  begin
    Writeln('Churn symbol found at '+IntToStr(x)+','+IntToStr(y));
    Symbol := BitmapFromString(15, 15, 'z78DA3330C00B0CF142' +
       '5201925E4753470B27134C255071E26DC16B1A2E80620B95CC24C' +
       'A7CF2C20D574852C9B514853F056960289A4C9370A65DDAA0757A' +
       'A65D1EA475B941D5B20E00B5A601F8');
    if x-20<MMX1 then x:=MMX1+20;
    if y-20<MMY1 then y:=MMY1+20;
    if x+20>MMX2 then x:=MMX2-20;
    if y+20>MMY2 then y:=MMY2-20;
    if FindBitmapToleranceIn(Symbol,x1,y1,x-20,y-20,x+20,y+20,100) then
    begin
      Writeln('Found BMP at '+IntToStr(x1)+','+IntToStr(y1));
      x:=x1+7;
      y:=y1+7;
      x2:=x1+14;
      y2:=y1+14;
    end else
    begin
      Writeln('No BMP found');
      x1:=x-8;
      y1:=y-8;
      x2:=x+15;
      y2:=y+15;
    end;
    FreeBitmap(Symbol);
    Result:=True;
    if (lowercase(Name)='churn') then
    begin
      Writeln('Searching '+IntToStr(x1)+','+IntToStr(y1)+'  '+IntToStr(x2)+','+IntToStr(y2));
      FindColorsSpiralTolerance(x,y,Points,1588313,X1,Y1,X2,Y2,60);
      UniqueColor:=True;
      L:=GetArrayLength(Points);
      for i:= 0 to L-1 do
      begin
        Wait(1);
        UniqueColor:=True;
        TestColor:=GetColor(Points[i].x,Points[i].y);
        if Findcolor(tmpx,tmpy,TestColor,MMX1,MMY1,x1-1,MMY2) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x2+1,MMY1,MMX2,MMY2) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x1,MMY1,x2,y1-1) then UniqueColor:=False else
        if Findcolor(tmpx,tmpy,TestColor,x1,y2+1,x2,MMY2) then UniqueColor:=False;
        if (UniqueColor) then
        begin
          ChurnColor:=Testcolor;
          Writeln('Unique Symbol Color '+inttostr(TestColor)+' found at '+inttostr(x)+', '+inttostr(y));
          ChurnX:=x;
          ChurnY:=y;
          Exit;
        end;
      end;
      Writeln('No unique symbol colors found!?');
      ChurnColor:=0;
    end;
  end else
  begin
    Writeln('No symbol detected on Minimap!');
    Result:=False;
  end;
end;

Yes, but that's for the churn symbol

And not just any bitmap xD (maybe i should "s/symbol/bitmap/"?).

**tarajunky** · 08-23-2009, 01:25 PM

Hmm. Still thinking about it. May commit later tonight.

**Daniel** · 08-23-2009, 01:26 PM

Originally Posted by tarajunky

Hmm. Still thinking about it. May commit later tonight.

Mine or yours?

**tarajunky** · 08-23-2009, 01:28 PM

Mine, of course.

**Daniel** · 08-23-2009, 01:31 PM

Originally Posted by tarajunky

Mine, of course.

>

**tarajunky** · 08-23-2009, 01:47 PM

Ok, to be fair I'll admit that it might rarely be useful to find other symbols besides the Churn.

That said, I prefer Myles' approach to ListUniqueColors. Also, I'm not sure that your FindUniqueSymbolColour would work correctly, what it would do if there weren't any unique colors, and why it's not a generic BMP function rather than a Symbol function.

And yes, I was just joking about committing my 100+ line function, lol.

**Daniel** · 08-23-2009, 02:14 PM

Originally Posted by tarajunky

Ok, to be fair I'll admit that it might rarely be useful to find other symbols besides the Churn.

That said, I prefer Myles' approach to ListUniqueColors. Also, I'm not sure that your FindUniqueSymbolColour would work correctly, what it would do if there weren't any unique colors, and why it's not a generic BMP function rather than a Symbol function.

And yes, I was just joking about committing my 100+ line function, lol.

It could be used for other things

And i do agree, that Myles has a better and faster approach. However, it doesn't list the unique colours. It lists every colour, found, deleting the duplicates. And FindUniqueSymbolColour does work correctly.. And it'll return -1 if no unique colour was found.. And i dunno why it isn't a generic bitmap function xD As i stated, that i might change the name from Symbol to Bitmap

**n3ss3s** · 08-23-2009, 07:00 PM

pascal Code:

Function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;

Var
   I, L: Integer;
   C: TIntegerArray;
Begin
  SetArrayLength(Result, 1 shl 20);
  C := GetColors(TPAFromBox(IntToBox(x1, y1, x2, y2)));
  For I := 0 To High(C) Do
    If CountColor(C, x1, y1, x2, y2) = 1 Then
    Begin
      Result[l] := C;
      L := L + 1;
    End;
  SetArrayLength(Result, L);
End;

**marpis** · 08-23-2009, 10:23 PM

Originally Posted by n3ss3s

pascal Code:

Function ListUniqueColours(x1, y1, x2, y2: Integer): TIntegerArray;

Var
   I, L: Integer;
   C: TIntegerArray;
Begin
  SetArrayLength(Result, 1 shl 20);
  C := GetColors(TPAFromBox(IntToBox(x1, y1, x2, y2)));
  For I := 0 To High(C) Do
    If CountColor(C, x1, y1, x2, y2) = 1 Then
    Begin
      Result[l] := C;
      L := L + 1;
    End;
  SetArrayLength(Result, L);
End;

if you search box size over 1024*1024 with every pixel of different color, it will give you out of range

omg omg

not rly, should be commited (if it isn't already)

**MylesMadness** · 08-23-2009, 10:30 PM

Originally Posted by Dan's The Man

It could be used for other things

And i do agree, that Myles has a better and faster approach. However, it doesn't list the unique colours. It lists every colour, found, deleting the duplicates. And FindUniqueSymbolColour does work correctly.. And it'll return -1 if no unique colour was found.. And i dunno why it isn't a generic bitmap function xD As i stated, that i might change the name from Symbol to Bitmap

Oh, I miss understood what you wanted to do.

**n3ss3s** · 08-23-2009, 11:22 PM

if you search box size over 1024*1024 with every pixel of different color, it will give you out of range omg omg

Functions posted here are for SRL, which means they are mainly for RuneScape, and runescape is 5xx * 7xx.

Thread: ListUniqueColours & FindUniqueSymbolColour

Thread Tools

ListUniqueColours & FindUniqueSymbolColour

Thread Information

Users Browsing this Thread

Posting Permissions