SCAR Code:
//-----------------------------------------------------------------//
//-- Scar Standard Resource Library --//
//-- ยป Text Routines --//
//-----------------------------------------------------------------//
// * procedure TypeByte(k: Byte); // * by Mutant Squirrle
// * procedure TypeSend(Text: String); // * by SKy Scripter
// * 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 ChooseOption(txt: String): Boolean; // * by Stupid3ooo, modded by Sumilion
// * procedure CloseWindow; // * by Stupid3ooo
// * function TextCoords(textn: Integer): TPoint; // * by Wizzup?
// * Function ChatsBlackText: Array Of String; // * by Wizzup?
// * function IsChatBlackTextAnyLine(ChatTxt: String): Boolean; // * by Wizzup?
// * 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
// * function ClickOption(s: String; i: Integer): Boolean; // * by Starblaster100
// * 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
{ var TheFile: Integer;
Description: Use to log chat to file. See SaveToChatLog. }
var
TheFile: Integer;
{ var OldLine,TheLine, TheName: String;
Description: ChatLog vars. }
var
OldLine, TheLine, TheName: string;
type
fnct_ActionOptions = (ClickLeft,ClickRight,Move,Nothing);
{*******************************************************************************
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 TypeSend(Text: string);
By: SKy Scripter
Description: Sends human like text.
*******************************************************************************}
procedure TypeSend(Text: string);
var
S: string;
I: Integer;
C: Byte;
Shift: Boolean;
begin
S:= 'ABCDEFGHIJKLMNOPQRSTUVWXZ' + '~!@#$%^&*()_+{}|:"<>?';
for I:= 1 to Length(Text) 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;
C := GetKeyCode(Chr(13));
TypeByte(C);
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: Similar to IsUpTextMulti but you can input as many strings in an
array as you like
Use: IsUpTextMultiCustom(['Att', 'ttac', 'ack', 'monst', 'ster'])
*******************************************************************************}
function IsUpTextMultiCustom(Text: TStringArray): Boolean;
var
TheText: string;
i, n: Integer;
begin
TheText := rs_GetUpText;
n := Length(Text) - 1;
for i := 0 to n do
if (Pos(Text[i], TheText) <> 0) then
begin
Result := True;
Exit;
end;
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
FreeBitmap(S);
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;
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 ChooseOption(txt: String): Boolean;
By: Wizzup?
Description: Finds Popup menu, then clicks on it.
*******************************************************************************}
function ChooseOption(txt: string): Boolean;
var
B: TBox;
P: TPointArray;
X, Y: Integer;
begin
GetClientDimensions(B.X2, B.Y2);
B.X1 := 0;
B.Y1 := 0;
FindColorsTolerance(P, 4674653, B.X1, B.Y1, B.X2, B.Y2, 0);
If Length(P) = 0 Then
Exit;
B := GetTPABounds(P);
If FindText(X, Y, txt, upchars, B.X1, B.Y1, B.X2, B.Y2) Then
Begin
Result := True;
Mouse(B.X1 + 5, y + 1, Random(B.X2 - B.X1), random(13), True);
End
Else
begin
MMouse(B.X1 - 50, B.Y1 - 50, 40, B.Y2 - B.Y1);
Wait(200 + Random(100));
end;
end;
{*******************************************************************************
function CloseWindow: Boolean;
By: Solemn Wishes and Starblaster100
Description: Closes any open windows.
*******************************************************************************}
function CloseWindow: Boolean;
var
WindowType : array[0..1] of Integer;
i, x, y: Integer;
Begin
WindowType[0] := BitmapFromString2(False, 'a0714278DA8D8D410EC' +
'5200844AF840AE25FAA95FB1FE9337651135353174FF31846220A' +
'A9911FBB1CA956A78CE2CC21823C4DC94EEE30D2063C31DEBA240' +
'B18CBF4D241C3568626D6E4D408AF626085C94D90EC8AB7FDE079' +
'F6577E9203D350F15780C07DD3D72F4E3BD7CCCE7332B3288773C' +
'39A5CF93DF9B6B54FC524A67EF3AD7FCD9C93FBD6B96D9FFE01BE' +
'1');
WindowType[1] := BitmapFromString2(False, 'aC16F978DA3DCB3B12002108' +
'03D02B4531B096ECC7FB1F49B285CD9B09090070BF05C20A7A966' +
'E8F6C5D8E3CF66B6843B55CAEBB26F0A9DF980AC125D38E30FE7E' +
'126D032D6');
for i := 0 to 1 do
begin
If(FindBitmapToleranceIn(WindowType[i], x, y, 470, 25, 505, 55, 25)) then
begin
Mouse(x, y, 2, 2, true);
Result := True;
Break;
end else
Wait(10);
end;
for i := 0 to 1 do
FreeBitmap(WindowType[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 := 12;
Result.Y := 347 + (14 * (textn - 1));
End;
{*******************************************************************************
function ChatsBlackText: Array Of String;
By: Wizzup?
Description: Gets all text with color 0 in chatbox:
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 ChatsBlackText: array of string;
var
I: Byte;
tpa: TPointArray;
begin
SetArrayLength(tpa, 9);
for I := 1 to 8 do
tpa[i] := TextCoords(i);
SetArrayLength(Result, 9);
for I := 1 to 8 do
Result[I] := Trim(GetTextAtEx(tpa[i].x - 2, tpa[i].y - 2, 0, SmallChars, False,
False, 0, 1, 0, 80, False, tr_AllChars));
end;
{*******************************************************************************
function IsChatBlackTextAnyLine(ChatTxt: String): Boolean;
By: Wizzup?
Description: Returns true if ChatTxt is found in any of the 8 lines in ChatBox.
*******************************************************************************}
function IsChatBlackTextAnyLine(ChatTxt: string): Boolean;
var
TheLines: array of string;
I: Byte;
begin
TheLines := ChatsBlackText;
for I := 1 to 8 do
if (Pos(ChatTxt, TheLines[I]) <> 0) then
begin
Result := True;
Exit;
end;
end;
{*******************************************************************************
function GetBlackChatMessage: String;
By: Wizzup?
Description: Gets text with color 0 in last chat line.
*******************************************************************************}
function GetBlackChatMessage: string;
Var
TextP: TPoint;
begin
TextP := TextCoords(8);
Result := Trim(GetTextAtEx(TextP.X - 2, TextP.Y - 2, 0, SmallChars, False,
False, 0, 1, 0, 80, False, tr_AllChars));
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, GetBlackChatMessage) <> 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;
textP: TPoint;
begin
textP := TextCoords(8);
name := LowerCase(Trim(GetTextAtEx(textP.x - 2, textP.y - 2, 0, SmallChars, False, False, 0, 1,
0, 60, False, tr_allChars)))
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;
var
x, y: Integer;
textP: TPoint;
begin
textP := TextCoords(8);
if findcolor(x, y, 16711680, textp.x, textp.y, textp.x + 200, textp.y + 14) then
begin
chat := LowerCase(Trim(GetTextAtEx(x - 3, textp.y - 2, 0, SmallChars, False,
False, -1, 1, 16711680, 60, False, tr_allChars)));
Result := True;
end;
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(509, 441) = 2503741) then
begin
MMouse(ScrollX, ScrollY, 0, 0)
while (GetColor(509, 441) = 2503741) 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
WriteFileString(TheFile, TheTime + ' '+TheName+':'+TheLine + Chr(13));
end else
begin
TheLine:=TheName;
if OldLine <> TheLine then
WriteFileString(TheFile, TheTime + ' '+TheLine + Chr(13));
end;
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;
{*******************************************************************************
function ClickOption(s: String; i: Integer): Boolean;
By: Starblaster100
Description: Clicks Option in Specified Area (1 for Main Screen, 2 Inventory,
3 for Chat Window), returns True if text was found
*******************************************************************************}
function ClickOption(S: string; i: Integer): Boolean;
var
x, y, tmpMask: Integer;
TempBox: TBox;
begin
tmpMask := CreateBitmapMaskFromText(S, upchars);
case i of
1: TempBox := IntToBox(0, 0, 520, 340);
2: TempBox := IntToBox(520, 200, 750, 470);
3: TempBox := IntToBox(0, 340, 500, 460);
else
begin
srl_Warn('ClickOption', IntToStr(i) + 'is not a valid area', warn_AllVersions);
Exit;
end;
end;
if (FindBitmapMaskTolerance(tmpMask, x, y, TempBox.x1, TempBox.y1, TempBox.x2, TempBox.y2, 10, 50)) then
begin
Wait(25 + Random(50));
Mouse(x + (Length(S) * 2), y + 5, (Length(S) * 2), 3, True);
Result := True;
end;
FreeBitmap(tmpMask);
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;
x := matches[0].x;
y := matches[0].y;
if Action = Nothing then
Exit;
Box := GetTPABounds(TextTPA);
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;