SRL Archive - SRL Archives

;) Can be useful.

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

{*******************************************************************************
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;

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

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

{*******************************************************************************
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 :)

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

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

Right.

Fixed ;)

From: noidea

{*******************************************************************************
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 :)

:o

Mine be a tad bit faster :p

But thanks anyways :p

(BTW, i had noidea you could do that? :o)

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;

[QUOTE=Dan's The Man;619691]Right.

Fixed ;)



:o

Mine be a tad bit faster :p

But thanks anyways :p

(BTW, i had noidea you could do that? :o)[/QUOTE]

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 :)

From 2006. Still going strong.

Maybe I'll add this one to the repos… :norris:

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;

There wont always be a churn symbol Tara ~.^

From: tarajunky
From 2006. Still going strong.

Maybe I'll add this one to the repos… :norris:

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/"?).

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

From: tarajunky
Hmm. Still thinking about it. May commit later tonight.

Mine or yours? :D

Mine, of course.

From: tarajunky
Mine, of course.

>:(

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.

From: 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 ;)

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;

From: n3ss3s

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 :eek: omg omg

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

[QUOTE=Dan's The Man;619754]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.

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.