Results 1 to 13 of 13

Thread: last steps...

  1. #1
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default last steps...

    ok guys so it's going pretty well with my script for except 1 thing.

    It compiles and stuff and it runs until it reaches the point where it needs to walk then i am getting this crazy error:

    a new tab opens with the name simba and this is what happens:
    problem 7.png


    here is the script i made

    Simba Code:
    Program New;
    {$i SRL/SRL.simba}

    var
    Inventory:TBoxArray;

    function ExplodeBox(bx: TBox; rows, columns: integer): TBoxArray;
    var
      r, c, w, h, ew, eh, ow, oh, i, x, y: integer;
    begin
      if ((rows > 0) and (columns > 0) and (bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2)) then
      begin
        w := ((bx.X2 - bx.X1) + 1);
        h := ((bx.Y2 - bx.Y1) + 1);
        if (rows < 1) then
          rows := 1
        else
          if (rows > h) then
            rows := h;
        if (columns < 1) then
          columns := 1
        else
          if (columns > w) then
            columns := w;
        w := (w div columns);
        h := (h div rows);
        ew := (((bx.X2 - bx.X1) + 1) - (w * columns));
        eh := (((bx.Y2 - bx.Y1) + 1) - (h * rows));
        SetLength(Result, (rows * columns));
        y := bx.Y1;
        for r := 0 to (rows - 1) do
        begin
          x := bx.X1;
          if ((eh > 0) and (r < eh)) then
            oh := 1
          else
            oh := 0;
          for c := 0 to (columns - 1) do
          begin
            if ((ew > 0) and (c < ew)) then
              ow := 1
            else
              ow := 0;
            i := ((r * columns) + c);
            Result[i].X1 := x;
            Result[i].X2 := (x + (w - 1) + ow);
            Result[i].Y1 := y;
            Result[i].Y2 := (y + (h - 1) + oh);
            x := (Result[i].X2 + 1);
          end;
          y := (Result[i].Y2 + 1);
        end;
      end else
        SetLength(Result, 0);
    end;

    procedure RSPS_SetInventory;
    begin
    Inventory := ExplodeBox(IntToBox(549, 206, 733, 465), 7, 4);
     end;

     function rsps_slotFull(slot:Integer):Boolean;
    var
      x, y:Integer;
    begin
      if FindColor(x, y, 65536, Inventory[slot].x1, Inventory[slot].y1, Inventory[slot].x2, Inventory[slot].y2) then
        result := true;
    end;

    function rsps_Invcount:Integer;
    var
      i:Integer;
    begin
     for i := 0 to high(Inventory) do
      begin
        if rsps_slotFull(i) then
          result := result + 1;
      end;
    end;

    function RSPS_InvFull:Boolean;
    begin
      result := (rsps_invcount = 28);
    end;

    Function RSPS_GetUpText: String;
    Var
      WhiteT,BlueT,YellowT,OrangeT,FoundText: String;
    Begin
      WhiteT:=GetTextAtExWrap(8, 8, 80, 21, 0, 5, 1, 14541281, 55, 'RSPS');
      BlueT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 13423640, 65, 'RSPS');
      YellowT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 1235160, 40, 'RSPS');
      OrangeT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 4687583, 53, 'RSPS');
      FoundText:=WhiteT + ' ' + BlueT + YellowT + OrangeT;
      FoundText:= ReplaceWrap(FoundText, '.', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '/', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '\', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, ',', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '*', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '^', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '"', '',[rfReplaceAll]);
      Result:=FoundText;
    End;

    function LoadDTMWalk(WalkNumber: Integer): Integer;
    var
      dtmMainPoint: TDTMPointDef;
      dtmSubPoints: array[0..3] of TDTMPointDef;
      TempTDTM: TDTM;
    begin
      case WalkNumber of
        1: begin
         dtmMainPoint.x := 863;
      dtmMainPoint.y := 206;
      dtmMainPoint.AreaSize := 0;
      dtmMainPoint.AreaShape := 0;
      dtmMainPoint.Color := 6712945;
      dtmMainPoint.Tolerance := 0;

      dtmSubPoints[0].x := 863;
      dtmSubPoints[0].y := 206;
      dtmSubPoints[0].AreaSize := 0;
      dtmSubPoints[0].AreaShape := 0;
      dtmSubPoints[0].Color := 6712945;
      dtmSubPoints[0].Tolerance := 0;

      dtmSubPoints[1].x := 882;
      dtmSubPoints[1].y := 195;
      dtmSubPoints[1].AreaSize := 0;
      dtmSubPoints[1].AreaShape := 0;
      dtmSubPoints[1].Color := 7513283;
      dtmSubPoints[1].Tolerance := 0;

      dtmSubPoints[2].x := 858;
      dtmSubPoints[2].y := 184;
      dtmSubPoints[2].AreaSize := 0;
      dtmSubPoints[2].AreaShape := 0;
      dtmSubPoints[2].Color := 8001204;
      dtmSubPoints[2].Tolerance := 0;

      dtmSubPoints[3].x := 844;
      dtmSubPoints[3].y := 194;
      dtmSubPoints[3].AreaSize := 0;
      dtmSubPoints[3].AreaShape := 0;
      dtmSubPoints[3].Color := 4408393;
      dtmSubPoints[3].Tolerance := 0;

      TempTDTM.MainPoint := dtmMainPoint;
      TempTDTM.SubPoints := dtmSubPoints;
      Result := AddDTM(TempTDTM);

      FreeDTM(LoadDTMWalk(1));
    end;
    end;
    end;

    function WalkToPlace: Boolean;
    var
      WalkDTM, x, y: integer; // Calls the WalkDTM making walking simpler.
      aFound: extended;
    begin
      WalkDTM := LoadDTMWalk(1); //Load which DDTM you want to find.
      if FindDTMRotated(WalkDTM, X, Y, MMx1,MMy1,MMx2,MMy2, -Pi/2, Pi/2, Pi/30, aFound) then // Find the DDTM using Find DTM
      begin
        Mouse(X, Y, 3, 3, True);
        FFlag(0);
        Writeln('Thief Point 1 done');
      end else // else it will do this...
        Writeln('failed find dtm');
          end;



    function StallColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.05, 0.09);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 10728640, MSX1, MSY1, MSX2, MSY2, 16);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 27.16) and (X <= 67.46) and (Y >= 27.98) and (Y <= 70.66) and (Z >= 20.78) and (Z <= 71.06) then
        begin
          Result := arC[i];
          //Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        //Writeln('AutoColor failed in finding the color.');
    end;

    function FindObjTPA2(var X, Y: Integer; Color, Tol, CTS, ObjWidth, ObjHeight, minCount: Integer; UpText: string): Boolean;
    var
      I, tCTS: Integer;
      myPoint: TPoint;
      Points: TPointArray;
      aPoints: T2DPointArray;
    begin
      Result := False;

      tCTS := GetColorToleranceSpeed;
      CTS := Integer(CTS * 9 mod 3 <> 0);
      ColorToleranceSpeed(CTS);
      FindColorsSpiralTolerance(X, Y, Points, Color, MSX1, MSY1, MSX2, MSY2, Tol);
      if Length(Points) = 0 then
      begin
        //writeln('findObjTPA(): Found no colors.... exiting');
        ColorToleranceSpeed(tCTS);
        Exit;
      end;
      ColorToleranceSpeed(1);
      aPoints := TPAtoATPAEx(Points, ObjWidth, ObjHeight);
      SetLength(Points, 0);
      for I := 0 to High(aPoints) do
      begin
        if Length(aPoints[i]) < minCount then
          Continue;
        myPoint := MiddleTPA(aPoints[i]);
        MMouse(myPoint.X, myPoint.Y, 0, 0);
        wait(100 + random(50));

        if (pos(upText, RSPS_GetUptext) > 0) then
        begin
          //writeln('findObjTPA(): We found the object!');
          GetMousePos(X, Y);
          Result := True;
          ColorToleranceSpeed(tCTS);
          Exit;
        end else
          //writeln('findObjTPA(): Did not find the uptext... :<');
      end;
      ColorToleranceSpeed(tCTS);
    end;


    procedure Steal;
    var
      X, Y: Integer;
    begin
      repeat
      if FindObjTPA2(X, Y, StallColor, 5, 1, 41, 21, 23, 'em') then
        clickMouse2(MOUSE_LEFT);
      until(RSPS_InvFull);
    end;

    procedure Walk;
    begin
    if RSPS_InvFull then
    WalkToPlace;
    end;

    begin
      RSPS_SetInventory;
      Writeln(RSPS_GetUpText);
      MouseSpeed := 12;
      Steal();
      Writeln('Inventory count: ' + ToStr(rsps_Invcount));
      if (rsps_invFull) then
        Writeln('Inventory Full!');
      Walk;
    end.



    what is going on guys? how to fix this?

  2. #2
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    pls guys what is this?

  3. #3
    Join Date
    Feb 2012
    Location
    Discord
    Posts
    3,114
    Mentioned
    37 Post(s)
    Quoted
    538 Post(s)

    Default

    try force updating srl report results

  4. #4
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    idk if that will help because i don't use srl as i am scripting for a rsps. + idk how to do it. i force updated simba... and that didn't work

  5. #5
    Join Date
    Feb 2012
    Location
    Discord
    Posts
    3,114
    Mentioned
    37 Post(s)
    Quoted
    538 Post(s)

    Default

    {$i SRL/SRL.simba} means you are using srl.
    and to force update go onto simba, go into srl, go to options and force update ticked. then click update.

  6. #6
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    tried it, same error.

  7. #7
    Join Date
    Jul 2012
    Posts
    437
    Mentioned
    10 Post(s)
    Quoted
    165 Post(s)

    Default

    Quote Originally Posted by hete taart View Post
    tried it, same error.
    You aren't freeing you dtms correctly. The access violation is likely because your computer ran out of free memory. You are looping this function, I commented the problem line for you.
    Simba Code:
    function LoadDTMWalk(WalkNumber: Integer): Integer;
    var
      dtmMainPoint: TDTMPointDef;
      dtmSubPoints: array[0..3] of TDTMPointDef;
      TempTDTM: TDTM;
    begin
      case WalkNumber of
        1: begin
         dtmMainPoint.x := 863;
      dtmMainPoint.y := 206;
      dtmMainPoint.AreaSize := 0;
      dtmMainPoint.AreaShape := 0;
      dtmMainPoint.Color := 6712945;
      dtmMainPoint.Tolerance := 0;

      dtmSubPoints[0].x := 863;
      dtmSubPoints[0].y := 206;
      dtmSubPoints[0].AreaSize := 0;
      dtmSubPoints[0].AreaShape := 0;
      dtmSubPoints[0].Color := 6712945;
      dtmSubPoints[0].Tolerance := 0;

      dtmSubPoints[1].x := 882;
      dtmSubPoints[1].y := 195;
      dtmSubPoints[1].AreaSize := 0;
      dtmSubPoints[1].AreaShape := 0;
      dtmSubPoints[1].Color := 7513283;
      dtmSubPoints[1].Tolerance := 0;

      dtmSubPoints[2].x := 858;
      dtmSubPoints[2].y := 184;
      dtmSubPoints[2].AreaSize := 0;
      dtmSubPoints[2].AreaShape := 0;
      dtmSubPoints[2].Color := 8001204;
      dtmSubPoints[2].Tolerance := 0;

      dtmSubPoints[3].x := 844;
      dtmSubPoints[3].y := 194;
      dtmSubPoints[3].AreaSize := 0;
      dtmSubPoints[3].AreaShape := 0;
      dtmSubPoints[3].Color := 4408393;
      dtmSubPoints[3].Tolerance := 0;

      TempTDTM.MainPoint := dtmMainPoint;
      TempTDTM.SubPoints := dtmSubPoints;
      Result := AddDTM(TempTDTM);

      //FreeDTM(LoadDTMWalk(1));//you are calling freedtm on the function not the actual dtm, this function is an infinite recursive(calls itself) loop of creating dtms. I am fairly sure you don't want to free your dtm here anyways.
    end;
    end;
    end;

  8. #8
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    so where should i free it or shouldn't i?

  9. #9
    Join Date
    Sep 2012
    Location
    Netherlands
    Posts
    2,752
    Mentioned
    193 Post(s)
    Quoted
    1468 Post(s)

    Default

    Quote Originally Posted by hete taart View Post
    so where should i free it or shouldn't i?
    if you call your dtm once, add it on terminate. if you call it everytime at the start of your procedure you should free them at the end of your procedure (before it exits your procedure)

  10. #10
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    ok so now i got it so far that it walks but right after it walks i get this error:

    problem 8.jpg

    here's my new script

    Simba Code:
    Program New;
    {$i SRL/SRL.simba}

    var
    Inventory:TBoxArray;

    function ExplodeBox(bx: TBox; rows, columns: integer): TBoxArray;
    var
      r, c, w, h, ew, eh, ow, oh, i, x, y: integer;
    begin
      if ((rows > 0) and (columns > 0) and (bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2)) then
      begin
        w := ((bx.X2 - bx.X1) + 1);
        h := ((bx.Y2 - bx.Y1) + 1);
        if (rows < 1) then
          rows := 1
        else
          if (rows > h) then
            rows := h;
        if (columns < 1) then
          columns := 1
        else
          if (columns > w) then
            columns := w;
        w := (w div columns);
        h := (h div rows);
        ew := (((bx.X2 - bx.X1) + 1) - (w * columns));
        eh := (((bx.Y2 - bx.Y1) + 1) - (h * rows));
        SetLength(Result, (rows * columns));
        y := bx.Y1;
        for r := 0 to (rows - 1) do
        begin
          x := bx.X1;
          if ((eh > 0) and (r < eh)) then
            oh := 1
          else
            oh := 0;
          for c := 0 to (columns - 1) do
          begin
            if ((ew > 0) and (c < ew)) then
              ow := 1
            else
              ow := 0;
            i := ((r * columns) + c);
            Result[i].X1 := x;
            Result[i].X2 := (x + (w - 1) + ow);
            Result[i].Y1 := y;
            Result[i].Y2 := (y + (h - 1) + oh);
            x := (Result[i].X2 + 1);
          end;
          y := (Result[i].Y2 + 1);
        end;
      end else
        SetLength(Result, 0);
    end;

    procedure RSPS_SetInventory;
    begin
    Inventory := ExplodeBox(IntToBox(549, 206, 733, 465), 7, 4);
     end;

     function rsps_slotFull(slot:Integer):Boolean;
    var
      x, y:Integer;
    begin
      if FindColor(x, y, 65536, Inventory[slot].x1, Inventory[slot].y1, Inventory[slot].x2, Inventory[slot].y2) then
        result := true;
    end;

    function rsps_Invcount:Integer;
    var
      i:Integer;
    begin
     for i := 0 to high(Inventory) do
      begin
        if rsps_slotFull(i) then
          result := result + 1;
      end;
    end;

    function RSPS_InvFull:Boolean;
    begin
      result := (rsps_invcount = 28);
    end;

    Function RSPS_GetUpText: String;
    Var
      WhiteT,BlueT,YellowT,OrangeT,FoundText: String;
    Begin
      WhiteT:=GetTextAtExWrap(8, 8, 80, 21, 0, 5, 1, 14541281, 55, 'RSPS');
      BlueT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 13423640, 65, 'RSPS');
      YellowT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 1235160, 40, 'RSPS');
      OrangeT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 4687583, 53, 'RSPS');
      FoundText:=WhiteT + ' ' + BlueT + YellowT + OrangeT;
      FoundText:= ReplaceWrap(FoundText, '.', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '/', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '\', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, ',', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '*', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '^', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '"', '',[rfReplaceAll]);
      Result:=FoundText;
    End;

    Function P06_IsUpTextMultiCustom(Text: TStringArray): Boolean;
    Var
      TheText: String;
      i, n: Integer;
    Begin
      TheText := RSPS_GetUpText;
      n := High(Text);
      For i := 0 to n do
        If (Pos(Text[i], TheText) > 0) then
        Begin
          Result := True;
          Exit;
        End;
    End;

    function ThiefColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.12, 0.83);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 928571, MSX1, MSY1, MSX2, MSY2, 2);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 2.24) and (X <= 3.30) and (Y >= 2.21) and (Y <= 3.21) and (Z >= 0.64) and (Z <= 0.91) then
        begin
          Result := arC[i];
          Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        Writeln('AutoColor failed in finding the color.');
    end;

    Function TalkingToThief: Boolean;

    Var
       TPAA: T2DPointArray; // The Variables of the Functions
       TPA: TPointArray;
       CTS, I, Retry: Integer;
       x, y:Integer;
    Begin
      CTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      FindColorsSpiralTolerance(MSCX, MSCY, TPA, ThiefColor, MSX1, MSY1, MSX2, MSY2, 7); // Enter the Color and Tolerance Here at the Right place.
      ColorToleranceSpeed(CTS);
      TPAA := TPAToATPAEx(TPA, 4, 3); //Put the Width and Heigh here
      SortATPASize(TPAA, True);
      For I := 0 To High(TPAA) Do
        If GetArraylength(TPAA[i]) > 5 Then // Set How Much Points you need for your function to take Action
        Begin
        repeat
          inc(Retry);
          MiddleTPAEx(TPAA[i], x, y);
          MMouse(X, Y, 3, 3);
           if (IsUpTextMultiCustom(['artin'])) then // Enter The name of Your NPC or Monster
          Begin
            Result := True;
            GetMousePos(X, Y);
            mouse(x,y,3,3,false);
            wait(100 + random(200));
          ChooseOption('rade');
          wait(5000 + random(1000));
            Break;
          End;
          until (Retry = 15);
          Break;
          end;
          end;

    function LoadDTMWalk(WalkNumber: Integer): Integer;
    var
      dtmMainPoint: TDTMPointDef;
      dtmSubPoints: array[0..3] of TDTMPointDef;
      TempTDTM: TDTM;
    begin
      case WalkNumber of
        1: begin
            dtmMainPoint.x := 621;
      dtmMainPoint.y := 164;
      dtmMainPoint.AreaSize := 3;
      dtmMainPoint.AreaShape := 0;
      dtmMainPoint.Color := 4477277;
      dtmMainPoint.Tolerance := 0;

      dtmSubPoints[0].x := 621;
      dtmSubPoints[0].y := 164;
      dtmSubPoints[0].AreaSize := 3;
      dtmSubPoints[0].AreaShape := 0;
      dtmSubPoints[0].Color := 4477277;
      dtmSubPoints[0].Tolerance := 0;

      dtmSubPoints[1].x := 669;
      dtmSubPoints[1].y := 151;
      dtmSubPoints[1].AreaSize := 3;
      dtmSubPoints[1].AreaShape := 0;
      dtmSubPoints[1].Color := 242;
      dtmSubPoints[1].Tolerance := 35;

      dtmSubPoints[2].x := 629;
      dtmSubPoints[2].y := 130;
      dtmSubPoints[2].AreaSize := 3;
      dtmSubPoints[2].AreaShape := 0;
      dtmSubPoints[2].Color := 15069671;
      dtmSubPoints[2].Tolerance := 35;

      dtmSubPoints[3].x := 597;
      dtmSubPoints[3].y := 140;
      dtmSubPoints[3].AreaSize := 3;
      dtmSubPoints[3].AreaShape := 0;
      dtmSubPoints[3].Color := 4477277;
      dtmSubPoints[3].Tolerance := 35;

      TempTDTM.MainPoint := dtmMainPoint;
      TempTDTM.SubPoints := dtmSubPoints;
      Result := AddDTM(TempTDTM);
    end;
    end;
    end;

    function WalkToPlace: Boolean;
    var
      WalkDTM, x, y: integer; // Calls the WalkDTM making walking simpler.
      aFound: extended;
    begin
      WalkDTM := LoadDTMWalk(1); //Load which DDTM you want to find.
      if FindDTMRotated(WalkDTM, X, Y, MMx1,MMy1,MMx2,MMy2, -Pi/2, Pi/2, Pi/30, aFound) then // Find the DDTM using Find DTM
      begin
        Mouse(X, Y, 3, 3, True);
        FFlag(0);
        Writeln('Thief Point 1 done');
      end else // else it will do this...
        Writeln('failed find dtm');
          end;



    function StallColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.05, 0.09);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 10728640, MSX1, MSY1, MSX2, MSY2, 16);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 27.16) and (X <= 67.46) and (Y >= 27.98) and (Y <= 70.66) and (Z >= 20.78) and (Z <= 71.06) then
        begin
          Result := arC[i];
          //Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        //Writeln('AutoColor failed in finding the color.');
    end;

    function FindObjTPA2(var X, Y: Integer; Color, Tol, CTS, ObjWidth, ObjHeight, minCount: Integer; UpText: string): Boolean;
    var
      I, tCTS: Integer;
      myPoint: TPoint;
      Points: TPointArray;
      aPoints: T2DPointArray;
    begin
      Result := False;

      tCTS := GetColorToleranceSpeed;
      CTS := Integer(CTS * 9 mod 3 <> 0);
      ColorToleranceSpeed(CTS);
      FindColorsSpiralTolerance(X, Y, Points, Color, MSX1, MSY1, MSX2, MSY2, Tol);
      if Length(Points) = 0 then
      begin
        //writeln('findObjTPA(): Found no colors.... exiting');
        ColorToleranceSpeed(tCTS);
        Exit;
      end;
      ColorToleranceSpeed(1);
      aPoints := TPAtoATPAEx(Points, ObjWidth, ObjHeight);
      SetLength(Points, 0);
      for I := 0 to High(aPoints) do
      begin
        if Length(aPoints[i]) < minCount then
          Continue;
        myPoint := MiddleTPA(aPoints[i]);
        MMouse(myPoint.X, myPoint.Y, 0, 0);
        wait(100 + random(50));

        if (pos(upText, RSPS_GetUptext) > 0) then
        begin
          //writeln('findObjTPA(): We found the object!');
          GetMousePos(X, Y);
          Result := True;
          ColorToleranceSpeed(tCTS);
          Exit;
        end else
          //writeln('findObjTPA(): Did not find the uptext... :<');
      end;
      ColorToleranceSpeed(tCTS);
    end;


    procedure Steal;
    var
      X, Y: Integer;
    begin
      repeat
      if FindObjTPA2(X, Y, StallColor, 5, 1, 41, 21, 23, 'em') then
        clickMouse2(MOUSE_LEFT);
      until(RSPS_InvFull);
    end;

    procedure Walk;
    begin
    if RSPS_InvFull then
    WalkToPlace;
    end;

    begin
      RSPS_SetInventory;
      Writeln(RSPS_GetUpText);
      MouseSpeed := 12;
      Steal();
      Writeln('Inventory count: ' + ToStr(rsps_Invcount));
      if (rsps_invFull) then
        Writeln('Inventory Full!');
      Walk;
    end.

  11. #11
    Join Date
    Sep 2010
    Posts
    5,762
    Mentioned
    136 Post(s)
    Quoted
    2739 Post(s)

    Default

    Quote Originally Posted by hete taart View Post
    To big
    Call the DTM's one time.
    Then do
    AddOnTerminare('freeproc');

    So just load all your dtm's in the begging of the script, and do "addonTerminate('nameofprocedure') and create a procedore to free them like
    procedure freemem;
    begin
    freedtm(dtm);
    end;

  12. #12
    Join Date
    Dec 2012
    Posts
    24
    Mentioned
    0 Post(s)
    Quoted
    8 Post(s)

    Default

    Quote Originally Posted by Officer Barbrady View Post
    Call the DTM's one time.
    Then do
    AddOnTerminare('freeproc');

    So just load all your dtm's in the begging of the script, and do "addonTerminate('nameofprocedure') and create a procedore to free them like
    procedure freemem;
    begin
    freedtm(dtm);
    end;

    am i doing this wrong?

    Simba Code:
    Program New;
    {$i SRL/SRL.simba}

    function LoadDTMWalk(WalkNumber: Integer): Integer;
    var
      dtmMainPoint: TDTMPointDef;
      dtmSubPoints: array[0..3] of TDTMPointDef;
      TempTDTM: TDTM;
    begin
      case WalkNumber of
        1: begin
            dtmMainPoint.x := 621;
      dtmMainPoint.y := 164;
      dtmMainPoint.AreaSize := 3;
      dtmMainPoint.AreaShape := 0;
      dtmMainPoint.Color := 4477277;
      dtmMainPoint.Tolerance := 0;

      dtmSubPoints[0].x := 621;
      dtmSubPoints[0].y := 164;
      dtmSubPoints[0].AreaSize := 3;
      dtmSubPoints[0].AreaShape := 0;
      dtmSubPoints[0].Color := 4477277;
      dtmSubPoints[0].Tolerance := 0;

      dtmSubPoints[1].x := 669;
      dtmSubPoints[1].y := 151;
      dtmSubPoints[1].AreaSize := 3;
      dtmSubPoints[1].AreaShape := 0;
      dtmSubPoints[1].Color := 242;
      dtmSubPoints[1].Tolerance := 35;

      dtmSubPoints[2].x := 629;
      dtmSubPoints[2].y := 130;
      dtmSubPoints[2].AreaSize := 3;
      dtmSubPoints[2].AreaShape := 0;
      dtmSubPoints[2].Color := 15069671;
      dtmSubPoints[2].Tolerance := 35;

      dtmSubPoints[3].x := 597;
      dtmSubPoints[3].y := 140;
      dtmSubPoints[3].AreaSize := 3;
      dtmSubPoints[3].AreaShape := 0;
      dtmSubPoints[3].Color := 4477277;
      dtmSubPoints[3].Tolerance := 35;

      TempTDTM.MainPoint := dtmMainPoint;
      TempTDTM.SubPoints := dtmSubPoints;
      Result := AddDTM(TempTDTM);
      addonTerminate('freemem')
    end;
    end;
    end;

    function WalkToPlace: Boolean;
    var
      WalkDTM, x, y: integer; // Calls the WalkDTM making walking simpler.
      aFound: extended;
    begin
      WalkDTM := LoadDTMWalk(1); //Load which DDTM you want to find.
      if FindDTMRotated(WalkDTM, X, Y, MMx1,MMy1,MMx2,MMy2, -Pi/2, Pi/2, Pi/30, aFound) then // Find the DDTM using Find DTM
      begin
        Mouse(X, Y, 3, 3, True);
        Writeln('Thief Point 1 done');
      end else // else it will do this...
        Writeln('failed find dtm');
          end;

    var
    Inventory:TBoxArray;

    function ExplodeBox(bx: TBox; rows, columns: integer): TBoxArray;
    var
      r, c, w, h, ew, eh, ow, oh, i, x, y: integer;
    begin
      if ((rows > 0) and (columns > 0) and (bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2)) then
      begin
        w := ((bx.X2 - bx.X1) + 1);
        h := ((bx.Y2 - bx.Y1) + 1);
        if (rows < 1) then
          rows := 1
        else
          if (rows > h) then
            rows := h;
        if (columns < 1) then
          columns := 1
        else
          if (columns > w) then
            columns := w;
        w := (w div columns);
        h := (h div rows);
        ew := (((bx.X2 - bx.X1) + 1) - (w * columns));
        eh := (((bx.Y2 - bx.Y1) + 1) - (h * rows));
        SetLength(Result, (rows * columns));
        y := bx.Y1;
        for r := 0 to (rows - 1) do
        begin
          x := bx.X1;
          if ((eh > 0) and (r < eh)) then
            oh := 1
          else
            oh := 0;
          for c := 0 to (columns - 1) do
          begin
            if ((ew > 0) and (c < ew)) then
              ow := 1
            else
              ow := 0;
            i := ((r * columns) + c);
            Result[i].X1 := x;
            Result[i].X2 := (x + (w - 1) + ow);
            Result[i].Y1 := y;
            Result[i].Y2 := (y + (h - 1) + oh);
            x := (Result[i].X2 + 1);
          end;
          y := (Result[i].Y2 + 1);
        end;
      end else
        SetLength(Result, 0);
    end;

    procedure RSPS_SetInventory;
    begin
    Inventory := ExplodeBox(IntToBox(549, 206, 733, 465), 7, 4);
     end;

     function rsps_slotFull(slot:Integer):Boolean;
    var
      x, y:Integer;
    begin
      if FindColor(x, y, 65536, Inventory[slot].x1, Inventory[slot].y1, Inventory[slot].x2, Inventory[slot].y2) then
        result := true;
    end;

    function rsps_Invcount:Integer;
    var
      i:Integer;
    begin
     for i := 0 to high(Inventory) do
      begin
        if rsps_slotFull(i) then
          result := result + 1;
      end;
    end;

    function RSPS_InvFull:Boolean;
    begin
      result := (rsps_invcount = 28);
    end;

    Function RSPS_GetUpText: String;
    Var
      WhiteT,BlueT,YellowT,OrangeT,FoundText: String;
    Begin
      WhiteT:=GetTextAtExWrap(8, 8, 80, 21, 0, 5, 1, 14541281, 55, 'RSPS');
      BlueT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 13423640, 65, 'RSPS');
      YellowT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 1235160, 40, 'RSPS');
      OrangeT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 4687583, 53, 'RSPS');
      FoundText:=WhiteT + ' ' + BlueT + YellowT + OrangeT;
      FoundText:= ReplaceWrap(FoundText, '.', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '/', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '\', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, ',', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '*', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '^', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '"', '',[rfReplaceAll]);
      Result:=FoundText;
    End;

    Function P06_IsUpTextMultiCustom(Text: TStringArray): Boolean;
    Var
      TheText: String;
      i, n: Integer;
    Begin
      TheText := RSPS_GetUpText;
      n := High(Text);
      For i := 0 to n do
        If (Pos(Text[i], TheText) > 0) then
        Begin
          Result := True;
          Exit;
        End;
    End;

    function ThiefColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.12, 0.83);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 928571, MSX1, MSY1, MSX2, MSY2, 2);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 2.24) and (X <= 3.30) and (Y >= 2.21) and (Y <= 3.21) and (Z >= 0.64) and (Z <= 0.91) then
        begin
          Result := arC[i];
          Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        Writeln('AutoColor failed in finding the color.');
    end;

    Function TalkingToThief: Boolean;

    Var
       TPAA: T2DPointArray; // The Variables of the Functions
       TPA: TPointArray;
       CTS, I, Retry: Integer;
       x, y:Integer;
    Begin
      CTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      FindColorsSpiralTolerance(MSCX, MSCY, TPA, ThiefColor, MSX1, MSY1, MSX2, MSY2, 7); // Enter the Color and Tolerance Here at the Right place.
      ColorToleranceSpeed(CTS);
      TPAA := TPAToATPAEx(TPA, 4, 3); //Put the Width and Heigh here
      SortATPASize(TPAA, True);
      For I := 0 To High(TPAA) Do
        If GetArraylength(TPAA[i]) > 5 Then // Set How Much Points you need for your function to take Action
        Begin
        repeat
          inc(Retry);
          MiddleTPAEx(TPAA[i], x, y);
          MMouse(X, Y, 3, 3);
           if (IsUpTextMultiCustom(['artin'])) then // Enter The name of Your NPC or Monster
          Begin
            Result := True;
            GetMousePos(X, Y);
            mouse(x,y,3,3,false);
            wait(100 + random(200));
          ChooseOption('rade');
          wait(5000 + random(1000));
            Break;
          End;
          until (Retry = 15);
          Break;
          end;
          end;





    function StallColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.05, 0.09);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 10728640, MSX1, MSY1, MSX2, MSY2, 16);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 27.16) and (X <= 67.46) and (Y >= 27.98) and (Y <= 70.66) and (Z >= 20.78) and (Z <= 71.06) then
        begin
          Result := arC[i];
          //Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        //Writeln('AutoColor failed in finding the color.');
    end;

    function FindObjTPA2(var X, Y: Integer; Color, Tol, CTS, ObjWidth, ObjHeight, minCount: Integer; UpText: string): Boolean;
    var
      I, tCTS: Integer;
      myPoint: TPoint;
      Points: TPointArray;
      aPoints: T2DPointArray;
    begin
      Result := False;

      tCTS := GetColorToleranceSpeed;
      CTS := Integer(CTS * 9 mod 3 <> 0);
      ColorToleranceSpeed(CTS);
      FindColorsSpiralTolerance(X, Y, Points, Color, MSX1, MSY1, MSX2, MSY2, Tol);
      if Length(Points) = 0 then
      begin
        //writeln('findObjTPA(): Found no colors.... exiting');
        ColorToleranceSpeed(tCTS);
        Exit;
      end;
      ColorToleranceSpeed(1);
      aPoints := TPAtoATPAEx(Points, ObjWidth, ObjHeight);
      SetLength(Points, 0);
      for I := 0 to High(aPoints) do
      begin
        if Length(aPoints[i]) < minCount then
          Continue;
        myPoint := MiddleTPA(aPoints[i]);
        MMouse(myPoint.X, myPoint.Y, 0, 0);
        wait(100 + random(50));

        if (pos(upText, RSPS_GetUptext) > 0) then
        begin
          //writeln('findObjTPA(): We found the object!');
          GetMousePos(X, Y);
          Result := True;
          ColorToleranceSpeed(tCTS);
          Exit;
        end else
          //writeln('findObjTPA(): Did not find the uptext... :<');
      end;
      ColorToleranceSpeed(tCTS);
    end;


    procedure Steal;
    var
      X, Y: Integer;
    begin
      repeat
      if FindObjTPA2(X, Y, StallColor, 5, 1, 41, 21, 23, 'em') then
        clickMouse2(MOUSE_LEFT);
      until(RSPS_InvFull);
    end;

    procedure Walk;
    begin
    if RSPS_InvFull then
    WalkToPlace;
    end;

    procedure freemem;
    begin
    freedtm(LoadDTMWalk(1));
    end;

    begin
      RSPS_SetInventory;
      Writeln(RSPS_GetUpText);
      MouseSpeed := 12;
      Steal();
      Writeln('Inventory count: ' + ToStr(rsps_Invcount));
      if (rsps_invFull) then
        Writeln('Inventory Full!');
      Walk;
    end.

  13. #13
    Join Date
    Sep 2010
    Posts
    5,762
    Mentioned
    136 Post(s)
    Quoted
    2739 Post(s)

    Default

    Quote Originally Posted by hete taart View Post
    am i doing this wrong?

    Simba Code:
    Program New;
    {$i SRL/SRL.simba}

    function LoadDTMWalk(WalkNumber: Integer): Integer;
    var
      dtmMainPoint: TDTMPointDef;
      dtmSubPoints: array[0..3] of TDTMPointDef;
      TempTDTM: TDTM;
    begin
      case WalkNumber of
        1: begin
            dtmMainPoint.x := 621;
      dtmMainPoint.y := 164;
      dtmMainPoint.AreaSize := 3;
      dtmMainPoint.AreaShape := 0;
      dtmMainPoint.Color := 4477277;
      dtmMainPoint.Tolerance := 0;

      dtmSubPoints[0].x := 621;
      dtmSubPoints[0].y := 164;
      dtmSubPoints[0].AreaSize := 3;
      dtmSubPoints[0].AreaShape := 0;
      dtmSubPoints[0].Color := 4477277;
      dtmSubPoints[0].Tolerance := 0;

      dtmSubPoints[1].x := 669;
      dtmSubPoints[1].y := 151;
      dtmSubPoints[1].AreaSize := 3;
      dtmSubPoints[1].AreaShape := 0;
      dtmSubPoints[1].Color := 242;
      dtmSubPoints[1].Tolerance := 35;

      dtmSubPoints[2].x := 629;
      dtmSubPoints[2].y := 130;
      dtmSubPoints[2].AreaSize := 3;
      dtmSubPoints[2].AreaShape := 0;
      dtmSubPoints[2].Color := 15069671;
      dtmSubPoints[2].Tolerance := 35;

      dtmSubPoints[3].x := 597;
      dtmSubPoints[3].y := 140;
      dtmSubPoints[3].AreaSize := 3;
      dtmSubPoints[3].AreaShape := 0;
      dtmSubPoints[3].Color := 4477277;
      dtmSubPoints[3].Tolerance := 35;

      TempTDTM.MainPoint := dtmMainPoint;
      TempTDTM.SubPoints := dtmSubPoints;
      Result := AddDTM(TempTDTM);
      addonTerminate('freemem')
    end;
    end;
    end;

    function WalkToPlace: Boolean;
    var
      WalkDTM, x, y: integer; // Calls the WalkDTM making walking simpler.
      aFound: extended;
    begin
      WalkDTM := LoadDTMWalk(1); //Load which DDTM you want to find.
      if FindDTMRotated(WalkDTM, X, Y, MMx1,MMy1,MMx2,MMy2, -Pi/2, Pi/2, Pi/30, aFound) then // Find the DDTM using Find DTM
      begin
        Mouse(X, Y, 3, 3, True);
        Writeln('Thief Point 1 done');
      end else // else it will do this...
        Writeln('failed find dtm');
          end;

    var
    Inventory:TBoxArray;

    function ExplodeBox(bx: TBox; rows, columns: integer): TBoxArray;
    var
      r, c, w, h, ew, eh, ow, oh, i, x, y: integer;
    begin
      if ((rows > 0) and (columns > 0) and (bx.X1 <= bx.X2) and (bx.Y1 <= bx.Y2)) then
      begin
        w := ((bx.X2 - bx.X1) + 1);
        h := ((bx.Y2 - bx.Y1) + 1);
        if (rows < 1) then
          rows := 1
        else
          if (rows > h) then
            rows := h;
        if (columns < 1) then
          columns := 1
        else
          if (columns > w) then
            columns := w;
        w := (w div columns);
        h := (h div rows);
        ew := (((bx.X2 - bx.X1) + 1) - (w * columns));
        eh := (((bx.Y2 - bx.Y1) + 1) - (h * rows));
        SetLength(Result, (rows * columns));
        y := bx.Y1;
        for r := 0 to (rows - 1) do
        begin
          x := bx.X1;
          if ((eh > 0) and (r < eh)) then
            oh := 1
          else
            oh := 0;
          for c := 0 to (columns - 1) do
          begin
            if ((ew > 0) and (c < ew)) then
              ow := 1
            else
              ow := 0;
            i := ((r * columns) + c);
            Result[i].X1 := x;
            Result[i].X2 := (x + (w - 1) + ow);
            Result[i].Y1 := y;
            Result[i].Y2 := (y + (h - 1) + oh);
            x := (Result[i].X2 + 1);
          end;
          y := (Result[i].Y2 + 1);
        end;
      end else
        SetLength(Result, 0);
    end;

    procedure RSPS_SetInventory;
    begin
    Inventory := ExplodeBox(IntToBox(549, 206, 733, 465), 7, 4);
     end;

     function rsps_slotFull(slot:Integer):Boolean;
    var
      x, y:Integer;
    begin
      if FindColor(x, y, 65536, Inventory[slot].x1, Inventory[slot].y1, Inventory[slot].x2, Inventory[slot].y2) then
        result := true;
    end;

    function rsps_Invcount:Integer;
    var
      i:Integer;
    begin
     for i := 0 to high(Inventory) do
      begin
        if rsps_slotFull(i) then
          result := result + 1;
      end;
    end;

    function RSPS_InvFull:Boolean;
    begin
      result := (rsps_invcount = 28);
    end;

    Function RSPS_GetUpText: String;
    Var
      WhiteT,BlueT,YellowT,OrangeT,FoundText: String;
    Begin
      WhiteT:=GetTextAtExWrap(8, 8, 80, 21, 0, 5, 1, 14541281, 55, 'RSPS');
      BlueT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 13423640, 65, 'RSPS');
      YellowT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 1235160, 40, 'RSPS');
      OrangeT:=GetTextAtExWrap(35, 8, 150, 21, 0, 5, 1, 4687583, 53, 'RSPS');
      FoundText:=WhiteT + ' ' + BlueT + YellowT + OrangeT;
      FoundText:= ReplaceWrap(FoundText, '.', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '/', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '\', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, ',', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '*', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '^', '',[rfReplaceAll]);
      FoundText:= ReplaceWrap(FoundText, '"', '',[rfReplaceAll]);
      Result:=FoundText;
    End;

    Function P06_IsUpTextMultiCustom(Text: TStringArray): Boolean;
    Var
      TheText: String;
      i, n: Integer;
    Begin
      TheText := RSPS_GetUpText;
      n := High(Text);
      For i := 0 to n do
        If (Pos(Text[i], TheText) > 0) then
        Begin
          Result := True;
          Exit;
        End;
    End;

    function ThiefColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.12, 0.83);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 928571, MSX1, MSY1, MSX2, MSY2, 2);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 2.24) and (X <= 3.30) and (Y >= 2.21) and (Y <= 3.21) and (Z >= 0.64) and (Z <= 0.91) then
        begin
          Result := arC[i];
          Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        Writeln('AutoColor failed in finding the color.');
    end;

    Function TalkingToThief: Boolean;

    Var
       TPAA: T2DPointArray; // The Variables of the Functions
       TPA: TPointArray;
       CTS, I, Retry: Integer;
       x, y:Integer;
    Begin
      CTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      FindColorsSpiralTolerance(MSCX, MSCY, TPA, ThiefColor, MSX1, MSY1, MSX2, MSY2, 7); // Enter the Color and Tolerance Here at the Right place.
      ColorToleranceSpeed(CTS);
      TPAA := TPAToATPAEx(TPA, 4, 3); //Put the Width and Heigh here
      SortATPASize(TPAA, True);
      For I := 0 To High(TPAA) Do
        If GetArraylength(TPAA[i]) > 5 Then // Set How Much Points you need for your function to take Action
        Begin
        repeat
          inc(Retry);
          MiddleTPAEx(TPAA[i], x, y);
          MMouse(X, Y, 3, 3);
           if (IsUpTextMultiCustom(['artin'])) then // Enter The name of Your NPC or Monster
          Begin
            Result := True;
            GetMousePos(X, Y);
            mouse(x,y,3,3,false);
            wait(100 + random(200));
          ChooseOption('rade');
          wait(5000 + random(1000));
            Break;
          End;
          until (Retry = 15);
          Break;
          end;
          end;





    function StallColor: Integer;
    var
      arP: TPointArray;
      arC: TIntegerArray;
      tmpCTS, i, arL: Integer;
      X, Y, Z: Extended;
    begin
      tmpCTS := GetColorToleranceSpeed;
      ColorToleranceSpeed(2);
      SetColorSpeed2Modifiers(0.05, 0.09);

      FindColorsSpiralTolerance(MSCX, MSCY, arP, 10728640, MSX1, MSY1, MSX2, MSY2, 16);
      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
        ColorToXYZ(arC[i], X, Y, Z);

        if (X >= 27.16) and (X <= 67.46) and (Y >= 27.98) and (Y <= 70.66) and (Z >= 20.78) and (Z <= 71.06) then
        begin
          Result := arC[i];
          //Writeln('AutoColor = ' + IntToStr(arC[i]));
          Break;
        end;
      end;

      ColorToleranceSpeed(tmpCTS);
      SetColorSpeed2Modifiers(0.2, 0.2);

      if (i = arL + 1) then
        //Writeln('AutoColor failed in finding the color.');
    end;

    function FindObjTPA2(var X, Y: Integer; Color, Tol, CTS, ObjWidth, ObjHeight, minCount: Integer; UpText: string): Boolean;
    var
      I, tCTS: Integer;
      myPoint: TPoint;
      Points: TPointArray;
      aPoints: T2DPointArray;
    begin
      Result := False;

      tCTS := GetColorToleranceSpeed;
      CTS := Integer(CTS * 9 mod 3 <> 0);
      ColorToleranceSpeed(CTS);
      FindColorsSpiralTolerance(X, Y, Points, Color, MSX1, MSY1, MSX2, MSY2, Tol);
      if Length(Points) = 0 then
      begin
        //writeln('findObjTPA(): Found no colors.... exiting');
        ColorToleranceSpeed(tCTS);
        Exit;
      end;
      ColorToleranceSpeed(1);
      aPoints := TPAtoATPAEx(Points, ObjWidth, ObjHeight);
      SetLength(Points, 0);
      for I := 0 to High(aPoints) do
      begin
        if Length(aPoints[i]) < minCount then
          Continue;
        myPoint := MiddleTPA(aPoints[i]);
        MMouse(myPoint.X, myPoint.Y, 0, 0);
        wait(100 + random(50));

        if (pos(upText, RSPS_GetUptext) > 0) then
        begin
          //writeln('findObjTPA(): We found the object!');
          GetMousePos(X, Y);
          Result := True;
          ColorToleranceSpeed(tCTS);
          Exit;
        end else
          //writeln('findObjTPA(): Did not find the uptext... :<');
      end;
      ColorToleranceSpeed(tCTS);
    end;


    procedure Steal;
    var
      X, Y: Integer;
    begin
      repeat
      if FindObjTPA2(X, Y, StallColor, 5, 1, 41, 21, 23, 'em') then
        clickMouse2(MOUSE_LEFT);
      until(RSPS_InvFull);
    end;

    procedure Walk;
    begin
    if RSPS_InvFull then
    WalkToPlace;
    end;

    procedure freemem;
    begin
    freedtm(LoadDTMWalk(1));
    end;

    begin
      RSPS_SetInventory;
      Writeln(RSPS_GetUpText);
      MouseSpeed := 12;
      Steal();
      Writeln('Inventory count: ' + ToStr(rsps_Invcount));
      if (rsps_invFull) then
        Writeln('Inventory Full!');
      Walk;
    end.
    It would be much simpler if you just made a normal dtm instead of a ddtm because your not even changing any of the vars -.-

    then it would be so simple

    procedure loadmem;
    begin
    walkdtm := dtmfromstring('whateverthestringis');
    end;
    procedure freemem;
    begin
    freedtm(walkdtm);
    end;

    begin
    loadmem;
    addonterminate('freemem');
    end.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •