SRL Archive - SRL Archives

Hey,
I have some nice procedures and functions I want to share with you all :), please post anything I could improve or change..

PleaseWait –> Returns true if there's Please Wait in the ChatScreen

function PleaseWait: Boolean;
var PlzWait: integer;
begin

  PlzWait := BitmapFromString(63, 2, 'z78DA33303030707373' +
       '727474B27044212D1D4D2D0C0D3064A12260596412531CA708865' +
       'D386DC12B82451C6217316C8A5D4EA60BF186214E1B8976272E73' +
       '70B90DBFCB89F22972D862A41F9CE2148433A62CA9210F0080F3B' +
       '0CA');

  if FindBitmapToleranceIn(PlzWait, x, y, MCX1, MCY1, MCX2, MCY2, 20) then Result := True;

FreeBitmap(PlzWait);
end;

HandleTalk –> Handles the talk with a NPC

procedure HandleTalk;
var c, i: integer;
begin
  repeat
   c := c +1;
    repeat
     Wait(500);
     i := 0;
     if PleaseWait then
     repeat
       Wait(500);
       i := i +1
     until ((not (PleaseWait)) or (i > 7))
    until not ClickToContinue;
   Wait(1000);
   if not ClickToContinue then Break;
  until c > 10;
end;

InTalk –> Returns True if you are talking to a NPC (works with most of them)

function InTalk: Boolean;
begin
  if FindColorTolerance(x, y, 128, 220, 360, 365, 370, 5) then
  Result := True;
end;

FindYew –> Finds a Yew for you :p , change colors to work with other Trees

function FindYew(var x, y: integer): Boolean;
var
  Points: TPointArray;
  I, Ci, Tol: Integer;
begin
  repeat
   if FindMSColorTol(x, y, 598048, Tol) then Break else Tol := Tol +2
  until Tol > 15
  if Tol > 15 then
  begin
    Result := False;
    exit;
    Tol := 0
  end else
  begin
    FindColorsSpiralTolerance(MSCX, MSCY, Points, 598048, MSX1 + 50, MSY1 + 30, MSX2 - 50, MSY2 - 50, tol)
    ci := 0;
    for I := 1 to GetArrayLength(Points) - 1 do
    begin
      if (Distance(Points[ci].x, 0, Points[i].x, 0) >= 2) and
        (Distance(0, Points[ci].y, 0, Points[i].y) >= 2) then
        ci := I
      else
      begin
        Points[I].x := 0;
        Points[I].y := 0;
      end;
    end;
    for i := 0 to GetArrayLength(Points) - 1 do
    begin
      if (Points[i].x <> 0) then
      if FindColorTolerance(x, y, 2373688, Points[i].x -5, Points[i].y -5, Points[i].x +5, Points[i].y +5, 5 +Tol) then
      if FindColorTolerance(x, y, 4159600, Points[i].x -5, Points[i].y -5, Points[i].x +5, Points[i].y +5, 5 +Tol) then
      if FindColorTolerance(x, y, 2900024, Points[i].x -5, Points[i].y -5, Points[i].x +5, Points[i].y +5, 5 +Tol) then
      begin
        MMouse(Points[i].x, Points[i].y, 0, 0)
          Wait(50);
        if (IsUpText('Yew')) then
        begin
          Status('Yew found at a Tol of ' +IntToStr(Tol));
          Result := True;
          Break;
        end;
      end;
    end;
    if (Result) then
    begin
      x := Points[i].x;
      y := Points[i].y;
    end;
  end;
  Tol := 0;
end;

FirstEmptySlot –> Returns the first empty slot, not sure if this is in SRL

function FirstEmptySlot: integer;
begin
  if(not(LoggedIn))then Exit;
  if (InvFull) then exit;
  Result := 0;
  repeat
    Result := Result + 1
  until(not ExistsItem(Result));
end;

GetBestAxe –> Gets your best axe out of the bank (make sure you run GetAllLevels first)

