SCAR Code:
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป Mouse Flag Routines --//
//-----------------------------------------------------------------//
// * function IsMoving(WaitTime: Integer): Boolean; // * by Bullzeye95 & Nava2
// * function FlagPresent: Boolean; // * by Mutant Squirrle
// * function FlagDistance: Integer; // * by PPLSUQBAWLZ/Odie533
// * Function MFF(ax, ay, xmod, ymod: Integer):Boolean; // * by WT-Fakawi
// * Function MFNF(ax, ay, xmod, ymod: Integer):Boolean; // * by WT-Fakawi
// * function FFlag(Dist: Integer): Boolean; // * by Wizzup? / WT-Fakawi / ZephyrsFury
// * function Flag: Boolean; // * by Nava2
// * procedure MouseFlag(cx, cy, rx, ry, FlagDist: Integer); // * by RsN edit by EvilChicken!
{*******************************************************************************
function IsMoving(WaitTime: Integer): Boolean;
By: Bullzeye95; Edits by Nava2
Description: Checks if the currently loaded player is moving. Uses Minimap,
ignoring all dots which can move without the player moving.
Nava2 edit: Added try..finally, also changed to work with SMART,
as well added WaitTime Parameter.
*******************************************************************************}
function IsMoving(WaitTime: Integer): Boolean;
var
BMP, BMP2, I, H, x, y: Integer;
ReplaceCols: TIntegerArray;
P: TPointArray;
DC: HDC;
begin
WaitTime := Max(50, WaitTime);
try
DC := GetTargetDC;
ReplaceCols:= [65536, 16711422, 12961221, 14869218, 16777215, 15527148, 195836, 56797, 60909, 52428,
13816530, 982782, 1310462, 62965, 2105598, 395004, 789758, 3553023, 217, 188, 241,
206, 233, 64768, 58880, 51456, 49152, 44800, 61440, 16215571, 9716750, 13129742];
BMP:= BitmapFromString(100, 100, '');
BMP2:= BitmapFromString(100, 100, '');
SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(BMP), MMCX - 50, MMCY - 50, MMCX + 50, MMCY + 50, 0, 0, 100, 100);
H := High(ReplaceCols);
for I:= 0 to H do
FastReplaceColor(BMP, ReplaceCols[i], 0);
wait(WaitTime);
SafeCopyCanvas(GetClientCanvas, GetBitmapCanvas(BMP2), MMCX - 50, MMCY - 50, MMCX + 50, MMCY + 50, 0, 0, 100, 100);
SetTargetDC(GetBitmapDC(BMP2));
for I:= 0 to H do
begin
FindColorsTolerance(P, ReplaceCols[i], 0, 0, 99, 99, 0);
y:= High(P);
for x:= 0 to y do
FastSetPixel(BMP2, P[x].x, P[x].y, FastGetPixel(BMP, P[x].x, P[x].y));
end;
Result:= not FindBitmapIn(BMP, x, y, 0, 0, 99, 99);
finally
SetTargetDC(DC);
FreeBitmap(BMP);
FreeBitmap(BMP2);
end;
end;
{*******************************************************************************
function FlagPresent: Boolean;
By: Mutant Squirrle
Description: T/F depending on flag exist.
*******************************************************************************}
function FlagPresent: Boolean;
var
x, y: integer;
begin
Result := FindColor(x, y, 3026478, MMX1, MMY1, MMX2, MMY2);
end;
{*******************************************************************************
function FlagDistance: Integer;
By: PPLSUQBAWLZ/Odie533
Description: Returns distance in pixels your char dot is from flag on mini-map
*******************************************************************************}
function FlagDistance: Integer;
var
x, y: Integer;
begin
if (FindColor(x, y, 3026478, MMX1, MMY1, MMX2, MMY2)) then
Result := Distance(MMCX, MMCY, x + 1, y + 14);
end;
{*******************************************************************************
Function MFF(ax, ay, xmod, ymod: Integer):Boolean;
By: WT-Fakawi
Description: If the flag is not present it will click at (ax, ay) increasing by
(xmod, ymod) 5 times or until the flag appears.
*******************************************************************************}
Function MFF(ax, ay, xmod, ymod: Integer):Boolean;
var
TT, i, xx, yy, x, y, BreakOutTime: Integer;
begin
if (not LoggedIn) then Exit;
if (not (FlagPresent)) then
begin
xx := ax - xmod;
yy := ay - ymod;
MarkTime(BreakOutTime);
for i := 0 to 4 do
begin
xx := xx + xmod;
yy := yy + ymod;
if rs_OnMiniMap(xx, yy) then
Mouse(xx, yy, 2, 2, True)
else
Continue;
Wait(50);
MarkTime(TT);
repeat
Wait(10);
if FindColor(x, y, 3026478, MMx1, MMy1, MMx2, MMy2) then
begin
Result := True
Exit;
end;
Wait(Random(100));
until TimeFromMark(TT) > 3000;
end;
Result := False;
end;
end;
{*******************************************************************************
Function MFNF(ax, ay, xmod, ymod: Integer):Boolean;
By: WT-Fakawi
Description: Like MFF except it will click even if the flag is present when the
function is called.
*******************************************************************************}
Function MFNF(ax, ay, xmod, ymod: Integer):Boolean;
var
TT, i, xx, yy, x, y: Integer;
begin
Result := False;
if (not LoggedIn) then Exit;
xx := ax - xmod;
yy := ay - ymod;
for i := 0 to 4 do
begin
xx := xx + xmod;
yy := yy + ymod;
if rs_OnMiniMap(xx, yy) then
Mouse(xx, yy, 2, 2, True)
else
Continue;
Wait(50);
MarkTime(TT);
repeat
Wait(100);
if FindColor(x, y, 3026478, MMx1, MMy1, MMx2, MMy2) then
begin
Result := True;
Exit;
end;
Wait(Random(100));
until TimeFromMark(TT) > 3000;
end;
end;
function RoadColorChecker: Boolean;Forward;
{*******************************************************************************
function FlagEx(Dist: Integer; RoadColorCheck: Boolean): Boolean;
By: Wizzup? / WT-Fakawi / ZephyrsFury modified by N1ke!
Description: Waits until Flag is within "Distance" distance.
*******************************************************************************}
function FlagEx(Dist: Integer; RoadColorCheck: Boolean): Boolean;
var
Tx, Ty, M, D1, D2: Integer;
begin
Result := False;
M := GetSystemTime;
while (FindColor(Tx, Ty, 3026478, MMX1, MMY1, MMX2, MMY2)) do
begin
D1 := Distance(Tx, Ty + 14, MMCX, MMCY);
if (D1 <= Dist) then
begin
Result := True;
Exit;
end;
If RoadColorCheck then
RoadColorChecker;
Wait(100);
if (GetColor(6, 6) <> clWhite) then
if (GetSystemTime - M > 5000) then
begin
if (D1 = D2) then Exit;
D2 := D1;
M := GetSystemTime;
end;
if (Random(20) = 0) then IdleTime(500, 1000, 0.01);
if SRL_Procs[SRL_AntiBan] <> nil then
SRL_Procs[SRL_AntiBan]();
end;
Wait(RandomRange(200, 400));
end;
{*******************************************************************************
function FFlag(Dist: Integer): Boolean;
By: Wizzup? / WT-Fakawi / ZephyrsFury
Description: Waits until Flag is within "Distance" distance.
*******************************************************************************}
function FFlag(Dist: Integer): Boolean;
begin
Result := FlagEx(Dist, False);
end;
{*******************************************************************************
function Flag: Boolean;
By: Nava2
Description: Waits while flag exists.
*******************************************************************************}
function Flag: Boolean;
begin
Result := FlagEx(0, False);
end;
{*******************************************************************************
procedure MouseFlag(cx, cy, rx, ry, FlagDist: Integer);
By: RsN edit by EvilChicken!
Description: Mouse and Flag combined into one easy procedure.
*******************************************************************************}
procedure MouseFlag(cx, cy, rx, ry, FlagDist: Integer);
var
i: Integer;
begin
if (not LoggedIn) then Exit;
Mouse(cx, cy, rx, ry, True);
while (not FlagPresent) and (i < 10) do
begin
Wait(100);
Inc(i);
end;
FFlag(FlagDist);
Wait(300 + Random(200));
end;
SCAR Code:
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป Chat Routines --//
//-----------------------------------------------------------------//
// * procedure SetChat(state: String; chat: Integer); // * by Wizzup?, WT-Fakawi, Starblaster100 & N1ke!
// * procedure SetAllChats(Pub, Priv, Clan, Trade, Assist: string); // * by ZephyrsFury
// * procedure ChatsOff; // * by Starblaster100
// * function TextCoords(textn: Integer): TPoint; // * by Wizzup?
// * function GetChatBoxText(Line, TextCol: Integer): string; // * by ZephyrsFury
// * function FindChatBoxText(Line: Integer; Text: string; TextCol: Integer): Boolean; // * by ZephyrsFury
// * function IsChatBoxTextBetween(Text: string; TextCol, StartLine, EndLine: Integer): Boolean; // * by ZephyrsFury
// * function IsChatBoxTextAnyLine(Text: string; TextCol: Integer): Boolean; // * by ZephyrsFury
// * function ChatBoxTextArray(TextCol: Integer): TStringArray; // * by ZephyrsFury
// * Function GetBlackChatMessage: String; // * by Wizzup?
// * Function FindBlackChatMessage(ChatMsg: String): Boolean; // * by Wizzup?
// * function LastChatter(var name: String): Boolean; // * by masquerader
// * function GetLastChatText(var chat: String): Boolean; // * by masquerader
// * procedure FixChat; // * by WT-Fakawi
// * function SaveToChatLog: Boolean; // * by WT-Fakawi / masquerader
// * function InChat(Text: String): Boolean; // * by WT-Fakawi
{*******************************************************************************
procedure SetChat(state: String; chat: Integer);
By: Wizzup?, WT-Fakawi, Starblaster100 & N1ke!
Description: Sets Chat to desired state
Chat: Game Public Private Clan Trade Assist
0 1 2 3 4 5
*******************************************************************************}
procedure SetChat(state: string; chat: Integer);
var
x, y, mx, Color: Integer;
begin
case chat of
0: mx := 90;
1: mx := 145;
2: mx := 200;
3: mx := 260;
4: mx := 320;
5: mx := 373;
else
begin
srl_Warn('SetChat', 'chat(' + IntToStr(chat) + ') does not exist.', warn_AllVersions);
Exit;
end;
end;
State := LowerCase(State);
case State of
'on', 'all': Color := 65280;
'off': Color := 255;
'hide': Color := 16776960;
'friends', 'filter': Color := 65535;
else srl_Warn('SetChat', state + ' does not exist.', warn_AllVersions);
end;
State := Capitalize(State);
if not FindColor(x, y, Color, mx - 10, 486, mx + 10, 506) then
begin
Mouse(mx, 496, 8, 8, False);
Wait(450 + Random(175));
ChooseOption(State);
end;
end;
{*******************************************************************************
procedure SetAllChats(Game, Pub, Priv, Clan, Trade, Assist: string);
By: ZephyrsFury
Description: Sets all the chats to a particular state in one simple procedure.
Leave the parameter as '' if you wish to leave the chat as it is.
Example: SetAlChats('all', 'Hide', '', 'Off', '', 'Friend');
*******************************************************************************}
procedure SetAllChats(Game, Pub, Priv, Clan, Trade, Assist: string);
var
States: TStringArray;
II: Integer;
begin
if (not(LoggedIn)) then Exit;
States := [Game, Pub, Priv, Clan, Trade, Assist];
for II := 0 to 5 do
begin
if (States[II] = '') then Continue;
SetChat(States[II], II);
end
end;
{*******************************************************************************
procedure ChatsOff;
By: Starblaster100
Description: Sets all Chats to off.
*******************************************************************************}
Procedure ChatsOff;
var
i: Integer;
begin
for i := 1 to 5 do
SetChat('off', i);
end;
{*******************************************************************************
Function TextCoords(textn: Integer): TPoint;
By: Wizzup?
Description: Returns x, y for text. (1 to 8)
*******************************************************************************}
Function TextCoords(textn: Integer): TPoint;
Begin
Result.X := 11;
Result.Y := 346 + (14 * (textn - 1));
End;
{*******************************************************************************
function GetChatBoxText(Line, TextCol: Integer): string;
By: ZephyrsFury
Description: Gets text on the line Line with colour TextCol. (Line 1 is the top,
Line 8 is the bottom line).
Colours:
clMessage/clBlack - Black text messages ("Oh Dear you are dead", etc).
clChat/clBlue - Chat messages from you and other players.
clTrade/clPurple - Colour of trade request text.
clFriend - Colour of friend and clan chat.
Works with other colours too.
*******************************************************************************}
function GetChatBoxText(Line, TextCol: Integer): string;
var
P: TPoint;
cArr: TPointArray;
B: TBox;
begin
P := TextCoords(Line);
if (FindColorsTolerance(cArr, TextCol, MCX1, P.y, MCX2, P.y + 13, 0)) then
begin
B := GetTPABounds(cArr);
Result := Trim(GetTextAtEx(B.x1 - 1, B.y1 - 2, 0, SmallChars, False, False,
0, 1, TextCol, 80, False, tr_AllChars));
end;
end;
{*******************************************************************************
function FindChatBoxText(Text: string; Line: Integer; TextCol: Integer): Boolean;
By: ZephyrsFury
Description: Searches for Text on Line with colour TextCol. True if found.
*******************************************************************************}
function FindChatBoxText(Text: string; Line: Integer; TextCol: Integer): Boolean;
begin
Result := (Pos(Text, GetChatBoxText(Line, TextCol)) > 0);
end;
{*******************************************************************************
function IsChatBoxTextBetween(Text: string; TextCol, StartLine, EndLine: Integer): Boolean;
By: ZephyrsFury
Description: Returns true if Text with colour TextCol is found anywhere in the
chat box.
*******************************************************************************}
function IsChatBoxTextBetween(Text: string; TextCol, StartLine, EndLine: Integer): Boolean;
var
II: Integer;
begin
Result := True;
for II := Max(StartLine, EndLine) downto Min(StartLine, EndLine) do
if (FindChatBoxText(Text, II, TextCol)) then
Exit;
Result := False;
end;
{*******************************************************************************
function IsChatBoxTextAnyLine(Text: string; TextCol: Integer): Boolean;
By: ZephyrsFury
Description: Returns true if Text with colour TextCol is found anywhere in the
chat box.
*******************************************************************************}
function IsChatBoxTextAnyLine(Text: string; TextCol: Integer): Boolean;
begin
Result := IsChatBoxTextBetween(Text, TextCol, 1, 8);
end;
{*******************************************************************************
function ChatBoxTextArray(TextCol: Integer): TStringArray;
By: ZephyrsFury
Description: Gets and return a TStringArray with the contents of each line with
the colour TextCol (see GetChatBoxText for list of colours).
Line 1 is Result[1]
Line 2 is Result[2]
Line 3 is Result[3]
Line 4 is Result[4]
Line 5 is Result[5]
Line 6 is Result[6]
Line 7 is Result[7]
Line 8 is Result[8]
*******************************************************************************}
function ChatBoxTextArray(TextCol: Integer): TStringArray;
var
II: Integer;
begin
SetLength(Result, 9);
for II := 8 downto 1 do
Result[II] := GetChatBoxText(II, TextCol);
end;
{*******************************************************************************
function GetBlackChatMessage: String;
By: Wizzup?
Description: Gets text with color 0 in last chat line.
*******************************************************************************}
function GetBlackChatMessage: string;
begin
Result := GetChatBoxText(8, clMessage);
end;
{*******************************************************************************
function FindBlackChatMessage(ChatMsg: String): Boolean;
By: Wizzup?
Description: Returns True if text with color 0 in last chat line is found.
*******************************************************************************}
function FindBlackChatMessage(ChatMsg: string): Boolean;
begin
Result := (Pos(ChatMsg, GetChatBoxText(8, clMessage)) > 0);
end;
{*******************************************************************************
function LastChatter(var name: String): Boolean;
By: masquerader
Description:Returns name and true if a person was talking, or false and the text
*******************************************************************************}
function LastChatter(var name: string): Boolean;
var
i: Integer;
begin
Result := False;
Name := LowerCase(GetBlackChatMessage);
i := Pos(':', name)
if (i <> 0) then
begin
Delete(Name, i, i);
Result := True;
end;
end;
{*******************************************************************************
function GetLastChatText(var chat: String): Boolean;
By: masquerader / Wizzup?
Description: Returns true if blue chat text was found
*******************************************************************************}
function GetLastChatText(var chat: string): Boolean;
begin
Chat := GetChatBoxText(8, clChat);
Result := (Chat <> '');
end;
{*******************************************************************************
function InChat(Text: String): Boolean;
By: WT-Fakawi
Description: Grabs Last Chat Line and performs checks on occurence of text
*******************************************************************************}
function InChat(Text: string): Boolean;
var
s: string;
begin
if (not (GetLastChatText(s))) then
LastChatter(s);
Result := (Pos(Text, s) > 0);
end;
{*******************************************************************************
procedure FixChat;
by: WT-Fakawi
Description: Scrolls ChatText scrollbar down.
*******************************************************************************}
procedure FixChat;
var
ScrollX, ScrollY: Integer;
begin
ScrollX := 499 + Random(8);
ScrollY := 445 + Random(8);
if (GetColor(500, 441) = 1975337) then
begin
MMouse(ScrollX, ScrollY, 0, 0)
while (GetColor(500, 441) = 1975337) do
begin
HoldMouse(ScrollX, ScrollY, True);
Wait(10);
end;
Wait(100);
ReleaseMouse(ScrollX, ScrollY, True);
Wait(100);
end;
end;
{*******************************************************************************
function SaveToChatLog: Boolean;
By: WT-Fakawi / masquerader
Description: Saves chat to log file
*******************************************************************************}
procedure SaveToChatLog;
begin
FixChat;
OldLine := TheLine;
if(LastChatter(TheName))then
begin
GetLastChatText(TheLine);
TheLine:=' '+TheLine+' ';
if OldLine <> TheLine then
try AddToSRLLog(TheName+':'+TheLine); except end;
end else
begin
TheLine:=TheName;
if OldLine <> TheLine then
try AddToSRLLog(TheLine); except end;
end;
end;
{*******************************************************************************
function ColorEffectAdd(Color, Effect: Boolean): string;
By: NiCbaZ
Description: Returns a RS chat effect based on 'Color' and 'Effect' booleans.
*******************************************************************************}
function ColorEffectAdd(Color, Effect: Boolean): string;
var
Str : TStringArray;
begin
Str := ['flash1:', 'flash2:', 'flash3:', 'glow1:', 'glow2:', 'glow3:', 'red:',
'green:', 'cyan:', 'purple:', 'white:', 'scroll:', 'shake:', 'slide:',
'wave:', 'wave2:'];
if Color then
Result := Str[Random(11)];
if Effect then
Result := Result + Str[11 + Random(5)];
end;
SCAR Code:
//-----------------------------------------------------------------//
//-- 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
// * procedure TypeByte(k: Byte); // * by Mutant Squirrle
// * procedure TypeSend(Text: String); // * by SKy Scripter
// * 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 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 Function LoadTextTPA(Text : String; Chars : Integer;var height : integer) : TPointArray; // * by Raymond
// * Function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action : (ClickLeft,ClickRight,Move,Nothing)) : Boolean; // * by Raymond
// * 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
{ var OldLine,TheLine, TheName: String;
Description: ChatLog vars. }
var
OldLine, TheLine, TheName: string;
{ type fnct_ActionOptions;
Description: Action options. }
type
fnct_ActionOptions = (ClickLeft,ClickRight,Move,Nothing);
{ 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;
var
i, l: Integer;
begin
i := 0;
l := -1;
SetLength(Result, 0);
if (str = '') then
Exit;
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 + Length(del) - 1);
until false
Result[l] := Copy(str, 1, Length(str));
end;
{*******************************************************************************
function srl_Implode(Pieces: TStringArray; Separator: string): string;
By: ZephyrsFury
Description: Combines Pieces in a single string separated by a Separator.
*******************************************************************************}
function srl_Implode(Pieces: TStringArray; Glue: string): string;
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];
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;
C: Byte;
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
C := GetKeyCode(StrGet(Text, I));
TypeByte(c);
I:= I + 1;
if(I > Length(Text))then Break;
end;
end;
if(Shift)then
KeyUp(VK_SHIFT);
Wait(40 + Random(40));
if(I <= Length(Text))then
begin
C:= GetKeyCode(StrGet(Text, I));
TypeByte(C);
Wait(40 + Random(40));
end;
end;
If Not PressEnter Then Exit;
C := GetKeyCode(Chr(13));
TypeByte(C);
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
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
Result := rs_GetUpText;
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, rs_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 := rs_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: ', ')', rs_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.
*******************************************************************************}
function FindText(var cx, cy: Integer; txt: string; font, xs, ys, xe, ye:
Integer): Boolean; //by Stupid3ooo
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.
*******************************************************************************}
function ClickText(Text: string; Chars, x1, y1, x2, y2: Integer; Left: Boolean): Boolean;
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/4), TY + (H/4), (W/2), (H/2), Left);
end;
{*******************************************************************************
Function 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
*******************************************************************************}
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;
{*******************************************************************************
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
*******************************************************************************}
Function FindTextTpaEx(Color,Tol,xs,ys,xe,ye : integer;var x,y : integer; Txt : string; Chars : Integer; Action :fnct_ActionOptions ) : Boolean;
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.
*******************************************************************************}
Function FindTextTpa(Color,Tol,xs,ys,xe,ye : integer; Txt : string; Chars : Integer; Action :fnct_ActionOptions ) : Boolean;
var
x,y : integer;
begin
Result := FindTextTPAEx(Color,Tol,xs,ys,xe,ye,x,y,Txt,chars,action);
end;
{*******************************************************************************
function ChooseOptionMultiEx(Texts: TStringArray; TextType: String; Action: fnct_ActionOptions): Boolean;
By: Wizzup?, Nava2, and modified by 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, T: TBox;
TPA, TextTPA: TPointArray;
aTPA: T2DPointArray;
I, C, H, HH, ii, L: Integer;
P: TPoint;
Occurances: array [0..4] of TPointArray;
Colors: TIntegerArray;
begin
Result := False;
GetClientDimensions(B.X2, B.Y2);
B.X1 := 0;
B.Y1 := 0;
FindColorsTolerance(TPA, 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
If Length(TPA) < 10 Then
Exit;
B.X2 := 0;
B.Y2 := 0;
P := TPA[0];
H := High(TPA);
Dec(H);
For I := 0 To H Do
If TPA[i].X = TPA[I+1].X - 1 Then
Begin
If C > 5 Then
Begin
B.X1 := P.X;
B.Y1 := P.Y;
Break;
End Else
C := C + 1;
End
Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
InvertTPA(TPA);
C := 0;
P := TPA[0];
H := High(TPA);
Dec(H);
For I := 0 To H Do
If TPA[i].X = TPA[I+1].X + 1 Then
Begin
If C > 5 Then
Begin
B.X2 := P.X;
B.Y2 := P.Y;
Break;
End Else
C := C + 1;
End Else
Begin
P := TPA[I + 1];
C := 0;
End;
If I = Length(TPA) Then
Begin
WriteLn('Choose Option Menu Getting Failed');
Exit;
End;
TPA := [];
Colors := [16777215, 4231423, 2070783, 65535, 16776960];
case LowerCase(TextType) of
'action', 'player': FindColorsTolerance(Occurances[0], Colors[0], B.x1, B.y1, B.x2, B.y2, 3);
'item' : begin
FindColorsTolerance(Occurances[1], Colors[1], B.x1, B.y1, B.x2, B.y2, 3);
FindColorsTolerance(Occurances[2], Colors[2], B.x1, B.y1, B.x2, B.y2, 3);
end;
'npc' : FindColorsTolerance(Occurances[3], Colors[3], B.x1, B.y1, B.x2, B.y2, 3);
'object': FindColorsTolerance(Occurances[4], Colors[4], B.x1, B.y1, B.x2, B.y2, 3);
else
begin
FindColorsTolerance(Occurances[0], 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
FindColorsTolerance(Occurances[1], clBlack, B.X1, B.Y1, B.X2, B.Y2, 0);
TPA := MergeATPA(Occurances);
ClearDoubleTPA(TPA);
TPA := ReturnPointsNotInTPA(TPA, B);
end;
end;
if High(TPA) < 1 then TPA := MergeATPA(Occurances);
aTPA := SplitTPAEx(TPA, 7, 1);
SortATPAFromFirstPoint(aTPA, Point(B.x1, B.y1));
H := High(Texts);
L := High(aTPA);
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
T := GetTPABounds(TPA);
Result := True;
Case Action of
ClickLeft: MouseBox(B.x1 + 5, T.y1 + 2, B.x2 - 5, T.y2 - 2, 1);
Move: MouseBox(B.x1 + 5, T.y1 + 2, B.x2 - 5, T.y2 - 2, 3);
Nothing: begin end;
else
srl_warn('ChooseOptionMultiEx', 'ClickRight not a valid click for RS menus!', warn_AllVersions);
end;
Exit;
End;
end;
MMouse(B.X1 - 50, B.Y1 - 50, 40, B.Y2 - B.Y1);
Wait(200 + Random(100));
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 h 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', rs_GetUpText) > 0);
Pa.x2 := GetTimeRunning + 2000;
while (not Result) and (GetTimeRunning < Pa.x2) do
begin
Wait(10);
Result := (Pos('lose', rs_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: String; 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;
