SCAR Code:
Program New;
{.include srl/srl.scar}
{
~~~ * Press Play to View My MMouse Function * ~~~
Some Of My Procedures / Functions You May Find Usless Or Not Helpful at all
so, the reason i would put them in here is because i use them my Self....
}
{*******************************************************************************
Function Hypot(x, y: Extended) : Extended;
By: Sky Scripter
Description: it returns the Hypotenuse
Example : |\
5' | \ <-- Hypotenuse = 5.3851648071345
|__\
2'
*******************************************************************************}
Function Hypot(x, y:Extended):Extended;
begin
Result:= Sqrt(x*x + y*y);
end;
{*******************************************************************************
Function Nott(E: Extended) : Extended;
By: Sky Scripter
Description: Kind of like abs() but works both ways ( nott(6) = -7, Nott(-7) = 6 )
*******************************************************************************}
Function Nott(E:Extended):Extended;
var s: String;
begin
s:= FloatToStr(E);
if ( e < 0) then
delete(S, 1, 1)
else
insert('-', S, 1);
Result:= StrToFloat(s)-1;
end;
{*******************************************************************************
Function Dividable(Int: Integer): Boolean;
By: Sky Scripter
Description: Returns True if the number is a even number.
*******************************************************************************}
Function Dividable(Int:Integer):Boolean;
var i:Integer;
e:Extended;
begin
Result:=False;
for i:= 1 to int - (int div 2) do
begin
e:= Int div i;
If ( e = 2) then
begin
Result:=True;
exit;
end;
end;
end;
{*******************************************************************************
Function Exp(Base, int : Extended):Extended;
By: Sky Scripter
Description: Gives the exponet number
Example: Exp(10, 2) = 1000
*******************************************************************************}
Function Exp(Base, int : Extended):Extended;
begin
Result:= Base * Pow(10, int);
end;
{*******************************************************************************
Function DeExp(Base, int : Extended) : Extended;
By: Sky Scripter
Description: Gives The Extended Exponet Number
Example: DeExp(10, 2) = 0.001
*******************************************************************************}
Function DeExp(Base, int : Extended):Extended;
begin
Result:= Base / Pow(10, int * 2);
end;
{*******************************************************************************
Function DrawEllipse(Centx, Centy, Width, Height, Inc, DegreeStop : Integer) : TPointArray;
By: Sky Scripter
Description: Draws Out a Ellipse In TPoints, use The Inc For the step
in between Tpoints.
*******************************************************************************}
Function DrawEllipse(Centx, Centy, Width, Height, Inc : Integer) : TPointArray;
Var P : TPointArray;
i, Add: Integer;
begin
setarraylength(P, 360 / Inc);
For i:= 1 to 360 / Inc do
begin
Add:= Add + Inc;
P[i-1].x:= Trunc( Width * Sin((Pi / 180) * Add) + Centx);
P[i-1].y:= Trunc(-Height * Cos((Pi / 180) * Add) + Centy);
end;
Result:= P;
end;
{*******************************************************************************
Function DrawTriangle(Centx, Centy, width, height, inc:Integer): TPointArray;
By: Sky Scripter
Description: Draws Out a Triangle in TPoints, Use Inc For The Step Between TPoints.
*******************************************************************************}
Function DrawTriangle(Centx, Centy, width, height, inc, DegreeStop:Integer): TPointArray;
Var P : TPointArray;
i, add:Integer;
begin
SetArrayLength(P, 540 / Inc);
for i:= 1 to 540 / Inc do
begin
add := add + Inc;
P[i-1].x := Trunc(width * Cos((Pi/180) * Add) + Centx);
if (add >= 180) then P[i-1].x := Trunc(-width * Cos((Pi/180) * Add) + Centx-(width * 2));
P[i-1].y := Trunc(height * Cos((Pi/180) * Add) + Centy);
if (add >= 360) then
begin
P[i-1].x:= Trunc(-(Width * 2) * Cos((Pi/180) * add) + Centx-Width);
P[i-1].y:= Trunc(height * Cos((Pi/180) * 0) + Centy);
end;
end;
Result:= P;
end;
{*******************************************************************************
Function DrawRect(dx, dy, Width, Height, Inc:Integer): TPointArray;
By: Sky Scripter
Description: Draws a Rectangle In TPoints, Use Inc For the step in between the TPoints.
*******************************************************************************}
Function DrawRect(dx, dy, Width, Height, Inc:Integer): TPointArray;
Var P: TPointArray;
i, add:Integer;
begin
SetArrayLength(P, 720 / Inc);
Width:= width Shr 1;
Height:= Height shr 1;
dx := dx + Width;
dy := dy + Height;
For i:= 1 to 720 / Inc do
begin
Add:= Add + Inc;
p[i-1].x:= Trunc(Width * Cos((Pi/180) * 0) + dx);
p[i-1].y:= Trunc(Height * Cos((Pi/180) * Add) + dy);
if (Add >= 180) then
begin
p[i-1].x:= Trunc(-Width * Cos((Pi/180) * Add) + dx);
p[i-1].y:= Trunc(-Height * Cos((Pi/180) * 0) + dy);
end;
if (Add >= 360) then
begin
p[i-1].x:= Trunc(-Width * Cos((Pi/180) * 0) + dx);
p[i-1].y:= Trunc(-Height * Cos((Pi/180) * Add) + dy);
end;
if (Add >= 540) then
begin
p[i-1].x:= Trunc(Width * Cos((Pi/180) * Add) + dx);
p[i-1].y:= Trunc(Height * Cos((Pi/180) * 0) + dy);
end;
end;
Result:= P;
end;
{*******************************************************************************
Function DrawLine(sx, sy, dx, dy, inc : Integer): TPointArray;
By: Sky Scripter
Description: draw A Line From (sx, sy, To dx, dy) use Inc For the step between
Tpoints. The Inc Doesn't work so well so (RECOMENDED inc = (1, 2 or 3))
*******************************************************************************}
Function DrawLine(sx, sy, dx, dy, inc : Integer): TPointArray;
Var P: TPointArray;
i, add, mx, my:Integer;
begin
SetArrayLength(P, 180 / Inc);
mx:= Trunc(Nott(sx - dx)+1);
my:= Trunc(Nott(sy - dy)+1);
For i:= 1 to 180 / Inc do
begin
add:= add + inc;
If (Not(P[i-1].x = dx)) then p[i-1].x:= Trunc(sx - mx * Cos((Pi/180) * Add) + mx );
If (Not(P[i-1].y = dy)) then p[i-1].y:= Trunc(sy - my * Cos((Pi/180) * Add) + my );
If (P[i-1].x = dx) and (P[i-1].y = dy) then
begin
SetArrayLength(P, i);
Break;
end;
end;
Result:= P;
end;
{*******************************************************************************
Procedure TransMouse(dx, dy, rx, ry :Integer);
By: Sky Scripter
Description: Moves The Mouse Human Like.. (Alot like BenMouse and RsN / Mutant MMouse)
*******************************************************************************}
Procedure TransMouse(dx, dy, rx, ry :Integer);
Var P: TPointArray;
i, x, y, step, Slow: Integer;
begin
GetMousePos(x, y)
If (Distance(dx, dy, x, y) = 0) then exit;
Step := Trunc( Mousespeed / 10 )
if ((step < 1) or (step > 3)) then step:= Random(3)+1;
dx:= dx + Random(Rx);
dy:= dy + Random(Ry);
If (dx <= 0) then dx:= 1 if (dy <= 0) then dy:= 1;
P:= DrawLine(x, y, dx, dy, step);
For i:= 0 to getarraylength(p)-1 do
begin
MoveMouse(P[i].x, P[i].y);
if Distance(P[i].x, P[i].y, dx, dy) < 50 then Slow := Slow + Random(Step);
if (slow > MouseSpeed) then Slow:= MouseSpeed;
Wait(MouseSpeed + Slow);
end;
end;
{*******************************************************************************
Procedure SnapMouse(dx, dy, rx, ry:Integer; Left:Boolean);
By: Sky Scripter
Description: Just like the (Procedure Mouse) but a little diffrent...
*******************************************************************************}
Procedure SnapMouse(dx, dy, rx, ry:Integer; Left:Boolean);
Var i, x, y:Integer;
begin
TransMouse(dx, dy, rx, ry);
Wait(50 + Random(50));
GetMousePos(x, y);
HoldMouse(x + 1, y, Left);
For i:= 1 to 3 do
Wait(10 + Random(10));
GetMousePos(x, y);
ReleaseMouse(x, y, Left);
Wait(10+Random(10));
TransMouse(x - Random(3), y - Random(3), 0, 0);
end;
{*******************************************************************************
Function ColorsSimilar(Color1, Color2:Integer):Boolean;
By: Sky Scripter
Description: Without Tol it checks if The colors Are close needs Work );
*******************************************************************************}
Function ColorsSimilar(Color1, Color2:Integer):Boolean;
Var // Im Not So Sure How Accurate This is :)
H, S, L : Array [1..2] Of Extended;
begin
ColortoHSL(Color1, H[1], S[1], L[1]);
ColortoHSL(Color2, H[2], S[2], L[2]);
If ( Sqrt( Sqr(H[1] - H[2]) ) <= 15 ) And
( Sqrt( Sqr(S[1] - S[2]) ) <= 100 ) And
( Sqrt( Sqr(L[1] - L[2]) ) <= 50 ) then
Result:= True;
end;
{*******************************************************************************
Function FindColorRadial(Var x, y : Integer; Color, Centx, Centy, Width, Height:Integer): Boolean;
By: Sky Scripter
Description: Finds a color in a Ellipse SLOW!!!
*******************************************************************************}
Function FindColorRadial(Var x, y : Integer; Color, Centx, Centy, Width, Height:Integer): Boolean;
Var
P : TPointArray;
Radialx, Radialy, i : Integer;
begin
repeat
If (Not(radialx >= Width)) then radialx:= radialx + 1;
If (Not(radialy >= Height)) then radialy:= radialy + 1;
P:= DrawEllipse(centx, Centy, radialx, radialy, 1);
For i:= 0 to GetArrayLength(P)-1 do
If (FindColor(x, y, Color, P[i].x, P[i].y, P[i].x, P[i].y)) then // It's Speeds It By Using Find color
Begin
Result:= True;
Exit;
end;
Until (radialx >= Width) And (radialy >= Height)
end;
{*******************************************************************************
Function FindColorEllipseEx(Var x, y : Integer; Color, Centx, Centy, Width, Height, Inc, OutInc, Tol:Integer): Boolean;
By: Sky Scripter
Description: Finds a color in a ellipse, Inc Is the Space Between The Tpoints
OutInc The Gap between Each Ellipse. SLOW!!!
*******************************************************************************}
Function FindColorEllipseEx(Var x, y : Integer; Color, Centx, Centy, Width, Height, Inc, OutInc, Tol:Integer): Boolean;
Var
P : TPointArray;
Radialx, Radialy, i : Integer;
begin
repeat
If (Not(radialx >= Width - radialx)) then radialx:= radialx + OutInc else radialx:= radialx + 1;
If (Not(radialy >= Height - radialy)) then radialy:= radialy + OutInc else radialy:= radialy + 1;
P:= DrawEllipse(centx, Centy, radialx, radialy, Inc);
For i:= 0 to GetArrayLength(P)-1 do
If (FindColor(x, y, Color, P[i].x, P[i].y, P[i].x, P[i].y)) or
(FindColorTolerance(x, y, Color, P[i].x, P[i].y, P[i].x, P[i].y, Tol)) then
Begin
Result:= True;
Exit;
end;
Until (radialx >= Width) And (radialy >= Height)
end;
{*******************************************************************************
Function FindColorBorder(Var x, y:Integer; Color, x1, y1, x2, y2, Tol:Integer):Boolean;
By: Sky Scripter
Description: Finds The Color Only on the borders of x1 y1 x2 y2
Example:
_____
|Space| <-- Finds The Color on the borders only Not in the space.
|_____|
*******************************************************************************}
Function FindColorBorder(Var x, y:Integer; Color, x1, y1, x2, y2, Tol:Integer):Boolean;
Var P: TPointArray;
i: Integer;
begin
P:= DrawRect(x1, y1, x2, y2, 1);
Wait(3);
For i:= 0 to getarraylength(p)-1 do
If (FindColorTolerance(x, y, Color, P[i].x, P[i].y, P[i].x, P[i].y, Tol)) then
begin
Result:= True;
Exit;
end;
end;
{*******************************************************************************
Function FindColorExcept(Var x, y : Integer; color, x1, y1, x2, y2, xx1, yy1, xx2, yy2, Tol:Integer):Boolean;
By: Sky Scripter
Description: Finds The Colors Except The "ExceptBounds"
Example: xx1, yy1, xx2, yy2 are the borders of the except bounds..
___________________
| _______ | SLOW!!!
| |Except | |
| |Bounds | |
| |_______| |
|___________________|
*******************************************************************************}
Function FindColorExcept(Var x, y : Integer; color, x1, y1, x2, y2, xx1, yy1, xx2, yy2, Tol:Integer):Boolean;
begin
repeat
If (Not( x1 = xx1 )) Then If (x1 < xx1) then xx1 := xx1 - 1 else xx1:= xx1 + 1;
If (Not( y1 = yy1 )) Then If (y1 < yy1) then yy1 := yy1 - 1 else yy1:= yy1 + 1;
If (Not( x2 = xx2 )) Then If (x2 < xx2) then xx2 := xx2 - 1 else xx2:= xx2 + 1;
If (Not( y2 = yy2 )) Then If (y2 < yy2) then yy2 := yy2 - 1 else yy2:= yy2 + 1;
If (FindColorBorder(x, y, color, xx1, yy1, xx2, yy2, tol )) then
begin
Result:= True;
Exit;
end;
Until (x1 = xx1) and (y1 = yy1) and (x2 = xx2) and (y2 = yy2)
end;
{*******************************************************************************
Function CountSep(S:String; Seperater:Char) : Integer;
By: Sky Scripter
Description: Returns The Amout of Seperaters Ther are
Example: CountSep('hello, wasup, hey', ',') = 2
*******************************************************************************}
Function CountSep(S:String; Seperater:Char) : Integer;
var i:Integer;
begin
for i:= 1 to length(S) do
if (S[i] = Seperater) then
Result:= Result + 1;
end;
{*******************************************************************************
Function BetweenSep(S:String; Seperater:Char): Array of String;
By: Sky Scripter
Description: Returns the strings between the seperater in array of string
Example:
S := PickString(BetweenSep('Wasup, hows it going dude, hey man, dude',','));
*******************************************************************************}
Function BetweenSep(S:String; Seperater:Char): Array of String;
Var i, ST, c:Integer;
begin
ST:= CountSep(S, Seperater);
If (St > 1 ) Then St:= St + 1;
setarraylength(Result, st);
For i:= 1 to length(s) do
if (S[i] = Seperater ) then C:= c + 1
else
Result[c]:= Result[c] + S[i];
end;
Var i:Integer;
begin
MouseSpeed:= 15;
BenMouse:= True;
ClearDebug;
Writeln('Watch The Diffrence between each MMouse Procedures / Functions!');
Wait(1000);
Writeln('');
Writeln('Heres Ben MMouse!.');
For i:= 1 to 4 do
MMouse(0, 0, 800, 600);
Wait(3000);
Writeln('');
Writeln('Heres Mutant/RsN MMouse!..');
BenMouse:= False;
For i:= 1 to 4 do
MMouse(Random(800), Random(600), 0, 0);
Wait(3000);
Writeln('');
Writeln('Heres Skys MMouse!...');
For i:= 1 to 4 do
TransMouse(0, 0, 800, 600);
Writeln('');
end.
Math Functions/ New MMouse!
Reply With Quote
