Lol:
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ? Text Routines --//
//-----------------------------------------------------------------//
// * function srl_Explode(str, del: string): TStringArray; // by mixster
// * function srl_Implode(Pieces: TStringArray; Separator: string): string; // * by ZephyrsFury & mixster
// * procedure TypeByte(k: Byte); // by Mutant Squirrle
// * procedure TypeSendEx(Text: string; PressEnter: Boolean); // by SKy Scripter
// * procedure TypeSend(Text: String); // by N1ke!
// * function AddMistakes(Orig: string; Chance: Integer): string; // by ZephyrsFury
// * function GetUpText: String; // by Freddy1990
// * function IsUpText(UpText: String): Boolean; // by Masquerader / Nielsie95 / Freddy1990
// * function IsUpTextMultiCustom(Text: TStringArray): Boolean; // by Starblaster100 / Nielsie95 / Freddy1990
// * function GetLevelAtPos(x, y: Integer): integer; // by marpis and Nava2
// * function FindNPCChatText(txt: string; Action: (ClickLeft,ClickRight,Move,Nothing)): Boolean; // by Kernel Klink and Nielsie95
// * function FindText(var cx, cy: Integer; txt: String; font, xs, ys, xe, ye: Integer): Boolean; // by Stupid3ooo
// * function ClickText(txt: String; font, x1, y1, x2, y2: Integer; left: Boolean): Boolean; // by Stupid3ooo and SKy Scripter
// * Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray; // by Raymond
// * Function FindTextTpaEx(Color, Tol, xs, ys, xe, ye: integer; var x,y: integer; Txt: string; Chars: Integer; Action: (ClickLeft, ClickRight, Move, Nothing)): Boolean; // by Raymond
// * Function FindTextTpa(Color, Tol, xs, ys, xe, ye: integer; Txt: string; Chars: Integer; Action: (ClickLeft, ClickRight, Move, Nothing)): Boolean; // by Raymond
// * function FindTextTPAMulti(Color, tol, xs, ys, xe, ye: integer; Texts: TStringArray; Chars: string;/integer; Action: fnct_ActionOptions): Boolean; // by Cigue and EvilChicken!
// * function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean; // by Wizzup?, Nava2, and modified by N1ke!
// * function ChooseOptionMulti(Text: TStringArray): Boolean; // by Wizzup? modified by N1ke!
// * function ChooseOptionEx(Txt, TextType: String): Boolean; // by Wizzup?, Nava2, and modified by N1ke!
// * function ChooseOption(txt: String): Boolean; // by Stupid3ooo, modded by Sumilion
// * Function OptionsExist(txt: TStringArray; MoveMouse: boolean): boolean; // by Rasta Magician
// * procedure CloseWindow; // by Solemn Wishes, Starblaster100 and ZephyrsFury
// * Function InStrArrEx(S: String; StrArr: TStringArray; Var W: Integer): Boolean; // by n3ss3s
// * function StrInArr(str: string; arrS: TStringArray): Boolean; // by Narcle & Nava2
// * function ArrInStr(arrS: TStringArray; str: string): Boolean; // by Narcle & Nava2
// * procedure SetDebugColors(Text, Back: Integer); // by Nava2
// * procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer); // by Nava2
{ var OldLine,TheLine, TheName: String;
Description: ChatLog vars. }
var
OldLine, TheLine, TheName: string;
{ const clMessage, clChat, clTrade, clFriend
Description: Text colour constants. }
const
clMessage = clBlack;
clChat = clBlue;
clTrade = clPurple;
clFriend = 128;
function CloseBank: Boolean; Forward;
{*******************************************************************************
function srl_Explode(str, del: string): TStringArray;
By: mixster
Description: Explodes a string into a TStringArray, seperated by del.
*******************************************************************************}
function srl_Explode(str, del: string): TStringArray;
{$IFNDEF SCAR320_UP}
var
i, l, dL: Integer;
begin
i := 0;
l := -1;
SetLength(Result, 0);
if (str = '') then
Exit;
dL := Length(del) - 1;
repeat
Inc(l);
SetLength(Result, l + 1);
i := Pos(del, str);
if i <= 0 then
Break;
Result[l] := Copy(str, 1, i - 1);
Delete(str, 1, i + dL);
until false;
Result[l] := Copy(str, 1, Length(str));
{$ELSE}
begin
Result := Explode(del, str);
{$ENDIF}
end;
{*******************************************************************************
function srl_Implode(Pieces: TStringArray; Separator: string): string;
By: ZephyrsFury & mixster
Description: Combines Pieces in a single string separated by a Separator.
*******************************************************************************}
function srl_Implode(Pieces: TStringArray; Glue: string): string;
{$IFNDEF SCAR320_UP}
var
II, H: Integer;
begin
H := High(Pieces);
if (H < 0) then Exit;
Result := Pieces[0];
if H > 0 then
for II := 1 to H do
Result := Result + Glue + Pieces[II];
{$ELSE}
begin
Result := Implode(glue, pieces);
{$ENDIF}
end;
{*******************************************************************************
procedure TypeByte(k: Byte);
By: Mutant Squirrle
Description: Types one char.
*******************************************************************************}
procedure TypeByte(k: Byte);
begin
KeyDown(k);
Wait(10 + Random(50));
KeyUp(k);
end;
{*******************************************************************************
procedure TypeSendEx(Text: string; PressEnter: Boolean);
By: SKy Scripter
Description: Sends human like text.
*******************************************************************************}
procedure TypeSendEx(Text: string; PressEnter: Boolean);
var
S: string;
I, L: Integer;
Shift: Boolean;
begin
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
L := Length(Text);
for I := 1 to L do
begin
Shift := (Pos(Text[i], S) > 0);
if (Shift) then
begin
KeyDown(VK_SHIFT);
Wait(40 + Random(40));
while (Pos(Text[i], S) > 0) and (I <= Length(Text)) do
begin
TypeByte(GetKeyCode(Text[I]));
Wait(40 + Random(40));
Inc(I);
if (I > Length(Text)) then Break;
end;
end;
if (Shift) then
KeyUp(VK_SHIFT);
Wait(40 + Random(40));
if (I <= Length(Text)) then
begin
TypeByte(GetKeyCode(Text[I]));
Wait(40 + Random(40));
end;
end;
if (PressEnter) then
TypeByte(GetKeyCode(Chr(13)));
end;
{*******************************************************************************
procedure TypeSend(Text: string);
By: N1ke!
Description: Sends human like text.
*******************************************************************************}
procedure TypeSend(Text: string);
begin
TypeSendEx(Text, True);
end;
{*******************************************************************************
function AddMistakes(Orig: string; Chance: Integer): string;
By: ZephyrsFury
Description: Adds human mistakes to Orig such as mistypes, missing letters,
wrong cases. Probability that a character is typed wrong is 1 / Chance. ie.
Higher 'Chance' = less mistakes (I know thats stupid but oh well...).
Probability is the chance that an individual character is typed incorrectly.
That is if you have more characters in a string you will get more mistakes overall.
20 - 30 is usually good but it varies depending on your string so experiment!
Use: TypeSend(AddMistakes('Hello', 20));
*******************************************************************************}
function AddMistakes(Orig: string; Chance: Integer): string;
var
Line1, Line2, Line: array [0..3] of string;
i, j, TPos, Prob, Mist, L: Integer;
Norm, Caps, Excp, TLine, NewKey: string;
begin
Result := '';
Norm := '`1234567890-=qwertyuiop[]\asdfghjkl;''zxcvbnm,./';
Caps := '~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:"ZXCVBNM<>?';
Excp := '`1234567890-=[]\;'',./~!@#$%^&*()_+{}|:"<>?';
Line1[0] := '`1234567890-= '; Line2[0] := '~!@#$%^&*()_+ ';
Line1[1] := ' qwertyuiop[]\'; Line2[1] := ' QWERTYUIOP{}|';
Line1[2] := ' asdfghjkl;'' '; Line2[2] := ' ASDFGHJKL:" ';
Line1[3] := ' zxcvbnm,./ '; Line2[3] := ' ZXCVBNM<>? ';
L := Length(Orig);
for i := 1 to L do
begin
Prob := Chance;
Prob := Prob + Mist; //More mistakes = less chance of another mistake
if (Pos(Orig[i], Excp) <> 0) then Prob := Prob - 2; //If char is hard to type (numbers/symbols) - more chance
if (i = 1) then Prob := Prob + 5; //The first letter - less chance
if (Orig[i] <> ' ') and (Random(Max(Prob, 0)) = 0) then
begin
if (Pos(Orig[i], Norm) <> 0) then
Line := Line1
else
if (Pos(Orig[i], Caps) <> 0) then
Line := Line2;
for j := 0 to 3 do
begin
TPos := Pos(Orig[i], Line[j]);
if (TPos <> 0) then
case Random(19) of
0..5: //Same line
begin
TLine := Line[j];
try
NewKey := TLine[TPos - 1 + Random(3)];
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
6..8: //Line above
begin
TLine := Line[Max(j - 1, 0)];
try
NewKey := Line[j - 1][TPos + Random(2)];
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
9..11: //Line below
begin
TLine := Line[Min(j + 1, High(Line))];
try
NewKey := TLine[TPos - 1 + Random(2)]; //Wrong case
except end;
if (NewKey = '') or (NewKey = ' ') then
NewKey := TLine[TPos];
end;
12..16:
begin
if (i - 1 >= 1) then
begin
if (Pos(Orig[i - 1], Caps) <> 0) then
NewKey := Line2[j][TPos]
else
if (Pos(Orig[i - 1], Norm) <> 0) then
NewKey := Line1[j][TPos]
end else
if (i + 1 <= Length(Orig)) then
begin
if (Pos(Orig[i + 1], Caps) <> 0) then
NewKey := Line2[j][TPos]
else
if (Pos(Orig[i + 1], Norm) <> 0) then
NewKey := Line1[j][TPos];
end;
end;
17, 18: if (i <> 1) then NewKey := ''; //Missing letters
end;
end;
end else
NewKey := Orig[i];
if (NewKey <> Orig[i]) then Inc(Mist);
Result := Result + NewKey;
end;
end;
{*******************************************************************************
function GetUpText: String;
By: Freddy1990
Description: Returns text in upperleft corner.
*******************************************************************************}
function GetUpText: string;
begin
{$IFDEF SIMBA}
Result := rs_GetUpText
{$ELSE}
{$IFDEF SCAR322_UP}
Result := rs_GetUpText;
{$ELSE}
Result := rs_GetUpTextAt(8, 8, 25);
{$ENDIF}
{$ENDIF}
end;
{*******************************************************************************
function IsUpText(UpText: String): Boolean;
By: Freddy1990
Description: Returns up text that might be to the right
*******************************************************************************}
function IsUpText(UpText: string): Boolean;
begin
Result := (Pos(UpText, GetUpText) > 0);
end;
{*******************************************************************************
function IsUpTextMultiCustom(Text: TStringArray): Boolean;
By: Starblaster100 / Nielsie95 / Freddy1990
Description: Checks for the occurance of any of the strings in the array.
Use: IsUpTextMultiCustom(['Att', 'ttac', 'ack', 'monst', 'ster'])
*******************************************************************************}
function IsUpTextMultiCustom(Text: TStringArray): Boolean;
var
TheText: string;
i, n: Integer;
begin
TheText := GetUpText;
n := High(Text);
for i := 0 to n do
if (Pos(Text[i], TheText) > 0) then
begin
Result := True;
Exit;
end;
end;
{*******************************************************************************
function GetLevelAtPos(x, y: Integer): integer;
By: marpis and Nava2
Description: Returns the level of the character at (x, y), uses uptext. Returns
-1 if none are found.
*******************************************************************************}
function GetLevelAtPos(x, y: Integer): integer;
begin
MMouse(x, y, 0, 0);
Wait(RandomRange(80, 150));
Result := StrToIntDef(Between('l: ', ')', GetUpText), -1);
end;
{*******************************************************************************
function FindNPCChatText(txt: string; Action: (ClickLeft,ClickRight,Move,Nothing)): Boolean;
By: Kernel Klink and Nielsie95
Description: Finds a text said by a NPC in chat. If found it'll perform action,
where action can be:
Nothing - Just return wether its found
Move - Just move the mouse to it
Clickleft - Movemouse & Clickmouse left
Clickright - MoveMouse & Clickmouse right
*******************************************************************************}
function FindNPCChatText(txt: string; Action: fnct_ActionOptions): Boolean;
var
tx, ty, S: Integer;
begin
Result := False;
if txt = '' then
begin
srl_Warn('FindNPCChatText', 'txt is empty', warn_AllVersions);
Exit;
end;
S := CreateBitmapMaskFromText(txt, NPCChars);
if FindBitmapMaskTolerance(S, tx, ty, 9, 348, 523, 471, 50, 10) then
begin
Result := True;
case Action of
Move: MMouse(tx, ty + 2, Random(Length(txt) * 5), 4);
ClickLeft: Mouse(tx, ty + 2, Random(Length(txt) * 5), 4, True);
ClickRight: Mouse(tx, ty + 2, Random(Length(txt) * 5), 4, False);
end;
end;
FreeBitmap(S);
end;
{*******************************************************************************
function FindText(var cx, cy: Integer; txt: String; font, xs, ys, xe, ye: Integer): Boolean;
By: Stupid3ooo
Description: Searches for text in specified box with specified font.
*******************************************************************************}
{$IFDEF SIMBA}
function FindText(var cx, cy: Integer; txt,font: string; xs, ys, xe, ye:
Integer): Boolean;
{$ELSE}
function FindText(var cx, cy: Integer; txt: string; font, xs, ys, xe, ye:
Integer): Boolean;
{$ENDIF}
var
S: Integer;
begin
S := CreateBitmapMaskFromText(txt, font);
if (xs < 0) then xs := 0;
if (ys < 0) then ys := 0;
Result := FindBitmapMaskTolerance(S, cx, cy, xs, ys, xe, ye, 30, 30);
FreeBitmap(S);
end;
{*******************************************************************************
function ClickText(Text: string; Chars, x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
By: SKy Scripter
Description: Clicks text if found in box.
*******************************************************************************}
{$IFDEF SIMBA}
function ClickText(Text, Chars: string;x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
{$ELSE}
function ClickText(Text: string; Chars, x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
{$ENDIF}
var
Mask, w, h, tx, ty: Integer;
begin
try
Mask:= CreateBitmapMaskFromText(Text, Chars);
except
srl_Warn('ClickText', 'Invalid Character Names', warn_AllVersions);
Exit;
end;
Result:= FindBitmapMaskTolerance(Mask, tx, ty, x1, y1, x2, 502, 10, 10);
GetBitmapSize(Mask, W, H);
FreeBitmap(Mask);
if(Result)then
Mouse(TX + (W div 4), TY + (H div 4), (W div 2), (H div 2), Left);
end;
{*******************************************************************************
Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray;
By: Raymond
Description: Loads a TPA of the text.. It also returns the real height
of the Text.. Used in FindTextTPAinTPA
*******************************************************************************}
{$IFNDEF SIMBA}
function LoadTextTPA(Text: string; Chars: Integer; var height: integer): TPointArray;
var
DC: HDC;
CTS, w, h :INteger;
BMP: Integer;
begin;
BMP := CreateBitmapMaskFromText(Text,Chars);
DC := GetClientCanvas.Handle;
CTS := GetColorToleranceSpeed;
ColorToleranceSpeed(0);
GetBitmapSize(BMP,W,H);
SetTargetDc(GetBitmapDc(BMP));
FindColorsTolerance(Result,clwhite,0,0,w+1,h+1,0);
height := h - 1;
SetTargetDC(DC);
ColorToleranceSpeed(CTS);
FreeBitmap(BMP);
end;
{$ELSE}
function LoadTextTPA(Text, Chars: string; var height: integer): TPointArray;
var
w: integer;
begin
result := TPAFromText(text,chars,w,height);
dec(height);
end;
{$ENDIF}
{*******************************************************************************
function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean;
By: Raymond
Description: Uses TPA's to find text..Returns the found pos in x and y (if not found both are 0)
In action you can put what you want to do after its found..
Nothing - Just return wether its found
Move - Just move the mouse to it
Clickleft - Movemouse & Clickmouse left
Clickright - MoveMouse & Clickmouse right
*******************************************************************************}
{$IFDEF SIMBA}
function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt, Chars : string; Action :fnct_ActionOptions ) : Boolean;
{$ELSE}
function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action :fnct_ActionOptions ) : Boolean;
{$ENDIF}
var
TextTPA,SearchTPA, Matches: TPointArray;
Box : TBox;
xx,yy : integer;
begin
FindColorsTolerance(SearchTPA,Color,xs,ys,xe,ye,tol);
if Length(SearchTPA) < 1 then
Exit;
TextTPA:= LoadTextTPA(Txt,Chars,yy);
Result := FindTextTPAinTPA(yy ,TextTPA,SearchTPA,Matches);
x := 0; y:=0;
if Result = False then
Exit;
Box := GetTPABounds(TextTPA);
SortTPAFrom(Matches, Point(Box.x1, Box.y1));
x := matches[0].x;
y := matches[0].y;
if Action = Nothing then
Exit;
GetMousePos(xx,yy);
if not IntInBox(xx,yy,IntToBox(matches[0].x,matches[0].y,matches[0].x + Box.x2,Matches[0].y + (Box.y2 shr 1))) then
MMouse(matches[0].x + Random(box.x2),Matches[0].y + Random(Box.y2 shr 1),0,0);
if Action = Move then
Exit;
GetMousePos(xx,yy);
Case Action of
ClickLeft : Mouse(xx,yy,0,0,true);
ClickRight: Mouse(xx,yy,0,0,false);
end;
end;
{*******************************************************************************
function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean;
By: Raymond
Description: Just like FindTextTPAEx, but without the x and y pos returning.
*******************************************************************************}
{$IFDEF SIMBA}
function FindTextTpa(Color, Tol, xs, ys, xe, ye: integer; Txt, Chars: string; Action: fnct_ActionOptions): Boolean;
{$ELSE}
function FindTextTpa(Color, Tol, xs, ys, xe, ye: integer; Txt: string; Chars : Integer; Action: fnct_ActionOptions): Boolean;
{$ENDIF}
var
x,y : integer;
begin
Result := FindTextTPAEx(Color,Tol,xs,ys,xe,ye,x,y,Txt,chars,action);
end;
{*******************************************************************************
function FindTextTPAMulti(Color, tol, xs, ys, xe, ye: integer;
Texts: TStringArray; Chars: string;/integer; Action: fnct_ActionOptions): Boolean;
By: Cigue and EvilChicken!
Description: Just like FindTextTPA, only that it takes an array of strings as
text to search for. Chars is supposed to be specified as a string if you
use Simba and as an integer otherwise.
*******************************************************************************}
{$IFDEF SIMBA}
function FindTextTPAMulti(Color, tol, xs, ys, xe, ye: integer;
Texts: TStringArray; Chars: string; Action: fnct_ActionOptions): Boolean;
{$ELSE}
function FindTextTPAMulti(Color, tol, xs, ys, xe, ye: integer;
Texts: TStringArray; Chars: Integer; Action: fnct_ActionOptions): Boolean;
{$ENDIF}
var
I: Integer;
begin
for i := 0 to High(Texts) do
if FindTextTPA(Color, Tol, xs, ys, xe, ye, Texts[i], Chars, Action) then
begin
Result := True;
Exit;
end;
end;
{*******************************************************************************
function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
By: Wizzup?, Nava2, and N1ke!
Description: Finds Popup menu, then clicks on it.
Will look for the first string first and so on.
It will search for the Text Type you input valid arguments are
'action', 'player': The white text
'npc': The yellow text
'object': The cyan text
'all': Searches for all colors of text.
Will default to 'all'.
*******************************************************************************}
function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
var
B,OptionBox: TBox;
TPA, TPA1, TPA2, TextTPA: TPointArray;
aTPA: T2DPointArray;
I, H, HH, ii, L: Integer;
Colors,SearchCols: TIntegerArray;
begin
Result := False;
GetClientDimensions(B.X2, B.Y2);
B.X1 := 0;
B.Y1 := 0;
Dec(B.X2);
Dec(B.Y2);
FindColorsTolerance(TPA1, 4343893, B.X1, B.Y1, B.X2, B.Y2, 0);
FindColorsTolerance(TPA2, 3950929, B.X1, B.Y1, B.X2, B.Y2, 0);
TPA := CombineTPA(TPA1, TPA2);
If Length(TPA) < 10 Then
Exit;
B.X2 := 0;
B.Y2 := 0;
aTPA := SplitTPAEx(TPA, 20, 20);
SortATPASize(aTPA, True);
B := GetTPABounds(aTPA[0]);
Colors := [13034990, 4231423, 2070783, 65535, 16776960, 9812166, 16777215];
TextType := LowerCase(TextType);
case TextType of
'action', 'player': SearchCols := [0,5,6];
'item' : SearchCols := [1,2];
'npc' : SearchCols := [3];
'object': SearchCols := [4];
else
SearchCols := [0,1,2,3,4,5,6];
end;
L := High(SearchCols);
SetLength(aTPA,l+1);
for i := 0 to l do
FindColorsTolerance(aTPA[I], Colors[SearchCols[I]], B.X1, B.Y1, B.X2, B.Y2, 3);
TPA := MergeATPA(aTPA);
aTPA := SplitTPAEx(TPA, 15, 1);
L := High(aTPA);
H := High(Texts);
SortATPAFromFirstPoint(ATPA, Point(OptionBox.X1, optionbox.y1));
for I :=0 To H do
begin
TextTPA := LoadTextTPA(Texts[i], UpChars, HH);
for ii := 0 to L do
If FindTextTPAInTPA(HH, TextTPA, aTPA[ii], TPA) Then
begin
Result := True;
case Action of
ClickLeft: MouseBoxEx(B.x1 + 5, TPA[0].Y, B.x2 - 5, TPA[0].Y + 2,5, 1);
Move: MouseBoxEx(B.x1 + 5, TPA[0].Y, B.x2 - 5, TPA[0].Y + 2,5, 3);
Nothing: begin end;
else
srl_warn('ChooseOptionMultiEx', 'ClickRight not a valid click for RS menus!', warn_AllVersions);
end;
Exit;
end;
end;
if Action <> Nothing then
begin
MMouse(B.X1 - 50, B.Y1 - 50, 40, B.Y2 - B.Y1);
Wait(200 + Random(100));
end;
end;
{*******************************************************************************
function ChooseOptionMulti(Text: TStringArray): Boolean;
By: Wizzup? modified by N1ke!
Description: Finds Popup menu, then clicks on it.
Will look for the first string first and so on.
*******************************************************************************}
function ChooseOptionMulti(Txt: TStringArray): Boolean;
begin
Result := ChooseOptionMultiEx(Txt, 'All', ClickLeft);
end;
{*******************************************************************************
function ChooseOptionEx(Txt, TextType: string): Boolean;
By: Wizzup?
Description: Finds an option in a popup menu, then clicks on it. Searches for
TextType. See ChooseOptionMultiEx for valid options.
Default is 'all'.
*******************************************************************************}
function ChooseOptionEx(Txt, TextType: string): Boolean;
begin
Result := ChooseOptionMultiEx([Txt], TextType, ClickLeft);
end;
{*******************************************************************************
function ChooseOption(txt: String): Boolean;
By: Wizzup?
Description: Finds an option in a popup menu, then clicks on it.
*******************************************************************************}
function ChooseOption(Txt: String): Boolean;
begin
Result := ChooseOptionMultiEx([Txt], 'All', ClickLeft);
end;
{*******************************************************************************
function OptionsExist(txt: TStringArray; Move: boolean): boolean;
By: Rasta Magician
Description: Returns true if an Option in txt is found in the RS Option Menu
Will move or do nothing according to the boolean Move
*******************************************************************************}
function OptionsExist(txt: TStringArray; MoveMouse: boolean): boolean;
begin
if MoveMouse then
Result := ChooseOptionMultiEx(Txt, 'All', Move)
else
Result := ChooseOptionMultiEx(Txt, 'All', Nothing);
end;
{*******************************************************************************
function CloseWindow: Boolean;
By: NaumanAkhlaQ, Narcle, and Nava2
Description: Closes any open windows.
*******************************************************************************}
function CloseWindow: Boolean;
var
Col: TIntegerArray;
b: T2DPointArray;
a: T2DPointArray;
Pa: TBox;
I, ii, {h,} l: Integer;
begin
Result := CloseBank;
Col := [1118997, 1449250, {Main typ 1}
8042720, 4160933, {Skill}
6854059, 2902100, {Quest}
4282212, 2503226, {Main typ 2}
39423, 13567, {Red X}
1514271, 1580837, {Deposit Box}
2106925, 1250584];
SetLength(b, 2);
for I := 0 to 6 do
begin
FindColors(b[0], Col[i*2], MSCX, MSY1, MSX2, MSCY);
FindColors(b[1], Col[i*2+1], MSCX, MSY1, MSX2, MSCY);
l := (High(b[0]) + High(b[1]));
//Writeln(IntToStr(i) + ' Col1: ' + IntToStr(High(b[0])) + ' Col2: ' + IntToStr(High(b[1])) + ' T: ' + IntToStr(l));
if InRange(l, 6, 53) or InRange(l, 94, 250) then
begin
a := SplitTPA(CombineTPA(b[0], b[1]), 5);
SortATPAFromFirstPoint(a, Point(385, 100));
//DebugATPA(a, '');
for ii := 0 to 0 do
begin
Pa := GetTPABounds(a[ii]);
if ((Pa.x2 - Pa.x1) > 50) or ((Pa.y2 - Pa.y1) > 50) then Continue;
MMouse(RandomRange(Pa.x1, Pa.x2), RandomRange(Pa.y1, Pa.y2), 0, 0);
Result := (Pos('lose', GetUpText) > 0) or (Pos('ack', GetUpText) > 0);
Pa.x2 := GetTimeRunning + 2000;
while (not Result) and (GetTimeRunning < Pa.x2) do
begin
Wait(10);
Result := (Pos('lose', GetUpText) > 0);
end;
Wait(Random(300));
if Result then
begin
GetMousePos(Pa.x1, Pa.y1);
Mouse(Pa.x1, Pa.y1, 0, 0, True);
Result := True;
//Writeln('Close Window Type ' + IntToStr(i));
Exit;
end;
end;
end;
end;
end;
{*******************************************************************************
function InStrArrEx(S: Sstring; StrArr: TStringArray; var Where: Integer): Boolean;
By: n3ss3s
Description: Returns true if the string S was found in the StrArr, and if so
stores the index into Where.
*******************************************************************************}
function InStrArrEx(S: string; StrArr: TStringArray; var Where: Integer): Boolean;
var
I, H: Integer;
begin
H := High(StrArr);
for I := 0 to H do
if LowerCase(StrArr[i]) = LowerCase(S) then
begin
Where := i;
Result := True;
Break;
end;
end;
{*******************************************************************************
function StrInArr(str: string; arrS: TStringArray): Boolean;
By: Narcle & Nava2
Description: Returns True if str is found in the Array. Case sensitive. Uses Pos
*******************************************************************************}
function StrInArr(str: string; arrS: TStringArray): Boolean;
var
I, L, H: Integer;
begin
Result := True;
L := Low(arrS); H := High(arrS);
for I := L to H do
if Pos(Str, arrS[I]) > 0 then
Exit;
Result := False;
end;
{*******************************************************************************
function ArrInStr(arrS: TStringArray; str: string): Boolean;
By: Narcle & Nava2
Description: Returns True if the Array is found in the str. Case sensitive. Uses Pos
*******************************************************************************}
function ArrInStr(arrS: TStringArray; str: string): Boolean;
var
I, L, H: Integer;
begin
Result := True;
L := Low(arrS); H := High(arrS);
for I := L to H do
if Pos(arrS[I], Str) > 0 then
Exit;
Result := False;
end;
{*******************************************************************************
procedure SetDebugColors(Text, Back: Integer);
By: Nava2
Description: Sets the next WriteLn's colours to Text and Back respectively.
*******************************************************************************}
procedure SetDebugColors(txtCol, BackCol: Integer);
{$IFDEF SCAR320_UP}
var
T: TDebugParams;
begin
T.BackColor := BackCol;
T.Color := txtCol;
T.Name := 'Courier New';
SetDebugParams(T);
end;
{$ELSE}
begin
end;
{$ENDIF}
{*******************************************************************************
procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer);
By: Nava2
Description: Writes a TStringArray with Text and Back colours. If not using
3.20, it will just writeln the array.
*******************************************************************************}
procedure WriteArrayCols(Lines: TStringArray; Text, Back: Integer);
var
i, h: Integer;
begin
h := High(Lines);
for i := 0 to h do
begin
SetDebugColors(Text, Back);
Writeln(Lines[i]);
end;
end;
//------------------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ? Grand Exchange Routines --//
//------------------------------------------------------------------------//
// * function InGE: boolean; // * by Rasta Magician
// * function GEIsMember: boolean; // * by Rasta Magician
// * function GESellMenu: boolean; // * by Rasta Magician
// * function GEBuyMenu: boolean; // * by Rasta Magician
// * procedure GEMenuExit; // * by Rasta Magician
// * function GESpotToTBox(spot: integer): TBox; // * by Rasta Magician
// * function GEIsSpotFree(spot: integer):boolean; // * by Rasta Magician
// * function GEFinishedAt(spot: integer): boolean; // * by Rasta Magician
// * procedure GERecoverAtEx(spot: integer; abort:boolean); // * by Rasta Magician
// * procedure GERecoverAt(spot: integer); // * by Rasta Magician
// * procedure GERecoverFinishedAt(spot: integer); // * by Rasta Magician
// * procedure GEAbortAll; // * by Rasta Magician
// * procedure GERecoverAll; // * by Rasta Magician
// * procedure GERecoverFinished; // * by Rasta Magician
// * function GEFindFreeSpot(var spot:integer): boolean; // * by Rasta Magician
// * function GESellAt(spot: integer): boolean; // * by Rasta Magician
// * function GEBuyAt(spot: integer): boolean; // * by Rasta Magician
// * function GESetPrice(value: string): boolean; // * by Rasta Magician
// * procedure GESetQuantity(Q: string); // * by Rasta Magician
// * function GEConfirmOffer: boolean; // * by Rasta Magician
// * function GEBuy(What, Price, Quantity: string): boolean; // * by Rasta Magician
// * function GESell(Price, Quantity: string; InvSpot: integer): boolean; // * by Rasta Magician
{*******************************************************************************
function InGE: boolean;
By: Rasta Magician
Description: Checks if we are in GE
*******************************************************************************}
function InGE: boolean;
var
x, y, GEIN: integer;
begin
// 'Grand Exchange'- header
GEIN := DTMFromString('mlwAAAHicY2dgYLgMxdeB+A4QPwLiV0D8CYhVgVgHirWhWAuKyQWMeDAUAAC0dAdN');
Result := FindDTM(GEIN,x,y,205, 33,314, 50);
FreeDTM(GEIN);
end;
{*******************************************************************************
function GEIsMember: boolean;
By: Rasta Magician
Description: Checks if it is a member account using GE
*******************************************************************************}
function GEIsMember: boolean;
begin
if not InGE then exit;
if GetColor(411, 167) <> srl_outline_black then
if GetColor(410, 155) <> 5199452 then
begin
Result := true;
exit;
end;
if GetColor(411, 167) <> 5199452 then //to avoid jagex moving 1px
if GetColor(410, 155) <> srl_outline_black then
begin
Result := true;
exit;
end;
Result := false;
end;
{*******************************************************************************
function GESellMenu: boolean;
By: Rasta Magician
Description: Checks if we are in the sell menu
*******************************************************************************}
function GESellMenu: boolean;
begin
if not InGE then exit;
Result := SimilarColors(GetColor(187, 73), 45055, 10);
end;
{*******************************************************************************
function GEBuyMenu: boolean;
By: Rasta Magician
Description: Checks if we are in the buy menu
*******************************************************************************}
function GEBuyMenu: boolean;
begin
if not InGE then exit;
Result := (GetColor(186, 74) = 61385);
end;
{*******************************************************************************
procedure GEMenuExit;
By: Rasta Magician
Description: Exits the Buy or Sell menu
*******************************************************************************}
procedure GEMenuExit;
var i, x:integer;
begin
if not InGE then exit;
if not GESellMenu then
if not GEBuyMenu then
exit;
MMouse(40, 291, 18, 9);
for i:= 0 to 5 do
begin
wait(100);
if IsUpText('ack') then break;
end;
if IsUpText('ack') then
begin
GetMousePos(x, i);
Mouse(x, i, 0, 0, true);
for i:= 0 to 5 do
begin
wait(150);
if not GESellMenu then
if not GEBuyMenu then
break;
end;
end;
end;
{*******************************************************************************
function GESpotToTBox(spot: integer): TBox;
By: Rasta Magician
Description: Returns the coords of a box in GE
*******************************************************************************}
function GESpotToTBox(spot: integer): TBox;
var
i, x1, x2, y1, y2: integer;
begin
{
box width: 140
box height: 112
gap hor: 16
gap ver: 8
}
if spot > 3 then
i := spot - 3 - 1
else
i := spot - 1 ;
x1 := 32 + (16 + 140)*i;
x2 := 172 + (16 + 140)*i;
if spot > 3 then
i := 1
else
i := 0;
y1 := 82 + (112 + 8)*i;
y2 := 194 + (112 + 8)*i;
Result := IntToBox(x1, y1, x2, y2);
end;
{*******************************************************************************
function GEIsSpotFree(spot: integer):boolean;
By: Rasta Magician
Description: Checks if a spot is available for buying/selling
*******************************************************************************}
function GEIsSpotFree(spot: integer):boolean;
var TB: TBox;
begin
if not InGE then exit;
if spot > 2 then
if not GEIsMember then
exit;
TB := GESpotToTBox(spot);
Result := (GetColor(TB.x1 + 9, TB.y2 - 30) <> 0);
writeln('coords: '+IntToStr(TB.x1+9)+', '+ IntToStr(TB.y2 -30));
end;
{*******************************************************************************
function GEFinishedAt(spot: integer): boolean;
By: Rasta Magician
Description: Checks if a trade has been concluded at spot: spot
*******************************************************************************}
function GEFinishedAt(spot: integer): boolean;
var TB: TBox;
begin
if not InGE then exit;
if spot > 2 then
if not GEIsMember then exit;
if not GEIsSpotFree(spot) then
begin
TB := GESpotToTBox(spot);
Result := ( GetColor(TB.x1 + 103, TB.y2 - 20) = 1999423 );
end;
end;
{*******************************************************************************
procedure GERecoverAtEx(spot: integer; abort:boolean);
By: Rasta Magician
Description: Collects the items traded received at a certain spot
Aborts the trade is boolean abort is set to true
*******************************************************************************}
procedure GERecoverAtEx(spot: integer; abort:boolean);
var
TB: TBox;
i, x, y: integer;
begin
if not InGE then exit;
if GEIsSpotFree(spot) then exit;
if spot > 2 then
if not GEIsMember then
exit;
TB := GESpotToTBox(spot);
MouseBox(TB.x1, TB.y1, TB.x2, TB.y2, 1);
wait(200);
for i:= 0 to 10 do
begin
if (GESellMenu)or(GEBuyMenu) then
break;
wait(150);
end;
if abort then
if (GetColor(359, 312) <> 1999423) then
begin
MMouse(364, 285, 5, 5); //moving to button
wait(100);
for i:= 0 to 5 do // waiting text
begin
if IsUpText('bort') then break;
wait(100);
end;
if IsUpText('bort') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
end;
for i:= 0 to 10 do //waiting until aborted
begin
wait(100);
if (GetColor(202, 309) = 1048714) then break;
end;
wait(200+Random(300));
end;
//collecting spot 1 //
MMouse(416, 299, 5, 5);
for i:= 0 to 5 do // waiting text
begin
if IsUpText('ollect') then break;
wait(100);
end;
if IsUpText('ollect') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
end;
wait(100+Random(200));
//collecting spot 1 //
if (GetColor(467, 298) <> 2176579) then // spot 2
begin
MMouse(467, 298, 5, 5);
for i:= 0 to 5 do // waiting text
begin
if IsUpText('ollect') then break;
wait(100);
end;
if IsUpText('ollect') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
end;
wait(100+Random(200));
end;
for i:=0 to 10 do
begin
wait(150);
if not GESellMenu then
if not GEBuyMenu then
break;
end;
GEMenuExit; //just if something went wrong
end;
{*******************************************************************************
function procedure GERecoverAt(spot: integer);
By: Rasta Magician
Description: Recovers items at spot: spot, does not abort the trade
*******************************************************************************}
procedure GERecoverAt(spot: integer);
begin
GERecoverAtEx(spot, false);
end;
{*******************************************************************************
procedure GERecoverFinishedAt(spot: integer);
By: Rasta Magician
Description: Recovers items at spot: spot if the trade is concluded
*******************************************************************************}
procedure GERecoverFinishedAt(spot: integer);
begin
if not InGE then exit;
if GEFinishedAt(spot) then
GERecoverAtEx(spot, false);
end;
{*******************************************************************************
procedure GEAbortAll;
By: Rasta Magician
Description: Aborts and recovers all current trades
*******************************************************************************}
procedure GEAbortAll;
var
i:integer;
begin
for i:= 1 to 6 do
GERecoverAtEx(i, true);
end;
{*******************************************************************************
procedure GERecoverAll;
By: Rasta Magician
Description: Recovers all current trades, does not abort
*******************************************************************************}
procedure GERecoverAll;
var
i:integer;
begin
for i:= 1 to 6 do
GERecoverAt(i);
end;
{*******************************************************************************
procedure GERecoverFinished;
By: Rasta Magician
Description: Recovers all finished trades
*******************************************************************************}
procedure GERecoverFinished;
var
i:integer;
begin
for i:= 1 to 6 do
GERecoverFinishedAt(i);
end;
{*******************************************************************************
function GEFindFreeSpot(var spot:integer): boolean;
By: Rasta Magician
Description: Finds a free spot to trade in
*******************************************************************************}
function GEFindFreeSpot(var spot:integer): boolean;
var
i:integer;
begin
if not InGE then exit;
Result := false;
spot := 0;
for i:= 1 to 6 do
if GEIsSpotFree(i) then
begin
spot := i;
Result := true;
break;
end;
end;
{*******************************************************************************
function GESellAt(spot: integer): boolean;
By: Rasta Magician
Description: Presses the sell button at spot: spot
*******************************************************************************}
function GESellAt(spot: integer): boolean;
var
TB: TBox;
x, y: integer;
begin
if not InGE then exit;
if not GEIsSpotFree(spot) then
begin
writeln('space is not free!');
exit;
end;
TB := GESpotToTBox(spot);
MMouse(TB.x1 + 100, TB.y1 + 65, 5, 5);
wait(150+Random(75));
if IsUpText('ell') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
end;
for x:= 0 to 9 do
begin
wait(100);
if GESellMenu then break;
end;
Result := GESellMenu;
end;
{*******************************************************************************
function GEBuyAt(spot: integer): boolean;
By: Rasta Magician
Description: Presses the buy button at spot: spot
*******************************************************************************}
function GEBuyAt(spot: integer): boolean;
var
TB: TBox;
x, y: integer;
begin
if not InGE then exit;
if not GEIsSpotFree(spot) then
begin
writeln('space is not free!');
exit;
end;
TB := GESpotToTBox(spot);
MouseBox(TB.x1 + 35, TB.y1 + 50, TB.x1 + 65, TB.y1 + 80, 3);
wait(150+Random(75));
if IsUpText('Buy') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
end;
for x:= 0 to 9 do
begin
wait(100);
if GEBuyMenu then break;
end;
Result := GEBuyMenu;
end;
{*******************************************************************************
function GESetPrice(value: string): boolean;
By: Rasta Magician
Description: Sets the price of an item.
'0', 'min' - Minimum Value
'1', 'med' - Market Value
'2', 'max' - Max value
Other - Exact value
*******************************************************************************}
function GESetPrice(Value: Variant): boolean;
begin
if not InGE then exit;
if not GESellMenu then
if not GEBuyMenu then
exit;
if value = 'min' then value := 0;
if value = 'med' then value := 1;
if value = 'max' then value := 2;
wait(100+Random(50));
case value of
1: MouseBox(269, 208, 304, 232, 1); // min price
2: begin end; // market price
3: MouseBox(376, 210, 408, 233, 1); // max price
else begin
MouseBox(429, 209, 462, 234, 1);
wait(100+Random(100));
TypeSend(IntToStr(value));
wait(200+Random(100));
if IsChatBoxTextAnyLine('price range', clblack) then
begin
writeln('wrong price! Out of Price Range!');
GEMenuExit;
end;
end;
end;
Result := true;
end;
{*******************************************************************************
procedure GESetQuantity(Q: string);
By: Rasta Magician
Description: Sets the price of an item.
Options: '1', '10', '100', '1000'(buy), 'all'(sell),
Other - Exact Value
*******************************************************************************}
procedure GESetQuantity(Q: string);
var i:integer;
begin
if not InGe then exit;
if not GESellMenu then
if not GEBuyMenu then
exit;
case lowercase(Q) of
'1': Mouse(72, 220, 5, 5, true);
'10': Mouse(115, 219, 5, 5, true);
'100': Mouse(155, 220, 5, 5, true);
'all', '1000': Mouse(196, 222, 5, 5, true);
else begin
Mouse(238, 223, 5, 5, true);
for i:= 0 to 3 do
begin
wait(450);
if (GetColor(259, 428) = 8388608) then
if (GetColor(256, 400) = 0) then
break;
end;
TypeSend(Q);
end;
end;
end;
{*******************************************************************************
function GEConfirmOffer: boolean;
By: Rasta Magician
Description: Confirms an offer
Returns false if it wasn't able to do so
*******************************************************************************}
function GEConfirmOffer: boolean;
var x, y : integer;
begin
if not InGE then exit;
if not GESellMenu then
if not GEBuyMenu then
exit;
Result := true;
MMouse(215, 284, 96, 21);
wait(250+Random(100));
if IsUpText('ffer') then
begin
GetMousePos(x, y);
Mouse(x, y, 0, 0, true);
wait(1000+Random(200));
end;
if GESellMenu or GEBuyMenu then
begin
writeln('could not confirm offer');
GEMenuExit;
Result := false;
end;
end;
function GEBuyAtEx(What, Price, Quantity: string; Slot: integer): boolean;
var
free, x, y:integer;
begin
if not InGE then exit;
if not GEIsSpotFree(Slot) then exit;
if GEBuyAt(Slot) then
begin
wait(50+ Random(50));
if (GetColor(231, 362) <> 23200) then //checking for Item Search
begin
Mouse(125, 117, 7, 7, true);
wait(200+random(50));
end;
TypeSend(lowercase(What));
wait(150+Random(100));
if FindColor(x, y, 23200, 66, 348, 120, 354) then //if it finds our thing
begin
Mouse(x, y, 5, 3, true);
wait(100+Random(100));
end else begin
writeln('Wrong object name');
exit;
end;
wait(100+Random(100));
if not GESetPrice(Price) then exit;
wait(200+Random(100));
GESetQuantity(Quantity);
wait(200+Random(100));
Result := GEConfirmOffer;
end;
end;
{*******************************************************************************
function GEBuy(What, Price, Quantity: string): boolean;
By: Rasta Magician
Description: Buys an item from the GE
What (item name) has to be exact
Price: 'min', 'med', 'max', exact value
Quantity: '1', '10', '100', '1000', exact value
*******************************************************************************}
function GEBuy(What, Price, Quantity: string): boolean;
var
free: integer;
begin
if not GEFindFreeSpot(free) then exit;
Result := GeBuyAtEx(What, Price, Quantity, free);
end;
function GESellAtEx(Price, Quantity: string; InvSpot, GESpot: integer): boolean;
begin
if not InGE then exit;
if not GEIsSpotFree(GESpot) then exit;
if GESellAt(GESpot) then
begin
wait(100+Random(100));
MouseItem(InvSpot, true);
wait(200+Random(100));
GESetPrice(Price);
wait(200+Random(100));
GESetQuantity(Quantity);
wait(200+Random(100));
Result := GEConfirmOffer;
end;
end;
{*******************************************************************************
function GESell(Price, Quantity: string; InvSpot: integer): boolean;
By: Rasta Magician
Description: Sells an item at GE
Price: 'min', 'med', 'max', exact value
Quantity: '1', '10', '100', 'all', exact value
InvSpot: the Invspot where you have your item
*******************************************************************************}
function GESell(Price, Quantity: string; InvSpot: integer): boolean;
var
free: integer;
begin
if not GEFindFreeSpot(free) then Exit;
Result := GESellAtEx(Price, Quantity, InvSpot, free);
end;