program New; {.include SRL/SRL.scar} type BlackList = array of integer; type BlackListNet = array of Tpoint; {******************************************************************************* function CreateTightNet : BlackListNet; By: Boreas Note: Purely an internal function, used in setup. Description: Same as above but takes a little (not noticeable) longer and is more accurate. 38% of the slot. 74% of slot without amount *******************************************************************************} function CreateTightNet :BlackListNet; var Counter,hx,hy:integer; var TPointsToCheck:array [0..367] of TPoint; begin repeat hy:=15; hx:=hx+1; repeat hy:=hy+1; if (((hx mod 2)=0) or ((hy mod 2)=0)) then begin TPointsToCheck[Counter].x:=hx; TPointsToCheck[Counter].y:=hy; Counter:=Counter+1; end; until hy=31; until hx=31; result:=TPointsToCheck; end; {******************************************************************************* function CreateItemBlackList(WhichBankSlot:integer;WhichNet:BlackListNet):BlackList; By: Boreas Description: Looks at the points in the list for an item, and returns an array contatining the indexes of the points that are black. Usage: WhichBankSlot-just what it sounds like. WhichList-the TPointArray containing positions relative to the x1,y1 of a bankslot which you want to check *******************************************************************************} function CreateItemBlackList(WhichBankSlot:integer;WhichNet:BlackListNet):BlackList; var Counter,Counter2,Tmpx1,Tmpy1,ListLength:integer; var TmpArray:array of integer; begin Tmpx1:=79+((((WhichBankSlot+7)mod 8))*47); Tmpy1:=62+((((WhichBankSlot-1)/8))*38); ListLength:=getarraylength(WhichNet)-1; setarraylength(tmparray,1); for Counter:= 0 to ListLength do begin if GetColor(Tmpx1+WhichNet[Counter].x,Tmpy1+WhichNet[Counter].y)=65536 then begin TmpArray[Counter2]:=Counter; Counter2:=Counter2+1; setarraylength(TmpArray,Counter2+1); end; end; setarraylength(tmpArray,Counter2); result:=TmpArray; end; {******************************************************************************* function GetNameOfItemInBank: string; By: Boreas, bases off of Ron's Replace Description: Takes item name from uptext in bankscreen, and changes spaces to underscores *******************************************************************************} function GetNameOfItemInBank: string; var a : LongInt; TheString:string; begin TheString:=GetUptext; a := Pos('Withdraw 1 ', TheString); if(a = 0)then begin // Do nothing.. end else begin Delete(TheString, a, Length('Withdraw 1 ')); Insert('', TheString, a); a := Pos(' /', TheString); delete(thestring,a,Length(TheString)); repeat a := Pos(' ', TheString); if a<>0 then begin Delete(TheString, a, 1); Insert('_', TheString, a); end; until a=0; Result := TheString; end; end; {******************************************************************************* procedure WriteBlackList(TheBlackList: BlackList); By: Boreas/moparisthebest Description: Displays a BlackList as a string in debug box. Basically array of integer -> string and DTM editor's DTM to Text put together *******************************************************************************} procedure WriteBlackList(TheBlackList: BlackList); var i, arrayLength: Integer; mystr,tmpstr,tmpresult:string; begin arrayLength := GetArrayLength(TheBlackList); repeat tmpresult := tmpresult + IntToStr(TheBlackList[i]); if (not (i = (arrayLength - 1))) then tmpresult := tmpresult + ' '; i := i + 1; until (i = arrayLength) mystr:=GetNameOfItemInBank; if mystr='' then mystr:='BlackList'; tmpresult:=' BL_'+mystr+' := LoadBlackListFromString('+chr(39)+tmpresult+chr(39)+');'; writeln(tmpresult); end; var MyNet:BlackListNet; MyList:Blacklist; slot1:integer; begin SetupSRL; MyNet:=CreateTightNet; writeln('Put mouse over item and press f12'); repeat repeat wait(30); until ((isfkeydown(12)) or (isfkeydown(11))); if not(isfkeydown(11)) then begin getmousepos(x,y); slot1:=(((((y-62) div 38)+1)-1)*8)+(((x-79) div 47)+1); MyList:=CreateItemBlackList(slot1,MyNet); WriteBlackList(Mylist); writeln('Press F12 to do another one'); writeln('Press F11 to end'); end; until isfkeydown(11); end.