procedure GetBestAxe;
var RuneAxeMask, AddyAxeMask, MithAxeMask, SteelAxeMask, IronAxeMask, BronzeAxeMask, x ,y: integer;
begin
  Status('Getting the best axe from the bank');
  Wait(5000);

  RuneAxeMask := BitmapFromString(5, 10, 'z78DA958C410E80400803BF040' +
       'B6DC2D58DFEFF49EAE281E86A620F3DCC14448EA8DCFB8A37045B' +
       'EDBA71C742266728247ED8FCA920B6891DFCDBD24F5E3B37B6C2D' +
       '09F3C6FAD4330E125FAC2650704733B67');
  AddyAxeMask := BitmapFromString(5, 10, 'z78DA7D8BB10DC0200C0457B2F' +
       '11B899208F65F8944503C58E48A2FEE6C91179573175057282FDF' +
       '203990A6CF455DCA56E9EB56ADA3598F75FAFF9AF179DE5BDD7E2' +
       'B1EABD113D12C06E4823B85');
  MithAxeMask := BitmapFromString(5, 10, 'z78DA8D90410AC0200C04BF94B' +
       '08992A394FAFF27D5AAA5DB16A11BD8C34C02A2488BCADD8F6047' +
       'F58D9B374D4DBD0E9E425D82EDBC6AE341567ED9CE51503CAD6CB' +
       '293734F3BAEDEFC7A5546767C3965F91B0716F53C9C');;
  SteelAxeMask := BitmapFromString(5, 10, 'z78DA758E490E80300C03BFE4' +
       '40EB28D7B2FCFF49A48B5028604B3E8CDB24804B30E79066EEDC6' +
       '2C6375A74712B4F1E34C9B047DB78FFF5D1F6992B8BFBDD36AEA0' +
       '55DF2D62CB5479CC3EC16F51F7CC87FC96543D6F0C921F8E0BF2C' +
       '73C7F');
  IronAxeMask := BitmapFromString(5, 10, 'z78DA958C310E80300C03BFE40' +
       '863292355E9FF9F44A1194251073C78B8930DF418E68EEC1B2B6B' +
       'EE97151BDBE02A26787E8895B1F0F86D1FCE934E5F59E9E6B9878' +
       'DD5CC63DB5F457D798A2D382EE20F3C76');
  BronzeAxeMask := BitmapFromString(5, 10, 'z78DA33300002430374120A4' +
       'C9C8D1D8D8C90496435C8E2669686A6069658642D8CCD8D0CB0C8' +
       '82C5299135330189239310352626C626862E98E250BD48B298FEC' +
       '5150E1000001FB63B4E');

  if ((Players[CurrentPlayer].level[20]) >= 41) and (FindBitmapToleranceIn(RuneAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20)) then
  begin
    WriteLn('Rune Axe is found')
    Wait(1000);
    repeat
     Mouse(x, y, 1, 1, True);
     Wait(3000);
    until (FindBitmapToleranceIn(RuneAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
  end else

  if ((Players[CurrentPlayer].level[20]) >= 31) and (FindBitmapToleranceIn(AddyAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20)) then
  begin
    WriteLn('Addy Axe is found')
    Wait(1000);
    repeat
      Mouse(x, y, 1, 1, True);
      Wait(3000);
    until (FindBitmapToleranceIn(AddyAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
  end else

  if ((Players[CurrentPlayer].level[20]) >= 41) and (FindBitmapToleranceIn(MithAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20)) then
  begin
    WriteLn('Mithril Axe is found')
    repeat
      Mouse(x, y, 1, 1, True);
      Wait(3000);
    until (FindBitmapToleranceIn(MithAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
  end else

  if ((Players[CurrentPlayer].level[20]) >= 6) and (FindBitmapToleranceIn(SteelAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20)) then
  begin
    WriteLn('Steel Axe is found')
    Wait(1000);
    repeat
      Mouse(x, y, 1, 1, True);
      Wait(3000);
    until (FindBitmapToleranceIn(SteelAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
  end else

 if FindBitmapToleranceIn(IronAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20) then
 begin
   WriteLn('Iron Axe is found');
   Wait(1000);
   repeat
     Mouse(x, y, 1, 1, True);
     Wait(3000);
   until (FindBitmapToleranceIn(IronAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
 end else

  if FindBitmapToleranceIn(BronzeAxeMask, x, y, MSX1,MSY1,MSX2,MSY2,20) then
  begin
    WriteLn('Bronze Axe is found')
    Wait(1000);
    repeat
      Mouse(x, y, 1, 1, True);
      Wait(3000);
    until (FindBitmapToleranceIn(BronzeAxeMask, x, y, MIX1,MIY1,MIX2,MIY2,20))
  end

  FreeBitmap(RuneAxeMask);
  FreeBitMap(AddyAxeMask);
  FreeBitmap(MithAxeMask);
  FreeBitmap(SteelAxeMask);
  FreeBitmap(IronAxeMask);
  FreeBitMap(BronzeAxeMask);
end;

GetDirtColor –> Returns the DirtColor, this is a modified GetLadderColor of Boreas!! Credits go to him!!

function GetDirtColor: integer;
var
  TmpBmp,MyX,MyY:integer;
  MyColor,TmpInt,range: integer;
  MyCanvas:tcanvas;
  TmpBool:boolean;

begin
 repeat
  TmpBmp:= BitmapFromString(100,90,'');
  MyCanvas:=GetBitmapCanvas(TmpBmp)
  CopyCanvas(GetClientCanvas,MyCanvas,598,39,698,129,0,0,100,90)

  for MyY:=0 to 99 do
  begin
   for MyX:=0 to 89 do
    begin
      MyColor:= MyCanvas.pixels[MyX,MyY];
      if ((MyColor/256) / 256) < 35 +range then
      begin
        if ((MyColor/256) mod 256) <95 +range then
        begin
          if ((MyColor/256) mod 256) >50 -range then
          begin
            if (MyColor mod 256) < 110 +range then
            begin
              if (MyColor mod 256) > 60 -range then
              begin
                TmpInt:=HowManyAround(5, 3,MyX,MyY,MyColor,MyCanvas);
                if TmpInt>55 then
                begin
                  if TmpInt<65 then
                    TmpBool:=true;
                end;
              end;
            end;
          end;
        end;
      end;
      if TmpBool then break;
    end;
    if TmpBool then break;
  end;

  if TmpBool then
  begin
    result:=MyColor;
    exit;
  end else Range := Range +5;
 until Range > 10
end;

MMScannerTol –> Scans the MM in a specified direction, doesn't work to well I think..

Function MMScannerTol(var cx, cy: integer; Color: integer; Dir: string; xs, ys, xe, ye, tol: integer): Boolean;
var
  a, b, c, d: Integer;
  tx, ty: Integer;
begin
  Case LowerCase(dir) of
   'leftright' :
   begin
     Result := FindColorTolerance(tx, ty, color, xs, ys, xe, ye, tol)
     if (Result) then
     begin
       cx := tx;
       cy := ty;
       exit;
     end
   end;

   'rightleft' :
   begin
     a := xe - 1;
     b := ys;
     c := xe;
     d := ye;
      repeat
       if (FindColorTolerance(tx, ty, color, a, b, c, d, tol)) then Result := True;
       a := a - 1;
       c := c - 1;
      until (Result) or (a <= xs);
     if (Result) then
     begin
       cx := tx;
       cy := ty;
       exit;
     end
   end;

   'downup' :
   begin
     a := xs;
     b := ye - 1;
     c := xe;
     d := ye;
      repeat
       if (FindColorTolerance(tx, ty, color, a, b, c, d, tol)) then Result := True;
       b := b - 1;
       d := d - 1;
      until (Result) or (b <= ys);
     if (Result) then
     begin
       cx := tx;
       cy := ty;
       exit;
     end
   end;

   'updown' :
   begin
     a := xs;
     b := ys;
     c := xe;
     d := ys + 1;
      repeat
       if (FindColorTolerance(tx, ty, color, a, b, c, d, tol)) then Result := True;
       b := b + 1;
       d := d + 1;
      until (Result) or (d >= ye);
     if (Result) then
     begin
       cx := tx;
       cy := ty;
       exit;
     end
   end;
  end;
  Result := False;
end;

WalkToBankers –> Walks to the lowest banker in VW BANK ONLY

procedure WalkToBankers;
var ax, ay: integer;
begin

If(FindColorSpiralTolerance(ax, ay, 195836, 628, 80, 683, 126, 10)) then
  begin
    MouseFindFlag(ax - 9, ay, 0, -1)
    FFlag(1);
      If (FlagPresent) then Flag;
    Repeat
      If(FindColorSpiralTolerance(ax, ay, 195836, 651, 90, 660, 95, 10)) then
        begin
          MouseFindFlag(ax - 9, ay, 0, -1)
          FFlag(1);
          If (FlagPresent) then Flag;
        end;
    until(not(FindColorSpiralTolerance(ax, ay, 195836, 651, 90, 660, 95, 10)))
  end
end;

Most of them are actually really old functions :p, but tell me what you think of them :)

EDIT: Srry as this is probably the wrong forum? I think it should have been posted in Snippets?

some of these look pretty useful do they work good, no glitches and ect…
if so.. im proud of you :D
good job

Thanks! :)
Yes, most of them work good :p except for MMScannerTol, I'm not totally sure of that one.

im going to test your

function FindYew(var x, y: integer): Boolean;

if i like it can i place in my script ?
i am going to make a edgville yew banker…..

~SKy

That's why they are here for, you maybe need to change some colors though ;)

FindYew seems to be a modified version of something I've seen before.. because if you can get TPointArrays then you should of figured out a much better way to set GetBestAxe up (arrays, for to do…).

Nonetheless, your good, much respect for you.. lawl..

In your yew finder I noticed this:

begin
  result:=false
  exit;
  tol:=0
end;

It would never get to the Tol:=0 part because it exits the function.

These are still very great function. If I ever have any script that is relative to these I will definetley(sp) use

@WhiteShadow: Yes, it's a kind of modified version of FindObjEx (I think). And GetBestAxe is actually my very first own made procedure :D and could be done smaller I think, but it still works great :p

@bob: Oh lol, didn't notice that :duh:, pretty stupid yes. Thanks for noticing :)

actually i figured out somthing diffrent, thanks any way :p
nice functions / procedures.

in your FindYew function (I havent tested it but just from looking) i think that it wont work, unless you have Tol specified as a certain number somewhere after you list the variables but before you use it. Otherwise, it wont be able to add 2 onto anything… understand?? well just my advice from lookin

good work btw

If I understand you correct..: It will add 2 Tolerance to 0 at the begin :)

yeah, watever you set Tol to in the beginnning (you have to set it to somthin or it wont work) , then it will add to to that, then 2 to that, and so on until it finds the yew or goes over 15. Yeah, so just add in tol:=0 right there in the beginning. You have to declare it

No, run this:

program New;
var i: integer;
begin
  WriteLn('i = '+IntToStr(i));
  WriteLn('Now we are gonna add one');
  i := i +1;
  WriteLn('i = '+IntToStr(i));
end.

sure, that works lol. why dont you have to declare i though?? how does it kno i =0 in the first place?