I dont know how you have backups..I cant really help at the moment since Wizzup's Site [The Simba site] is down till like next week… I suggest you just manage with this for now. Ill post up my Inventory.Scar and WorldSwitcher.Scar. I dunno if itll help if your getting a Duplicate error =/. Good Luck bro, and keep us notified.
Inventory.Scar
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ? Inventory Routines --//
//-----------------------------------------------------------------//
// * function GetInven(Inven : Integer) : TInvenItem; // by Sky Scripter
// * function GetInventoryArray : array of TInvenItem; // by Sky Scripter
// * function InvBox(i :Integer): TBox; // by Boreas & Ogre
// * function ItemCoords(i: Integer): TPoint; // by RsN
// * Function CoordsToItem(X, Y: Integer): Integer; // by Boreas
// * function GetInvItemBounds(InvSpot: Integer; T: TBox): Boolean; // by Wizzup?
// * procedure InvMouse(InvSlot, Action: Byte); // by EvilChicken!
// * procedure MMouseItem(i: Integer); // by WT-Fakawi & EvilChicken!
// * procedure MouseItem(i: Integer; left: Boolean); // by WT-Fakawi, EvilChicken!, & NaumanAkhlaQ
// * procedure DragItem(Inv1, Inv2: Integer); // by NaumanAkhlaQ
// * function ExistsItem(i: Integer): Boolean; // by RsN
// * function InvCount: Integer; // by RsN
// * function InvEmpty: Boolean; // by WT-Fakawi
// * function InvFull: Boolean; // by RsN
// * function CountItems(identifier: Integer; identifiertype: string; tol: TIntegerArray): Integer; // by WT-Fakawi & Sumilion
// * function ClickAllItemsExcept(identifier: Integer; identifiertype, option: string; SlotIgnores: TIntegerArray; waitnum: Integer; tol: TIntegerArray):Integer; // by WT-Fakawi, Sumilion, & Nava2
// * function ClickAllItems(identifier: Integer; identifiertype, option: string; waitnum: Integer; tol: TIntegerArray):Integer; // by Nava2
// * procedure DropItem(i: Integer); // by Lorax
// * Procedure DropPattern(which: integer); // by Rasta Magician
// * procedure DropAll; // by Rasta Magician
// * procedure DropAllExcept(IgnoreInvSlots: array of Byte); // by R1ch
// * procedure DropItemsByIdentifier; // by EvilChicken!
// * procedure ArrangeInv; // by Cheesehunk
// * function CountItemsBlackLine(Count, Tol: Integer): Integer; // by n3ss3s
// * function ClickAllItemsBlackLine(Count, Tol: Integer; Option: String): Integer; // by n3ss3s
// * function ItemActivated(Slot: Integer): Boolean; // by marpis
{ type TInvenItem;
Description: Holds data regarding an inventory item }
type
TInvenItem = record
Width, Height : Integer; // the width and height of the item
Count : Integer; // the count of the item
ItemBox : TBox; // the exact box around the item
CenterPoint: TPoint; // the center point inside the item
ExistsItem : Boolean; // to define the item Exists
end;
TInvenItemArr = array of TInvenItem;
{*******************************************************************************
function GetInven(Inven: Integer): TInvenItem;
By: SKy Scripter
Description: Returns The Width, Height, Count, ItemBox and CenterPoint of the
Given Item Slot.
*******************************************************************************}
function GetInven(Inven: Integer): TInvenItem;
var
Slot, Row, Ix, Iy, I, Cx, Cy: Integer;
P: TPointArray;
MinP, MaxP: TPoint;
begin
GameTab(tab_Inv);
Inven := Inven - 1;
Slot := Inven mod 4;
Row := Inven div 4;
IX := 560 + (Slot * 42);
IY := 210 + (Row * 36);
FindColorsTolerance(P, srl_outline_black, IX, IY, IX + 41, IY + 35, 0);
Result.Count := Length(P);
if (Result.Count = 0) then Exit;
Result.ExistsItem := True;
MinP := P[0];
MaxP := P[Result.Count-1];
Cx := P[0].x + P[Result.Count-1].x;
Cy := P[0].y + P[Result.Count-1].y;
for I := 1 to Result.Count - 2 do
begin
if (P[i].x < MinP.x) then MinP.x := P[i].x;
if (P[i].y < MinP.y) then MinP.y := P[i].y;
if (P[i].x > MaxP.x) then MaxP.x := P[i].x;
if (P[i].y > MaxP.y) then MaxP.y := P[i].y;
Cx := Cx + P[i].x;
Cy := Cy + P[i].y;
end;
Cx := Cx div Result.Count;
Cy := Cy div Result.Count;
Result.CenterPoint := Point(Cx, Cy);
Result.Width := MaxP.x - MinP.x;
Result.Height := MaxP.y - MinP.y;
Result.ItemBox := PointToBox(MinP, MaxP);
end;
{*******************************************************************************
function GetInventoryArray : array of TInvenItem;
By: SKy Scripter
Description: Returns The Width, Height, Count, ItemBox and CenterPoint
in array [0..27] of all Items in the inventory.
*******************************************************************************}
function GetInventoryArray : TInvenItemArr;
var
I: Byte;
begin
SetArrayLength(Result, 28);
for I := 0 to 27 do
Result[I] := GetInven(i + 1);
end;
{*******************************************************************************
Function InvBox(i :Integer): TBox;
By: Boreas. Coords by Ogre July 15th 2009.
Description: Returns TBox of surrounding Inventory SlotBox
1-2-3-4
5-6-7-8
etc.
*******************************************************************************}
function InvBox(I :Integer): TBox;
var
Slot1, Slot6: TBox;
begin
if not InRange(I, 1, 28) then
begin
Result := IntToBox(-1,-1,-1,-1);
srl_Warn('InvBox', 'Incorrect index: ' + IntToStr(i), warn_AllVersions);
Exit;
end;
Slot1 := IntToBox(563, 213, 594, 244);
Slot6 := IntToBox(605, 249, 31415, 92653);
Result.x1 := Slot1.X1 + ((((i + 3) mod 4)) * (Slot6.X1 - Slot1.X1));
Result.y1 := Slot1.Y1 + ((((i - 1) div 4)) * (Slot6.Y1 - Slot1.Y1));
Result.x2 := Result.x1 + (Slot1.X2 - Slot1.X1);
Result.y2 := Result.y1 + (Slot1.Y2 - Slot1.Y1);
end;
{*******************************************************************************
function ItemCoords(i: Integer): TPoint;
By: RsN
Description: Returns X and Y of Specified Inventory Spot
*******************************************************************************}
function ItemCoords(i: Integer): TPoint;
var
Box: TBox;
begin
Box := InvBox(i);
Result.X := (Box.X1 + Box.X2) Shr 1;
Result.Y := (Box.Y1 + Box.Y2) Shr 1;
end;
{*******************************************************************************
function CoordsToItem(X, Y: Integer): Integer;
By: Boreas
Description: Returns which Inventory slot the X and Y coords are in. If the
coords are between slots (or not in the inventory area at all) it will return 0.
*******************************************************************************}
function CoordsToItem(X, Y: Integer): Integer;
var
tmpBox: TBox;
begin
if not PointInBox(Point(X, Y), IntToBox(MIX1, MIY1, MIX2, MIY2)) then exit;
for Result := 1 to 4 do
begin
tmpBox := InvBox(result);
if InRange(X, tmpBox.x1, tmpBox.x2) then break;
end;
while (not InRange(Y, tmpBox.y1, tmpBox.y2)) do
begin
IncEx(Result, 4);
if (Result > 28) then
Break;
tmpBox := InvBox(Result);
end;
if (not PointInBox(Point(X, Y), tmpBox)) then
Result := 0;
end;
{*******************************************************************************
function GetInvItemBounds(InvSpot: Integer; T: TBox): Boolean;
By: Wizzup?
Description: If item exists, returns TBox of the item, else returns the normal InvBox.
*******************************************************************************}
function GetInvItemBounds(InvSpot: Integer; var T: TBox): Boolean;
var
TPA: TPointArray;
begin
GameTab(tab_inv);
if (not FindColors(TPA, srl_outline_black, T.x1, T.y1, T.x2, T.y2)) then //No shortcut elevation
begin
Result := False;
T := InvBox(InvSpot);
Exit;
end;
Result := True;
T := GetTPABounds(TPA);
end;
{*******************************************************************************
function ExistsItem(i: Integer): Boolean;
By: WT-Fakawi
Description: Checks if item in inventory at specified position exists
*******************************************************************************}
function ExistsItem(I: Integer): Boolean;
var
X, Y: Integer;
TB: TBox;
begin
GameTab(tab_Inv);
TB := InvBox(I);
Result := FindColor(x, y, srl_outline_black, TB.x1, TB.y1, TB.x2, TB.y2);
end;
{*******************************************************************************
function ExistsItemDTM(dtm: Integer; var x, y: Integer): Boolean;
By: NCDS
Description: Checks if the item with dtm is in the inventory. Returns the item's
coordinates.
*******************************************************************************}
function ExistsItemDTM(dtm: Integer; var x, y: Integer): Boolean;
begin
Gametab(tab_Inv);
Wait(300 + Random(300));
Result := FindDTM(dtm, x, y, MIx1, MIy1, MIx2, MIy2);
end;
{*******************************************************************************
function InvMouse(InvSlot, Action: Byte) : boolean;
By: EvilChicken!
Description: A combined MouseItem & MMouseItem, will hopefully replace both
procedures one day. Usage is like SRL's MouseBox, Action determines what to do:
1: Leftclick
2: Rightclick
3: Move mouse to item
*******************************************************************************}
function InvMouse(InvSlot, Action: Byte) : boolean;
var
TB: TBox;
CurrPT : TPoint;
begin
result := false;
if (not InRange(Action, 1, 3)) then
begin
srl_Warn('InvMouse', 'Action #' + IntToStr(Action) + ' is not a valid action', warn_AllVersions);
Exit;
end;
if (not InRange(InvSlot, 1, 28)) then
begin
srl_Warn('InvMouse', 'Inventory slot #' + IntToStr(InvSlot) + ' is not a valid slot', warn_AllVersions);
Exit;
end;
GameTab(tab_inv);
Result := true;
TB := InvBox(InvSlot);
GetMousePos(CurrPT.x,CurrPT.y);
if PointInBox(CurrPT,TB) then
MouseBox(Max(CurrPT.x-random(2),TB.x1),Max(CurrPT.y-random(2),TB.y1),
Min(CurrPT.x+random(2),TB.x2),Min(CurrPT.y+random(2),TB.y2),Action) //LOL Pro-human much!
else
MouseBoxEx(TB.X1, TB.Y1, TB.X2, TB.Y2,14, Action);
end;
{*******************************************************************************
procedure MMouseItem(i: Integer);
By: WT-Fakawi/EvilChicken!
Description: Moves mouse to specified inventory spot.
*******************************************************************************}
procedure MMouseItem(I: Byte);
begin
InvMouse(I, 3);
end;
{*******************************************************************************
procedure MouseItem(i: Byte; Left: Boolean);
By: WT-Fakawi/EvilChicken!, edit by NaumanAkhlaQ
Description: Moves Mouse to inv spot then clicks left or right.
*******************************************************************************}
procedure MouseItem(I: Byte; Left: Boolean);
begin
case left of
true : InvMouse(I,1);
false: InvMouse(I,2);
end;
end;
{*******************************************************************************
procedure DragItem(Inv1, Inv2: Integer);
By: NaumanAkhlaQ
Description: Drags Item from first position Inv1 to Inv2 (Inventory Slots)
*******************************************************************************}
procedure DragItem(Inv1, Inv2: Integer);
var
InvAr: array [0..1] of TBox;
begin
InvAr[0] := InvBox(Inv1);
InvAr[1] := InvBox(Inv2);
DragMouse(InvAr[0].x1, InvAr[0].y1, InvAr[0].x2 - InvAr[0].x1, InvAr[0].y2 - InvAr[0].y1,
InvAr[1].x1, InvAr[1].y1, InvAr[1].x2 - InvAr[1].x1, InvAr[1].y2 - InvAr[1].y1);
end;
{*******************************************************************************
function InvCount: Integer;
By: RsN
Description: Returns amount of items in your inventory
*******************************************************************************}
function InvCount: Integer;
var
I: Integer;
begin
Result := 0;
GameTab(tab_inv);
for I := 1 to 28 do
if (ExistsItem(I)) then
Inc(Result);
end;
{*******************************************************************************
function InvEmpty: Boolean;
By: WT-Fakawi
Description: Returns True if inventory is empty
*******************************************************************************}
function InvEmpty: Boolean;
var
X, Y: Integer;
begin
GameTab(tab_Inv);
Result := (not FindColor(X, Y, srl_outline_black, MIX1, MIY1, MIX2, MIY2));
end;
{*******************************************************************************
function InvFull: Boolean;
By: n3ss3s
Description: Returns True if inventory is full
*******************************************************************************}
function InvFull: Boolean;
begin
Result := (InvCount = 28);
end;
{*******************************************************************************
function CountItems(ItemType: string; Identifier: Integer; tol: TIntegerArray): Integer;
By: WT-Fakawi / Sumilion
Description: Counts Items in the inventory.
ItemType - 'dtm', 'bitmap', 'bitmap mask', 'color'
Item - name/value of your dtm/bmp/color/bmpmask.
Tol - 'dtm' - [] (dtm's can't have tolerance).
'bmp' - [BMPTol].
'color' - [COLOUR Tol, Colour Count].
'bmpmask' - [BMPTol, ContourTol].
*******************************************************************************}
function CountItems(ItemType: string; Identifier: Integer; tol: TIntegerArray): Integer;
begin
GameTab(tab_Inv);
Result := CountItemsIn('inv', ItemType, Identifier, Tol)
end;
{*******************************************************************************
function ClickAllItemsExcept(ItemType: String; Identifier: Integer; option: string; SlotIgnores: TIntegerArray; waitnum: Integer; tol: TIntegerArray):Integer;
By: WT-Fakawi, Sumilion & Nava2
Description: Performs "option" popup menu action on all items with:
ItemType - 'dtm', 'bitmap', 'bitmap mask', 'color'
Identifier - name/value of your dtm/bmp/color/bmpmask.
Tol - 'dtm' - [] (dtm's can't have tolerance).
'bmp' - [BMPTol].
'color' - [COLOUR Tol, Colour Count].
'bmpmask' - [BMPTol, ContourTol].
Will not click items in slots SlotIgnores
*******************************************************************************}
function ClickAllItemsExcept(ItemType: String; Identifier: Integer; option: string; SlotIgnores: TIntegerArray; waitnum: Integer; tol: TIntegerArray):Integer;
var
arr: TIntegerArray;
I, X, Y: Integer;
TB: Tbox;
begin
GameTab(tab_Inv);
Result := 0;
arr :=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,
18,19,20,21,22,23,24,25,26,27,28];
for i := 1 to 28 - 4 do
Swap(arr[RandomRange(i - 1, i + 4)], arr[RandomRange(i - 1, i + 4)] );
SetLength(Tol, 2);
for i := 0 to 27 do
begin
if InIntArray(SlotIgnores, arr[i] + 1) then Continue;
TB := InvBox(arr[i]);
if ExistsItem(arr[i]) then
try
if not FindItemEx(x, y, ItemType, Identifier, TB, Tol) then Continue;
if (Option <> '') then
begin
MouseItem(arr[i], False);
WaitOption(Option, waitnum);
Inc(Result);
end
else
MouseItem(arr[i], True);
Wait(waitnum);
except end;
end;
end;
{*******************************************************************************
function ClickAllItems(ItemType: String; Identifier: Integer; option: string; waitnum: Integer; tol: TIntegerArray):Integer;
By: Nava2
Description: See ClickAllItemsExcept, this doesn't ignore any slots.
*******************************************************************************}
function ClickAllItems(ItemType: String; Identifier: Integer; option: string; waitnum: Integer; tol: TIntegerArray):Integer;
begin
Result := ClickAllItemsExcept(ItemType, Identifier, option, [], waitnum, tol);
end;
{*******************************************************************************
procedure DropItem(i: Integer);
By: Lorax
Description: Drops item at given position (1-28)
*******************************************************************************}
function DropItem(i: Integer): Boolean;
begin
Result := False;
if ExistsItem(i) then
begin
MouseItem(i, False);
if (WaitOptionEx('rop', 'action', ClickLeft, 250)) then
begin
Result := True;
Wait(RandomRange(50, 200));
end;
end;
end;
{*******************************************************************************
procedure DropArray(InvSlots: TIntegerArray);
By: Lorax/EvilChicken!, Tickyy for idea.
Description: Drops item positioned equivalent to numbers in "InvSlots" array.
Example: "DropArray([2, 4, 9, 12]);" would drop items in InvSlot 2, 4, 9 and 12.
*******************************************************************************}
procedure DropArray(InvSlots: TIntegerArray);
var
I, Len: Integer;
begin
Len := Length(InvSlots);
for I := 1 to Len - 4 do
Swap(InvSlots[RandomRange(I - 1, I + 4)], InvSlots[RandomRange(I - 1, I + 4)]);
for I := 0 to Len - 1 do
DropItem(InvSlots[I]);
end;
const
dp_UpToDown = 1;
dp_Snake = 2;
dp_Random = 3;
{*******************************************************************************
procedure DropPattern(Which: Integer);
By: Rasta Magician
Description: Drops all items in inventory according to pattern which.
*******************************************************************************}
procedure DropPattern(Which: Integer);
var
Col, A, I: Integer;
Arr: TIntegerArray;
Turn: Boolean;
begin
SetLength(Arr, 28);
A := 0;
if (Which = 0) then
Which := Random(2) + 1; //ignores complete randomness, unless scripter chooses to use it
srl_warn('DropPattern','Dropping by pattern: ' + IntToStr(Which),warn_Debug);
case which of
dp_UpToDown:
for Col := 1 to 4 do
if InIntArray([2, 4], Col) then
begin
for i := 6 Downto 0 do
begin
Arr[a] := Col + i*4;
Inc(a);
end;
end else
for i := 0 to 6 do
begin
Arr[a] := Col + i*4;
Inc(a);
end;
dp_Snake:
repeat
if (not Turn) then
begin
for i:= 1 to 4 do
Arr[a + I - 1] := A + I;
IncEx(a, 4);
Turn := True;
end else begin
for I := 4 Downto 1 do
Arr[a-i+4] := a + i;
IncEx(a, 4);
Turn := false;
end;
until (a >= 28);
dp_Random:
begin
DropArray([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28]);
Exit;
end;
end;
if Random(2) = 1 then
InvertTIA(Arr);
Gametab(tab_inv);
for i:= 0 to 27 do
DropItem(Arr[i]);
end;
{*******************************************************************************
procedure DropAll;
By: Rasta Magician
Description: Drops all items in inventory.
*******************************************************************************}
procedure DropAll;
var i: integer;
begin
for i:= 0 to 2 do
begin
DropPattern(Random(2) + 1);
if InvCount = 0 then
break;
end;
end;
{*******************************************************************************
procedure DropAllExcept(IgnoreInvSlots: TIntegerArray);
By: Nava2
Date: Dec 06, 2009
Description: Drops everything in inventory. Ignores slots specified by
DontDrop array.
*******************************************************************************}
procedure DropAllExcept(DontDrop: TIntegerArray);
var
inv, i, h: Integer;
begin
h := high(DontDrop);
for i := 0 to h do
{ Set the bit associated with the DontDrop Array }
inv := inv or (1 shl DontDrop[i]);
for i := 1 to 28 do
{ Check the bit at i, and if its high, then we dont drop. }
if (((inv shr i) and 1) = 0) then
DropItem(i);
end;
{*******************************************************************************
procedure DropItemsByIdentifier;
By: EvilChicken! Fixed by Coh3n
Description: See description of ClickAllItemsExcept.
*******************************************************************************}
procedure DropItemsByIdentifier(ItemType: string; Identifier: Integer; Tol: TIntegerArray);
begin
ClickAllItems(ItemType, Identifier, 'rop', 250, Tol);
end;
{*******************************************************************************
procedure ArrangeInv;
By: Cheesehunk
Description: Arrange's inventory in an orderly fashion.
*******************************************************************************}
procedure ArrangeInv;
var
InvSpace, i, c, OpenSpace: Integer;
InvSpotFull: array[1..28] of Boolean;
begin
InvSpace := InvCount;
if (InvSpace <= 0) or (InvSpace >= 28) then
Exit;
for i := 1 to 28 do
InvSpotFull[i] := ExistsItem(i);
for i := 1 to 28 do
if InvSpotFull[i] then
for c := 1 to 28 do
if not ExistsItem(c) then
begin
OpenSpace := c;
if (i > 1) and (c < i) then
begin
DragItem(i, c);
Break;
end;
end;
end;
{*******************************************************************************
function CountItemsBlackLine(Count, Tol: Integer): Integer;
By: n3ss3s
Description: Returns the number of items in inventory with Count amount of
blackline points and Tol tolerance in the amount of points.
*******************************************************************************}
function CountItemsBlackLine(Count, Tol: Integer): Integer;
var
TPA: TPointArray;
I, H: Integer;
TPAA: T2DPointArray;
begin
GameTab(tab_Inv);
result := 0;
FindColors(TPA, srl_outline_black, MIX1, MIY1, MIX2, MIY2);
TPAA := TPAToATPAEx(TPA, 42, 36);
H := High(TPAA);
for I := 0 to H do
if InRange(GetArrayLength(TPAA[i]), Count - Tol, Count + Tol) then
Inc(Result);
end;
{*******************************************************************************
function ClickAllItemsBlackLine(Count, Tol: Integer; Option: String): Integer;
By: n3ss3s
Description: Finds all items in inventory with blackline points amount of Count
with Tol tolerance, and returns the amount of items could choose the
option Option to. Waits the WaitT amount of millisecs between items, with
WaitR randomness of milliseconds.
*******************************************************************************}
function ClickAllItemsBlackLine(Count, Tol, WaitT, WaitR: Integer; Option: String): Integer;
var
TPA: TPointArray;
X, Y, Z, H: Integer;
TPAA: T2DPointArray;
begin
GameTab(tab_Inv);
result := 0;
FindColorsTolerance(TPA, srl_outline_black, MIX1, MIY1, MIX2, MIY2, 0);
TPAA := TPAToATPAEx(TPA, 42, 36);
H := High(TPAA);
for z := 0 to H do
if InRange(GetArrayLength(TPAA[z]), Count - Tol, Count + Tol) then
begin
MiddleTPAEx(TPAA[z], X, Y);
Mouse(X, Y, 2, 2, False);
if WaitOption(Option, 300) then
begin
Inc(Result);
Wait(WaitT + Random(WaitR));
end;
end;
end;
{*******************************************************************************
function ItemActivated(Slot: Integer): Boolean;
By: marpis
Description: Checks if item in specified inventory slot has a white outline.
Returns True if the item has a white outline, otherwise returns false.
*******************************************************************************}
function ItemActivated(Slot: Integer): Boolean;
var
X, Y: Integer;
TB: TBox;
begin
result := false;
if not GameTab(tab_Inv) then
exit;
TB := InvBox(Slot);
Result := FindColor(x, y, srl_outline_white, TB.x1, TB.y1, TB.x2, TB.y2) and InRange(
CountColor(srl_outline_white, TB.x1, TB.y1, TB.x2, TB.y2) -
CountColor(srl_outline_black, TB.x1, TB.y1, TB.x2, TB.y2),-40,40);
end;
{*******************************************************************************
function SelectedItem : integer;
By: MaaaassturrRrrraymond
Description: Returns the selected item in invetory (if any), else returns -1.
*******************************************************************************}
function ActivatedItem : integer;
var
i : integer;
begin;
result := -1;
for i := 1 to 28 do
if ItemActivated(i) then
begin
result := i;
exit;
end;
end;
WorldSwitcher.Scar
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ? WorldSwitch routines --//
//-----------------------------------------------------------------//
// * function WorldScreen: Boolean; // by Narcle
// * function OpenWorldScreen: Boolean; // by Bionicle1800
// * function UpdateWorlds: Boolean; // by mixster & Nava2
// * procedure LoadWorldArrays; // by Narcle
// * function FindWorld(W: integer): Boolean; // by Narcle
// * function GetWorldInfo(World: Integer; var WorldRec: TWorld): Boolean; // by Narcle
// * function WS_CurrentWorld(var World: Integer): Boolean; // by IceFire908
// * function GetWorldInfo(World: Integer; var WorldRec: TWorld): Boolean; // by Narcle
// * function FindWorld(W: integer): Boolean; // by Narcle
// * function SelectWorld(WorldNumber: Integer): Boolean; // by Narcle & ZephyrsFury
// * function RandomWorld(Members, PvP: Boolean): Integer; // by Narcle & mixster
// * function ChangeWorld(W: Integer): Boolean; // by Nava2
// * Procedure OrderWorlds(by: string; Descending: boolean); // by NaumanAkhlaQ
// * Function ChooseWorldBy(SettingsNames:TStringArray; SettingsDescending: TBooleanArray; Members, PVP: boolean): boolean; // by Rasta Magician
type
TWorld = record
Number, PlayerNo: Integer;
Members: Boolean;
Prefix, Location, Activity, Language: String;
LootShare, QuickChat, PVP: Boolean;
end;
TWorldArray = array of TWorld;
var
WorldArray: TWorldArray;
WorldsOrdered: Boolean;
function ExitToLobby: Boolean; forward;
function LogInPlayer: Boolean; forward;
{*******************************************************************************
function WorldScreen: Boolean;
by: IceFire908
Description: Returns true if the World screen is open.
*******************************************************************************}
function WorldScreen: Boolean;
begin
Result := (GetLobbyTab = L_WorldSelect);
end;
{*******************************************************************************
function OpenWorldScreen: Boolean;
by: Bionicle1800
Description: Opens the world screen. Returns true if world screen is opened.
*******************************************************************************}
function OpenWorldScreen: Boolean;
begin
Result := LobbyTab(2);
end;
const
SRL_LG_ENGLISH = 0;
SRL_LG_GERMAN = 1;
SRL_LG_FRENCH = 2;
SRL_LG_PORTUGUESE = 3;
SRL_WORLDPARSE_LANG = SRL_LG_ENGLISH;
{*******************************************************************************
procedure UpdateWorlds;
by: mixster
Description: Parses the worlds page into Worlds.INI
*******************************************************************************}
function UpdateWorlds: Boolean;
var
worldList: TWorldArray;
str, Path: string;
tsa, tsb: TStringArray;
W, I, H, Time: Integer;
begin
try
Result := True;
Path := IncludePath + 'SRL\SRL\misc\Worlds.INI';
Writeln('NOTE: Attempting to update the Worlds.INI, please allow the script to access this file.');
Time := GetTimeRunning;
W := RewriteFile(Path, False);
CloseFile(W);
if (SRL_WORLDPARSE_LANG = SRL_LG_ENGLISH) then
str := ''
else
str := 'l=' + IntToStr(SRL_WORLDPARSE_LANG) + '/';
str := GetPage('http://www.runescape.com/' + str + 'slu.ws?order=WMPLA');
Delete(str, 1, Pos('<a href="?order=MWPLA">', str));
Delete(str, 1, Pos('<tr', str) + 3);
tsa := srl_Explode(str, '<tr');
H := High(tsa);
SetLength(worldList, H + 1);
for I := 0 to H do
with worldList[I] do
begin
tsb := srl_Explode(tsa[I], '<td');
if High(tsb) < 5 then
begin
Writeln('Skipping world "' + IntToStr(I + 1) + '" because explosion didn''t return enough values');
Continue;
end;
PlayerNo := StrToIntDef(Between('>', '<', tsb[2]), 2000);
if (Between('"', '"', tsb[3]) = 'a') or (Between('"', '"', tsb[3]) = 'a d') then
begin
Location := 'Activity';
Activity := Between('>', '<', tsb[3]);
end
else
begin
Location := Between('>', '<', tsb[3]);
Activity := '';
end;
Prefix := Between('http://', '.runescape', tsb[1]);
if Prefix = '' then
Prefix := Replace(Lowercase(Between('>' + #10, #10 + #10, tsb[1])), ' ', '');
Number := StrToIntDef(Replace(Prefix, 'world', ''), -1);
if Number = -1 then
begin
Writeln('Invalid world number produced: ' + Prefix);
Writeln('Assuming has suffix, trying again');
str := Replace(Prefix, 'world', '');
Number := StrToIntDef(Copy(str, 1, Length(str) - 1), -1);
if Number = -1 then
Writeln('Failed to gather a world number')
else
Writeln('Succeeded, got ' + IntToStr(Number));
end;
LootShare := Between('"', '"', tsb[4]) = 'd';
QuickChat := Activity = 'Quick Chat';
PvP := Activity = 'PvP World';
Members := Between('"', '"', tsb[5]) = 'm';
end;
//Writeln('Writing to the INI File. T: ' + IntToStr(GetTimeRunning - W));
except
Result := False;
//SRL_Warn('UpdateWorlds', ExceptionToString(ExceptionType, ExceptionParam), Warn_AllVersions);
end;
if not Result then Exit;
WriteINI('Worlds', 'Count', IntToStr(High(worldList) + 1), Path);
WriteINI('Worlds', 'High', IntToStr(worldList[High(worldList)].Number) + #13#10, Path);
H := High(worldList);
for I := 0 to H do
with worldList[I] do
begin
Str := 'World' + IntToStr(Number);
DeleteINI(Str, '', Path);
WriteINI(Str, 'Prefix', Prefix, Path);
WriteINI(Str, 'Activity', Activity, Path);
//WriteINI(Str, 'Type', BoolToStr(Members), Path);
if (Members) then
WriteINI(Str, 'Type', 'Members', Path)
else
WriteINI(Str, 'Type', 'Free', Path);
//WriteINI(Str, 'Flag', fla + 'Flag', Path);
WriteINI(Str, 'Location', Location, Path);
WriteINI(Str, 'LootShare', BoolToStr(LootShare), Path);
WriteINI(Str, 'QuickChat', BoolToStr(QuickChat), Path);
WriteINI(Str, 'PvP', BoolToStr(PvP) + #13#10, Path);
end;
Writeln('Parsed Worlds Page into Worlds.INI. Took ' + IntToStr(GetTimeRunning - Time) + ' ms.');
end;
{*******************************************************************************
procedure LoadWorldArrays;
by: Narcle; Edits by Nava2
Description: Loads the world array into WorldArray from Worlds.ini
*******************************************************************************}
procedure LoadWorldArrays;
var
i, H, Hw: integer;
begin
try
H := StrToInt(ReadINI('Worlds', 'High', IncludePath + 'SRL\SRL\misc\Worlds.ini'));
except
Writeln('LoadWorldArrays: Could not load world arrays, attempting to rewrite Worlds.INI');
if not UpdateWorlds then
begin
SRL_Warn('LoadWorldArrays', 'Could not Load World arrays, please download mixster''s world parser, and replace Worlds.ini', Warn_AllVersions);
Exit;
end;
end;
SetArrayLength(WorldArray, H + 1);
for i := 1 to H do
if not (ReadINI('World' + IntToStr(i), 'Prefix', IncludePath + 'SRL\SRL\misc\Worlds.ini') = '') then
begin
WorldArray[Hw].Number := i;
WorldArray[Hw].Prefix := ReadINI('World' + IntToStr(i), 'Prefix', IncludePath + 'SRL\SRL\misc\worlds.ini');
WorldArray[Hw].Members := (ReadINI('World' + IntToStr(i), 'Type', IncludePath + 'SRL\SRL\misc\worlds.ini') = 'Members');
WorldArray[Hw].LootShare := StrToBool(ReadINI('World' + IntToStr(i), 'Lootshare', IncludePath + 'SRL\SRL\misc\worlds.ini'));
WorldArray[Hw].QuickChat := StrToBool(ReadINI('World' + IntToStr(i), 'Quickchat', IncludePath + 'SRL\SRL\misc\worlds.ini'));
WorldArray[Hw].PVP := StrToBool(ReadINI('World' + IntToStr(i), 'PvP', IncludePath + 'SRL\SRL\misc\worlds.ini'));
WorldArray[Hw].Language := ReadINI('World' + IntToStr(i), 'ServLang', IncludePath + 'SRL\SRL\misc\worlds.ini');
Inc(Hw);
end;
SetArrayLength(WorldArray, Hw);
end;
{*******************************************************************************
function WS_CurrentWorld(var World: Integer): Boolean;
by: IceFire908
Description: Results true if the current world is members,returns world number.
World returns -1 if failed. Only works at world screen.
*******************************************************************************}
function WS_CurrentWorld(var World: Integer): Boolean;
var
P: TPoint;
begin
World := -1;
if (not (WorldScreen)) then
Exit;
if (IsTextInAreaEx(618, 74, 705, 96, P.X, P.Y, 'orld', 0, SmallChars, False, False, 0, 1, clWhite)) then
World := StrToIntDef(GetNumbers(Trim(GetTextAtEx(P.X, P.Y, 0, SmallChars, False, False, 0, 1, clWhite, 15, False, tr_AllChars))), -1);
Result := FindColorTolerance(P.X, P.Y, 3141117, 596, 64, 701, 100, 20);
end;
{*******************************************************************************
function FindWorld(W: integer): Boolean;
by: Narcle
Description: Scrolls to area and returns true if world was found
*******************************************************************************}
function FindWorld(W: integer): Boolean;
Var
WPos, SPos, i, x, y, H, CurW: integer;
begin
if not WorldScreen then
Exit;
WS_CurrentWorld(CurW);
if (W = CurW) then
begin
Result := True;
WriteLn('Already on world ' + IntToStr(W));
Exit;
end;
if Length(WorldArray) < 1 then
LoadWorldArrays;
H := High(WorldArray);
for i := 0 to H do
if (WorldArray[i].Number = W) then
begin
WPos := i+1;
Break;
end;
SPos := Round(WPos/(H+1)*100);
if not WorldsOrdered then
begin
Mouse(116, 125, 4, 4, true);//makes them drop down
WorldsOrdered := true;
wait(500+random(500));
end;
if (WPos < 16) then SPos := 0;
if (WPos > H-9) then SPos := 100;
Mouse(699, Round(SPos/100.0*262.0+156), 3, 0, true);
wait(300+Random(100));
Result := IsTextInAreaEx(84, 134, 134, 440, X, Y, IntToStr(W) + ' ', 0, StatChars, False, False, -1, 2, 16579836) or
IsTextInAreaEx(84, 134, 134, 440, X, Y, IntToStr(W) + ' ', 0, StatChars, False, False, -1, 2, 6618364);
end;
{*******************************************************************************
function GetWorldInfo(World: Integer; var WorldRec: TWorld): Boolean;
by: Narcle
Description: Records World info into TWorld record, also Results true if world
was found
*******************************************************************************}
function GetWorldInfo(World: Integer; var WorldRec: TWorld): Boolean;
var
xx, yy, x, y, Color: integer;
begin
if (WorldScreen) then
begin
Color := 16579836;//white
if not IsTextInAreaEx(84, 134, 134, 440, X, Y, IntToStr(World) + ' ', 0, StatChars, False, False, 0, 2, Color) then
begin
Color := 6618364;//yellow
if IsTextInAreaEx(84, 134, 134, 440, X, Y, IntToStr(World) + ' ', 0, StatChars, False, False, 0, 2, Color) then
WorldRec.Members := true
else
Exit;
end;
WorldRec.Number := World;
WorldRec.PlayerNo := StrToIntDef(Trim(GetTextAtEx(137, y, 0, StatChars, False, False, 0, 2, Color, 5, False, tr_Digits)), -1);
WorldRec.Activity := Trim(GetTextAtEx(238, y, 0, StatChars, False, False, 0, 2, Color, 24, False, tr_AllChars));
WorldRec.LootShare := FindColor(xx, yy, 7711612, 600, y-4, 636, y+14);
WorldRec.QuickChat := Pos('uick', WorldRec.Activity) > 0;
WorldRec.PVP := Pos('ounty', WorldRec.Activity) > 0;
Result := (WorldRec.PlayerNo > 0);
end;
end;
{*******************************************************************************
Function SelectWorld(W: Integer): Boolean;
by: Narcle & ZephyrsFury
Description: Switches to the specified world. Returns true if successful.
*******************************************************************************}
function SelectWorld(W: integer): boolean;
var
x, y, xx, yy, T, CurW: integer;
WRec: TWorld;
begin
if OpenWorldScreen then
begin
wait(400+random(200));
WS_CurrentWorld(CurW);
if (W = CurW) then
begin
Result := True;
WriteLn('Already on world ' + IntToStr(W));
Exit;
end;
if FindWorld(W) then
begin
wait(100+random(100));
if GetWorldInfo(W, WRec) then
begin
Writeln('World: '+inttostr(WRec.Number)+', Players: '+inttostr(WRec.PlayerNo)+', Members: '+Booltostr(WRec.Members)+', PvP: '+Booltostr(WRec.PVP));
if FindText(x, y, ' '+inttostr(W)+' ', StatChars, 84, 134, 134, 440) then
begin
MMouse(x, y, 500, 4);
GetMousePos(x, y);
wait(400+random(100));
if FindColor(xx, yy, 6316128, x-20, y-2, x+20, y+2) then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
T := GetSystemTime;
if FindColor(xx, yy, 19890, x-20, y-2, x+20, y+2) then
begin
Writeln('World '+inttostr(W)+' selected.');
Result := true;
end;
end;
end;
end else
WriteLn('World ' + IntToStr(W) + ' is either OFFLINE or FULL.');
end else
WriteLn('Failed to find World ' + IntToStr(W) + '!');
if (not(Result)) then TypeByte(vk_Escape);
end;
end;
{*******************************************************************************
function RandomWorld(Members, PvP: Boolean): Integer;
by: Narcle & mixster
Description: Returns a random world by paramaters.
*******************************************************************************}
function RandomWorld(Members, PvP: Boolean): Integer;
var
i, H, l: integer;
wArray: TWorldArray;
begin
if High(WorldArray) < 0 then
LoadWorldArrays;
H := High(WorldArray);
SetLength(wArray, H + 1);
for i := 0 to H do
if (WorldArray[i].Members = Members) and (WorldArray[i].PvP = PvP) and (InStrArr(WorldArray[i].Language, ['English', ''], False)) then
begin
wArray[l] := WorldArray[i];
Inc(l);
end;
Result := wArray[random(l)].Number;
end;
{*******************************************************************************
function ChangeWorld(W: Integer): Boolean;
by: Nava2
Description: Changes to world W. Returns True if successful.
*******************************************************************************}
function ChangeWorld(W: Integer): Boolean;
begin
while LoggedIn do ExitToLobby;
Result := SelectWorld(W);
LoginPlayer;
end;
{*******************************************************************************
Procedure OrderWorlds(by: string; Descending: boolean);
by: NaumanAkhlaQ
Description: Orders worlds by 'by' in order 'Descending'
Check function for valid params of 'by'
Descending = true means the left button
*******************************************************************************}
procedure OrderWorlds(by: string; Descending: boolean);
var
ATPA: T2DPointArray;
Arr: array of tstringarray;
TPA: TPointArray;
I: Byte;
TB: TBox;
begin
Arr := [TStringArray(['world', 'w', 'worlds']), TStringArray(['players', 'pl', 'player']), TStringArray(['activity', 'location', 'loc', 'act']),
TStringArray(['ls', 'lootshare']), TStringArray(['type', 't']), TStringArray(['ping', 'pi'])];
for I := 0 To High(Arr) do
if InStrArr(Lowercase(By), Arr[i], False) then
Break;
FindColorsTolerance(TPA, 1074576, 0, 0, 716, 141, 1);
ATPA := SplitTPA(TPA, 2);
SortATPAFromFirstPoint(ATPA, Point(91, 124));
TB := GetTPABounds(ATPA[(I * 2) + Integer(Descending)]);
MouseBox(TB.x1, TB.y1, TB.x2, TB.y2, 1);
end;
{*******************************************************************************
Function ChooseWorldBy(SettingsNames:TStringArray; SettingsDescending: array of boolean; Members, PVP: boolean): boolean;
by: Rasta Magician
Description: Chooses a world by SettingsNames , ordered by SettingsDescending
Takes into account Members and PVP
Check OrderWorlds for valid params for SettingsNames
*******************************************************************************}
function ChooseWorldBy(SettingsNames:TStringArray; SettingsDescending: array of boolean; Members, PVP: boolean): boolean;
var
TPA: TPointArray;
i, C : integer;
begin
if not WorldScreen then
if not OpenWorldScreen then
exit;
if length(SettingsNames) <> length(SettingsDescending) then
begin
srl_warn('ChooseWorldBy', 'Arrays are not the same length', warn_AllVersions);
SelectWorld(RandomWorld(Members, PVP));
exit;
end;
for i:= 0 to High(SettingsNames) do
begin
OrderWorlds(SettingsNames[i], SettingsDescending[i]);
wait(1000+random(200));
end;
wait(1500+random(500));
for i:= 0 to 15 do //16 worlds show up in screen
begin
FindColorsTolerance(TPA, 16777215, 182, 150+18*i, 206, 159+18*i, 0);
C := Length(TPA);
if (C = 0)or(C = 66) then //failed detection or full
Continue;
if (Members)xor(GetColor(620, 157+18*i) <> 11316396) then
Continue;
if (PVP)xor(GetColor(589, 156+18*i) <> 1251528) then
Continue;
MouseBox(79, 148+18*i, 685, 165+18*i, 1);
for c := 0 to 4 do
begin
wait(200);
Result := not WorldScreen;
if Result then exit;
end;
end;
Result := false;
writeln('Failed to sort the worlds. Choosing random world. Members: ' +
BoolToStr(Members) + '; PVP: ' + BoolToStr(PVP) + ';');
SelectWorld(RandomWorld(Members, PVP));
end;
Im not sure if your getting SRL's Up-To-Date Include with the site being down and all…