SRL Archive - SRL Archives

Well I'm watching my private power-mining script run, and he drops a ruby and a diamond. And I'm there thinking 'wouldn't it be great if he kept those?' Well, now you can.

BEHOLD!

//Supply the procedure with an array of strings, and it will drop everything except those items.
procedure DropExceptName(ItemList : TStringArray);
var J : TPoint;
var i, X, Y : Integer;
begin
  GameTab(4);

  for i := 1 To 28 do
  begin
    if (Not(ExistsItem(i))) then Continue;

    J := ItemCoords(i);
    MMouse(J.X, J.Y, 3, 3);
    Wait(150 + Random(150));

    if (Not(IsUpTextMultiCustom(ItemList))) then
    begin
      GetMousePos(X, Y);
      Mouse(X, Y, 0, 0, False);
      Wait(150 + Random(150));
      ChooseOption('rop');
    end;

  end;
end;

//Supply the procedure with an array of strings, and it will only drop those items.
procedure DropOnlyName(ItemList : TStringArray);
var J : TPoint;
var i, X, Y : Integer;
begin
  GameTab(4);
  
  for i := 1 To 28 do
  begin
    if (Not(ExistsItem(i))) then Continue;
    
    J := ItemCoords(i);
    MMouse(J.X, J.Y, 3, 3);
    Wait(150 + Random(150));
    
    if (IsUpTextMultiCustom(ItemList)) then
    begin
      GetMousePos(X, Y);
      Mouse(X, Y, 0, 0, False);
      Wait(150 + Random(150));
      ChooseOption('rop');
    end;

  end;
end;

Post bugs / improvements / suggestions etc. :)

Tested, works like a charm :)

Edit: Added the other procedure, cleaned them up alot.

Ooo, this is a useful procedure. Ill test it, ill reply in about 1 min.

Yeah I haven't done anything with the cases though, so it will have to be case sensitive at the moment.

for T := 0 To GetArrayLength(ItemList) do
    begin
      if (IsUpText(ItemList[T])) then
      begin
        Drop := False;
        Break;
      end;
    end;

IsUpTextMultiCustom?

:)

Didn't even know about that one, I'll take a look at it.

Any errors that you can see though?

You do slots 1 to invcount. But the inventory hasn't got the be "arranged" so there could be 1 item, but that could be in slot 28; so you miss it. You better can do

for i := 1 to 28 do
  if ExistsItem(i) then
  // the rest

Edited somewhat.

function DropExceptBitmap(ItemBmp: TIntegerArray): Boolean;
var
  i, c, rx, ry: Integer;
  p: TBox;
  DropIt: Boolean;
begin
  for I := 1 to 28 do
    if ExistsItem(I) then
    begin
      P := InvBox(I);
      DropIt := True;
      for C := 0 to Length(ItemBmp) - 1 do
      begin
        if FindBitmapToleranceIn(ItemBmp, Rx, Ry, P.X1, P.Y1, P.X2, P.Y2, 40) then
        begin
          DropIt := False;
          Break;
        end;
      end;
      if DropIt then
      begin
        Mouse((P.X1 + P.X2) div 2, (P.Y1 + P.Y2) div 2, 5, 5, False);
        Wait(100 +Random(100));
        ChooseOption('rop');
      end;
    end;
    Wait(50 +Random(75));
end;

Slightly modified it just then, I made it for my Power-fisher a while ago

This way, they don't have to create a bitmap though.

Although, you do have to iterate through every item…

Building on The Claw's procedure, you could also use DTM's for this as well. Just make it a TIntegerArray of DTM's then use FindDTM. If you really want you could also put both of them together and use both DTMs/Bitmaps and UpText. (Useful for a dropping items that share the same image with something else).

Kewl?


I am still trying to find a very confusing way of confusing people, so I'll be back in a bit to give bugs etc.

i do remember that you had some problem with your miner, i read your script what you posted, and i wanted premission to use your dropexeptname function :D Bad thing is it has to mmouse on every inv slot