Boom Headshot
2007-10-31 13:25:21
{Pimper4live PRESENTS:
THE BRAND NEW SEXYLICIOUS FABULICIOUS GANGSTER LOOKIN' FINGER LICKING GOOD NEW POWERCUTTER!
^Means I updated my powercutter by making a new one.
===========================================================================================
INCLUDES:
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
{.include SRL\SRL.scar}
{.include SRL\SRL\skill\WoodCutting.scar}{
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
NOTES:
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
This script is FREE if you paid for it you have been scammed.
If you are banned using this script I am not responsible, You use this
at your own Risk.
I am not responsible if you die and lose items.
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
INSTRUCTIONS:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. If you know what your doing change the 'TreeWait' below
2. Run the script.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
}
const
TreeWait = 15000; //How long to wait until next tree
var //Global Stat Variables
gLogsCut, gExperienceGained: Integer;
var //Script Variables
LogsCut, ExperienceGained, LogMark: Integer;
var //Form Variables
frmDeclare: TForm;
chkActive: TCheckBox;
cmbTreeType: TComboBox;
lblUser, lblPass, lblNick: TLabel;
cmdBack, cmdNext, cmdDPStart: TButton;
lblHMTC, lblChange, lblCurPlayer: TLabel;
txtHMTC, txtChange, txtUser, txtPass, txtNick: TEdit;
//This is like awesome command, Credz to Danrox2004 where I changed mine to be like his with an array
procedure Debug(V: TVariantArray);
var
T: Integer;
Str: string;
begin
for T := 0 to GetArrayLength(V) - 1 do
Str := Str + V[T];
Writeln(Str);
end;
//For a more detailed report I've added PlayerStats
procedure PlayerStats;
var
N: Integer;
begin
if HowManyPlayers > 1 then
for N := 0 to HowManyPlayers - 1 do
if Players[N].Integers[2] > 0 then
begin
Debug(['~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~']);
Debug([Players[N].Name, ' has….']);
Debug(['Cut approximately ', Players[N].Integers[2], ' ', Players[N].Strings[0], 's']);
Debug(['Gained about ', Players[N].Extendeds[0], ' Experience']);
Debug(['Worked for ', Players[N].Worked, ' Minutes']);
if Players[N].Loc <> '' then Debug([Players[N].Name, '''s Loc is: ', Players[N].Loc]);
if not Players[N].Active then Debug([Players[N].Name, ' is not active.']);
end;
end;
//Progress Report
procedure Report;
begin
ClearDebug;
Debug(['<========================Nashi========================>']);
Debug(['Worked for ', TimeRunning]);
Debug(['You have cut approximately ', LogsCut, ' Logs!']);
Debug(['You have gained approximately ', ExperienceGained, ' Experience!']);
PlayerStats;
Debug(['<=====================================================>']);
SRLRandomsReport;
end;
//Check if you don't have an axe
function NoAxe: Boolean;
begin
Result := (Pos('You do not have an axe', GetBlackChatMessage) > 0);
end;
//Checks if there are active players
function NoneActive: Boolean;
var
T: Integer;
begin
Result := True;
for T := 0 to HowManyPlayers - 1 do
if (Players[T].Active) then Result := False;
end;
//My function for checking for 'Click to continue'
function ClickHereToContinue: Boolean;
begin
if (GetColor(218, 440) = 16711680) and
(GetColor(228, 441) = 16711680) and
(GetColor(329, 447) = 16711680) and
(GetColor(334, 446) = 16711680) and
(GetColor(347, 444) = 16711680) then
begin
Mouse(290, 446, 50, 2, True);
Wait(250 + 500);
Result := True;
end else
Result := False;
end;
//Gets the version of the Script
function GetVersion: Integer;
var
Version: String;
begin
Version := GetPage('http://www.freewebs.com/dafilestorage/Mitch/Scripts/NashiPowerCutter/Ver.html');
Version := StrGet(Version, 2);
Result := StrToInt(Version);
end;
const
CurVersion = 2; //Script Version
//Downloads a new script if needed
procedure Update;
var
NewScript: TStringList;
begin
if GetVersion > CurVersion then
begin
NewScript := TStringList.Create;
GetApplication.MessageBox('Your script is outdated and will now Download the latest version from my website' + Chr(13) + 'when the new Script is downloaded a Box will come up prompting you to Reload the script' + Chr(13) + 'Select Ok and restart the script.', 'Nashi Script Updater', 0);
NewScript.Text := GetPage('http://www.freewebs.com/dafilestorage/Mitch/Scripts/NashiPowerCutter/NashiPowerCutter.scar');
GetApplication.MessageBox('Script successfully updated.', 'Nashi Script Updater', 0);
SaveToFile(NewScript, ScriptPath + 'NashiPowerCutter.scar');
NewScript.Free;
TerminateScript;
end;
end;
//My custom way of writing to the Stats.ini file, Because it uses Variants
procedure WriteToLog(Name, Value: Variant);
begin
WriteINI('PowerCutter', Name, Value, AppPath + 'NashiPowerCutter\Stats.ini');
end;
//My custom way of reading from the Stats.ini file, Because it uses Variants
function ReadFromLog(Name: Variant): Variant;
begin
Result := ReadINI('PowerCutter', Name, AppPath + 'NashiPowerCutter\Stats.ini');
end;
//Saves the Outer Script stats
procedure SaveGlobalStats;
begin
WriteToLog('Logs', LogsCut + gLogsCut);
WriteToLog('EXP', ExperienceGained + gExperienceGained);
end;
//Loads the Outer Script stats
procedure LoadGlobalStats;
begin
try
gLogsCut := ReadFromLog('Logs');
gExperienceGained := ReadFromLog('EXP');
except
WriteToLog('Logs', 0);
WriteToLog('EXP', 0); //Reset if error(Eg, First time, or Some other weird thing?)
end;
end;
//My procedure for doing an Introduction of the script.
procedure Intro;
begin
Writeln('N N AAA SSSSS H H IIII');
Writeln('NN N A A SS H H II ');
Writeln('N N N AAAAA SSSSS HHHHH II '); //My lame ass Logo, I needed something xP
Writeln('N NN A A SS H H II ');
Writeln('N N A A SSSSS H H IIII');
Debug(['Total Logs Cut: ', gLogsCut]);
Debug(['Total EXP Gained: ', gExperienceGained]);
Update;
end;
//If none active then script will finish, otherwise it will declare the current player false and next player
procedure FinishScript(Reason: String);
begin
Players[CurrentPlayer].Loc := Reason;
Players[CurrentPlayer].Active := False;
Report;
Debug([Reason]);
if NoneActive then begin
LogOut;
TerminateScript;
end;
NextPlayer(False);
MarkTime(LogMark);
end;
function FindFastRandoms: Boolean; // By WT-Fakawi, Modded by Nashi
var
i: Integer;
begin
for I := 1 to 12 do
begin
case I of
1: if FindDead then
Result := True;
2: if FindMod then
Result := True;
3: if FindMime then
Result := True;
4: if FindMaze then
Result := True;
5: if FindQuiz then
Result := True;
6: if FindDemon then
Result := True;
7: if InBlack then
begin
Result := True;
FinishScript('In Black');
Exit;
end;
8: if NoGameTab then
begin
Result := True;
FinishScript('No GameTab');
Exit;
end;
9 : if RC then //Hell if you wanna add it in go for it
Result := True;
10: if FindTalk then
Result := True;
11: if FindFight then
begin
Debug(['Found Fight']);
RunTo('W', True);
end;
12: if ClickHereToContinue then
Result := True;
end;
Wait(1);
end;
end;
//This is my antiban which is based off Weibs AntiBan
procedure NantiBan;
begin
case 1 + Random(6) of
1 : BoredHuman;
2 : PickUpMouse;
3 : HoverSkill('random', false);
4 : RandomMovement;
5 : RandomRClick;
6 : GameTab(1 + Random(13));
end;
end;
//This is my randoms procedure
procedure NashiWCRandoms;
begin
if not LoggedIn then LogInPlayer;
if FindDead then
FinishScript('Player dead');
FindFastRandoms;
if Random(3) = 0 then FindNormalRandoms;
if Random(10) = 9 then NantiBan;
if Random(3) > 0 then Exit;
if NoAxe then
begin
TypeSend('Gah');
FinishScript('No Usable Axe');
end;
end;
{*******************************************************************************
Function NClickAllItemsBmpMaskTolWait(bmp:integer; option: string; tol, ctol, waitnum:
Integer):Integer;
By: WT-Fakawi, Edited for personal Use by Nashi
Description: Performs option popupmenu action on all items with bmp bitmap and
tol tolerance ctol CountourTolerance in inventory. (e.g. 'store all')
Returns number of performed operations.
*******************************************************************************}
Function NClickAllItemsBmpMaskTolWait(bmp:integer; option: string; tol, ctol, waitnum:
Integer):Integer;
var
i, x, y: Integer;
TB: Tbox;
arr:array of Integer;
begin
arr :=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,
18,19,20,21,22,23,24,25,26,27,28];
for i := 1 to 28 - 4 do
Swap(arr[RandomRange(i - 1, i + 4)], arr[RandomRange(i - 1, i + 4)] );
GameTab(4);
for i := 0 to 27 do
begin
TB := InvBox(arr);
if ExistsItem(arr) then
if FindBitmapMaskTolerance(bmp, x, y, TB.x1, TB.y1, TB.x2, TB.y2, tol, ctol) then
begin
if (not (option = '')) then
begin
MouseItem(arr, False);
ChooseOption(option);
Inc(Result);
end
else
MouseItem(arr, True);
Wait(waitnum);
FindFastRandoms;
end;
end;
end;
//Returns a random direction for the compass
function RBearing: Char;
begin
case Random(4) of
0: Result := 'N';
1: Result := 'E';
2: Result := 'S';
3: Result := 'W';
end;
end;
//Checks for randoms then attempts to change compass direction
procedure NewCompass;
begin
NashiWCRandoms;
MakeCompass(RBearing);
end;
//This is the Ent Detector I used in my KYAB Oak Cutter, It seems to work if used correctly,
//I've tweaked it a bit though.
function UberEnt: Boolean;
var
x,y:integer;
begin
if (FindColorTolerance(x, y, 383705, 9, 9, 233, 24, 20)) or
(FindColorTolerance(x, y, 65535, 9, 9, 233, 24, 20)) then
begin
GetMousePos(x, y);
Mouse(x, y, 5, 5, False);
if (FindText(x, y, 'Chop down', upchars, x - 50, y - 50, x + 100, y + 50)) then
begin
if (FindColor(x, y, 65535, x + 70, y, x + 100, y + 10)) then
begin
Writeln('Found ent! Waiting for it to go away');
Result := True;
EntsAvoided := EntsAvoided + 1;
Mouse(MMCX, MMCY, 1, 1, True);
NewCompass;
end;
end else
ChooseOption('Cancel');
end;
end;
//Saves info from the form when chaning player setup
procedure SaveStats;
begin
Players[CurrentPlayer].Name := txtUser.Text;
Players[CurrentPlayer].Pass := txtPass.Text;
Players[CurrentPlayer].Nick := txtNick.Text;
Players[CurrentPlayer].Active := chkActive.Checked;
SetArrayLength(Players[CurrentPlayer].Strings, 1);
SetArrayLength(Players[CurrentPlayer].Integers, 3);
SetArrayLength(Players[CurrentPlayer].Extendeds, 1);
Players[CurrentPlayer].Strings[0] := cmbTreeType.Text
Players[CurrentPlayer].Extendeds[0] := 0.0;
try
Players[CurrentPlayer].Integers[0] := StrToInt(txtHMTC.Text);
Players[CurrentPlayer].Integers[1] := StrToInt(txtChange.Text);
except
ShowMessage('Invalid entry for Logs to Cut and Mins before Change, Please go back and fill in again.');
end;
end;
//Loads info on form when changing player
procedure LoadStats;
begin
if CurrentPlayer < 0 then CurrentPlayer := 0;
txtUser.Text := Players[CurrentPlayer].Name;
txtPass.Text := Players[CurrentPlayer].Pass;
txtNick.Text := Players[CurrentPlayer].Nick;
chkActive.Checked := Players[CurrentPlayer].Active;
try
if Players[CurrentPlayer].Strings[0] = '' then
cmbTreeType.Text := 'Which Tree To Cut'
else
cmbTreeType.Text := Players[CurrentPlayer].Strings[0];
txtHMTC.Text := IntToStr(Players[CurrentPlayer].Integers[0]);
txtChange.Text := IntToStr(Players[CurrentPlayer].Integers[1]);
except
Writeln('New SRL are Pwnz0r');
end;
lblCurPlayer.Caption := 'Player: ' + IntToStr(CurrentPlayer);
HowManyPlayers := GetArrayLength(Players);
end;
//Changes information on form
procedure ChangePlayer(Sender: TObject);
begin
SaveStats;
if Sender = cmdBack then
CurrentPlayer := CurrentPlayer - 1
else
CurrentPlayer := CurrentPlayer + 1;
if CurrentPlayer = GetArrayLength(Players) then NumberOfPlayers(GetArrayLength(Players) + 1);
LoadStats;
txtUser.SetFocus;
end;
//Saves the player array to a file
procedure SavePlayerArray;
var
SaveBuffer: TStringList;
I: Integer;
begin
SaveBuffer := TStringList.Create;
try
SaveBuffer.Add(IntToStr(GetArrayLength(Players)));
for I := 0 to GetArrayLength(Players) - 1 do
begin
SaveBuffer.Add(Players.Name);
SaveBuffer.Add(Players.Pass);
SaveBuffer.Add(Players.Nick);
SaveBuffer.Add(BoolToStr(Players.Active));
SaveBuffer.Add(Players.Strings[0]);
SaveBuffer.Add(IntToStr(Players.Integers[0]));
SaveBuffer.Add(IntToStr(Players.Integers[1]));
end;
SaveToFile(SaveBuffer, AppPath + 'NashiPowerCutter\PlayerArray.txt');
Writeln('Saved player array to ' + AppPath + 'NashiPowerCutter\PlayerArray.txt');
finally
SaveBuffer.Free;
end;
end;
//Loads the player array from a file
procedure NLoadPlayerArray;
var
LoadBuffer: TStringList;
I, Z: Integer;
begin
LoadBuffer := TStringList.Create;
try
if LoadFromFile(LoadBuffer, AppPath + 'NashiPowerCutter\PlayerArray.txt') then
for I := 0 to StrToInt(LoadBuffer.Strings[0]) - 1 do
begin
SetArrayLength(Players, I + 1);
SetArrayLength(Players.Strings, 1);
SetArrayLength(Players.Integers, 2);
Z := I * 7;
Players.Name := LoadBuffer.Strings[Z + 1];
Players.Pass := LoadBuffer.Strings[Z + 2];
Players.Nick := LoadBuffer.Strings[Z + 3];
Players.Active := StrToBool(LoadBuffer.Strings[Z + 4]);
Players.Strings[0] := LoadBuffer.Strings[Z + 5];
Players.Integers[0] := StrToInt(LoadBuffer.Strings[Z + 6]);
Players.Integers[1] := StrToInt(LoadBuffer.Strings[Z + 7]);
end;
finally
HowManyPlayers := GetArrayLength(Players);
LoadBuffer.Free;
end;
end;
//Replacement for SRL's since it's no longer in SRL(Designed for this Script, Won't work with other peoples)
procedure LoadPlayerArray;
var
I: Integer;
begin
for I := 0 to GetArrayLength(Players) - 1 do
if Players.Name = '' then
begin
SetArrayLength(Players, I);
HowManyPlayers := I;
end;
end;
//This is for ending the form
procedure EndDeclare(Sender: TObject);
var
I: Integer;
begin
SaveStats;
NumberOfPlayers(100);
LoadPlayerArray;
for I := 0 to GetArrayLength(Players) - 1 do
Players.Name := Capitalize(Players.Name);
try
CurrentPlayer := StrToInt(Readln('Which player to start with?'));
except
ShowMessage('Must be an Integer. (0, 1, 2 etc..)');
CurrentPlayer := StrToInt(Readln('Which player to start with?'));
end;
if SRLID = '' then
begin
SRLID := '2554';
SRLPassword := 'password';
end;
frmDeclare.ModalResult := mrOk;
SavePlayerArray;
Debug([GetArrayLength(Players), ' Players, Starting Player: ', Players[CurrentPlayer].Name]);
end;
// This form was parsed using: DFM Form Parser v.23 by Ron.
//Loads the form into memory
procedure InitDPForm;
begin
frmDeclare := CreateForm;
frmDeclare.Left := 250;
frmDeclare.Top := 114;
frmDeclare.Hint := 'Fill in this form with your player information';
frmDeclare.BorderStyle := bsToolWindow;
frmDeclare.Caption := 'Declare Players';
frmDeclare.ClientHeight := 140;
frmDeclare.ClientWidth := 325;
frmDeclare.Color := 0;
frmDeclare.Font.Color := clMaroon;
frmDeclare.Font.Height := -11;
frmDeclare.Font.Name := 'MS Sans Serif';
frmDeclare.Font.Style := [fsBold];
frmDeclare.ShowHint := True;
frmDeclare.PixelsPerInch := 96;
lblUser := TLabel.Create(frmDeclare);
lblUser.Parent := frmDeclare;
lblUser.Left := 56;
lblUser.Top := 8;
lblUser.Width := 37;
lblUser.Height := 13;
lblUser.Caption := 'Name:';
lblUser.Transparent := True;
lblPass := TLabel.Create(frmDeclare);
lblPass.Parent := frmDeclare;
lblPass.Left := 35;
lblPass.Top := 28;
lblPass.Width := 59;
lblPass.Height := 13;
lblPass.Caption := 'Password:';
lblPass.Transparent := True;
lblNick := TLabel.Create(frmDeclare);
lblNick.Parent := frmDeclare;
lblNick.Left := 33;
lblNick.Top := 48;
lblNick.Width := 61;
lblNick.Height := 13;
lblNick.Caption := 'Nickname:';
lblNick.Transparent := True;
lblCurPlayer := TLabel.Create(frmDeclare);
lblCurPlayer.Parent := frmDeclare;
lblCurPlayer.Left := 226;
lblCurPlayer.Top := 35;
lblCurPlayer.Width := 51;
lblCurPlayer.Height := 13;
lblCurPlayer.Caption := 'Player: 0';
lblCurPlayer.Transparent := True;
lblHMTC := TLabel.Create(frmDeclare);
lblHMTC.Parent := frmDeclare;
lblHMTC.Left := -1;
lblHMTC.Top := 71;
lblHMTC.Width := 106;
lblHMTC.Height := 13;
lblHMTC.Hint := 'Type how many Logs you wish to cut and Drop';
lblHMTC.Caption := 'How Many To Cut:';
lblHMTC.Transparent := True;
lblChange := TLabel.Create(frmDeclare);
lblChange.Parent := frmDeclare;
lblChange.Left := 3;
lblChange.Top := 93;
lblChange.Width := 160;
lblChange.Height := 13;
lblChange.Hint := 'How long, In minutes before script changes player';
lblChange.Caption := 'Time before player change: ';
lblChange.Transparent := True;
txtUser := TEdit.Create(frmDeclare);
txtUser.Parent := frmDeclare;
txtUser.Left := 96;
txtUser.Top := 3;
txtUser.Width := 121;
txtUser.Height := 21;
txtUser.Hint := 'What is this characters username?';
txtUser.TabOrder := 8;
txtPass := TEdit.Create(frmDeclare);
txtPass.Parent := frmDeclare;
txtPass.Left := 96;
txtPass.Top := 24;
txtPass.Width := 121;
txtPass.Height := 21;
txtPass.Hint := 'What is this characters password?';
txtPass.PasswordChar := '*';
txtPass.TabOrder := 9;
txtNick := TEdit.Create(frmDeclare);
txtNick.Parent := frmDeclare;
txtNick.Left := 96;
txtNick.Top := 45;
txtNick.Width := 121;
txtNick.Height := 21;
txtNick.Hint := '3-4 lowercase characters from the players username(No spaces)';
txtNick.TabOrder := 10;
chkActive := TCheckBox.Create(frmDeclare);
chkActive.Parent := frmDeclare;
chkActive.Left := 228;
chkActive.Top := 6;
chkActive.Width := 97;
chkActive.Height := 17;
chkActive.Hint := 'Will this player be used?';
chkActive.Caption := 'Active?';
chkActive.ParentColor := True;
chkActive.TabOrder := 11;
cmdBack := TButton.Create(frmDeclare);
cmdBack.Parent := frmDeclare;
cmdBack.Left := 23;
cmdBack.Top := 112;
cmdBack.Width := 75;
cmdBack.Height := 25;
cmdBack.Hint := 'Go to last player';
cmdBack.Caption := '<<';
cmdBack.TabOrder := 12;
cmdBack.OnClick := @ChangePlayer;
cmdNext := TButton.Create(frmDeclare);
cmdNext.Parent := frmDeclare;
cmdNext.Left := 218;
cmdNext.Top := 112;
cmdNext.Width := 75;
cmdNext.Height := 25;
cmdNext.Hint := 'Go to next player';
cmdNext.Caption := '>>';
cmdNext.TabOrder := 13;
cmdNext.OnClick := @ChangePlayer;
cmdDPStart := TButton.Create(frmDeclare);
cmdDPStart.Parent := frmDeclare;
cmdDPStart.Left := 105;
cmdDPStart.Top := 112;
cmdDPStart.Width := 106;
cmdDPStart.Height := 25;
cmdDPStart.Hint := 'Start Script';
cmdDPStart.Caption := '&Start';
cmdDPStart.TabOrder := 14;
cmdDPStart.OnClick := @EndDeclare;
cmbTreeType := TComboBox.Create(frmDeclare);
cmbTreeType.Parent := frmDeclare;
cmbTreeType.Left := 179;
cmbTreeType.Top := 67;
cmbTreeType.Width := 145;
cmbTreeType.Height := 21;
cmbTreeType.Hint := 'Select which tree to cut from this drop down Box';
cmbTreeType.ItemHeight := 13;
cmbTreeType.TabOrder := 15;
cmbTreeType.Text := 'Which Tree To Cut?';
cmbTreeType.Items.Add('Tree');
cmbTreeType.Items.Add('Oak');
cmbTreeType.Items.Add('Willow');
txtHMTC := TEdit.Create(frmDeclare);
txtHMTC.Parent := frmDeclare;
txtHMTC.Left := 105;
txtHMTC.Top := 67;
txtHMTC.Width := 72;
txtHMTC.Height := 21;
txtHMTC.Hint := 'Type how many Logs you wish to cut and Drop';
txtHMTC.TabOrder := 16;
txtChange := TEdit.Create(frmDeclare);
txtChange.Parent := frmDeclare;
txtChange.Left := 159;
txtChange.Top := 89;
txtChange.Width := 61;
txtChange.Height := 21;
txtChange.Hint := 'How long, In minutes before script changes player';
txtChange.TabOrder := 17;
try
LoadStats;
except
Writeln('First run');
end;
end;
//Safe call of 'InitDPForm'
procedure SafeInitDPForm;
var
V : TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('InitDPForm', V);
end;
//Shows the form 'frmDeclare'
procedure ShowDPFormModal;
begin
frmDeclare.ShowModal;
end;
//Safe call of 'ShowDPFormModal'
procedure SafeShowDPFormModal;
var
V : TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('ShowDPFormModal', V);
end;
//Initiates Declare Player Form
procedure MainInitDPForm;
begin
NumberOfPlayers(1);
NLoadPlayerArray;
SafeInitDPForm;
SafeShowDPFormModal;
FreeForm(frmDeclare);
end;
//Adds 'Plus' to 'Number'
procedure Add(var Number: Integer; Plus: Integer);
begin
Number := Number + Plus;
end;
//Gets teh experience of the Current Players TreeType
function GetEXP: Integer;
begin
case Players[CurrentPlayer].Strings[0] of
'Tree' : Result := 15;
'Oak' : Result := 37;
'Willow': Result := 62;
end;
end;
//Gets teh report vars indec of the Current Players TreeType
function RV: Integer;
begin
case LowerCase(Players[CurrentPlayer].Strings[0]) of
'tree' : Result := 0;
'oak' : Result := 1;
'willow': Result := 2;
end;
end;
//Checks if player has cut allocated logs
function DoneChop: Boolean;
begin
if Players[CurrentPlayer].Integers[2] >= Players[CurrentPlayer].Integers[0] then
Result := True;
end;
//Checks if player has worked for allocated time
function DoneTime: Boolean;
begin
if TimeFromMark(LogMark) >= (Players[CurrentPlayer].Integers[1] * 60000) then
Result := True;
end;
//Drops all logs and updates variables
procedure DropEm;
var
bmpLogMask, T: Integer;
begin
bmpLogMask := BitmapFromString(18, 14, 'z78DA3330A015704302' +
'067404F4B471D4AEA162D7D0F5911B5E405D3369E15ADA85C3504' +
'F27F40400D1E72874');
Status('Dropping Logs');
Gametab(4);
T := NClickAllItemsBmpMaskTolWait(bmpLogMask, 'rop', 20, 25, 30 + Random(30));
Add(ReportVars[RV], T); //Number of ? tree logs cut(? = type of tree, normal, oak, etc)
Add(ReportVars[3], Round(T * GetEXP)); //Experience gained
Add(ReportVars[4], T); //Total Amount of Logs Dropped
Inc(ReportVars[5]); //Loads Cut
Add(Players[CurrentPlayer].Integers[2], T);
Add(LogsCut, T);
Add(ExperienceGained, T * GetEXP);
Players[CurrentPlayer].Extendeds[0] := Players[CurrentPlayer].Integers[2] * GetEXP;
Report;
SaveGlobalStats;
FreeBitmap(bmpLogMask);
end;
//Chops any of the three Supported trees
function Chop(TreeName: string): Boolean;
var
Nx, Ny, N: Integer;
Colours: TIntegerArray;
begin
case LowerCase(TreeName) of
'tree' : Colours := [4156042, 2971727, 2439992];
'oak' : Colours := [3561845, 486492, 1064758];
'willow': Colours := [4150100, 2974794, 3297881];
end;
for N := 0 to 5 do
begin
NashiWCRandoms; //eg, Tree becomes ree, Oak = ak, Willow = illow
if FindObjCustom(Nx, Ny, [TreeName, 'Chop down ' + TreeName, Copy(TreeName, 2, Length(TreeName))], Colours, N) and not UberEnt then
begin
if Random(5) = 4 then
begin
Mouse(Nx, Ny, 1, 1, False);
Wait(250 + Random(300));
ChooseOption('Chop down');
end else
Mouse(Nx, Ny, 1, 1, True);
Wait(500 + Random(300));
Flag;
NashiWCRandoms;
Result := True;
Exit;
end;
end;
NewCompass;
if Random(2) = 1 then HighestAngle else LowestAngle;
end;
//My main loop, I prefer not to have it in the actual Main loop since it gets crowded
procedure NMainLoop;
var
ChopMark: Integer;
begin
if not LoggedIn then
LogInPlayer
else
NickNameBMP := CreateBitmapMaskFromText(Players[CurrentPlayer].Nick, UpChars);
repeat
MarkTime(LogMark);
repeat
repeat
if not LoggedIn then LogInPlayer;
NashiWCRandoms;
if Chop(Players[CurrentPlayer].Strings[0]) then
begin
MarkTime(ChopMark);
repeat
NashiWCRandoms;
Wait(300 + Random(500));
until(TimeFromMark(ChopMark) >= (TreeWait + Random(2000) - Random(1000)));
end;
until(InvFull);
DropEm;
until(DoneChop or DoneTime);
NextPlayer(True);
until(IsFKeyDown(2));
end;
begin
ClearDebug;
SetUpSRL;
ScriptID := '214';
LoadGlobalStats;
Intro;
MainInitDPForm;
MouseSpeed := 10 + Random(10);
Disguise('No page to display - Microsoft Internet Explorer');
NMainLoop;
end.
THE BRAND NEW SEXYLICIOUS FABULICIOUS GANGSTER LOOKIN' FINGER LICKING GOOD NEW POWERCUTTER!
^Means I updated my powercutter by making a new one.
===========================================================================================
INCLUDES:
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
{.include SRL\SRL.scar}
{.include SRL\SRL\skill\WoodCutting.scar}{
\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
NOTES:
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
This script is FREE if you paid for it you have been scammed.
If you are banned using this script I am not responsible, You use this
at your own Risk.
I am not responsible if you die and lose items.
<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
INSTRUCTIONS:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. If you know what your doing change the 'TreeWait' below
2. Run the script.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
}
const
TreeWait = 15000; //How long to wait until next tree
var //Global Stat Variables
gLogsCut, gExperienceGained: Integer;
var //Script Variables
LogsCut, ExperienceGained, LogMark: Integer;
var //Form Variables
frmDeclare: TForm;
chkActive: TCheckBox;
cmbTreeType: TComboBox;
lblUser, lblPass, lblNick: TLabel;
cmdBack, cmdNext, cmdDPStart: TButton;
lblHMTC, lblChange, lblCurPlayer: TLabel;
txtHMTC, txtChange, txtUser, txtPass, txtNick: TEdit;
//This is like awesome command, Credz to Danrox2004 where I changed mine to be like his with an array
procedure Debug(V: TVariantArray);
var
T: Integer;
Str: string;
begin
for T := 0 to GetArrayLength(V) - 1 do
Str := Str + V[T];
Writeln(Str);
end;
//For a more detailed report I've added PlayerStats
procedure PlayerStats;
var
N: Integer;
begin
if HowManyPlayers > 1 then
for N := 0 to HowManyPlayers - 1 do
if Players[N].Integers[2] > 0 then
begin
Debug(['~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~']);
Debug([Players[N].Name, ' has….']);
Debug(['Cut approximately ', Players[N].Integers[2], ' ', Players[N].Strings[0], 's']);
Debug(['Gained about ', Players[N].Extendeds[0], ' Experience']);
Debug(['Worked for ', Players[N].Worked, ' Minutes']);
if Players[N].Loc <> '' then Debug([Players[N].Name, '''s Loc is: ', Players[N].Loc]);
if not Players[N].Active then Debug([Players[N].Name, ' is not active.']);
end;
end;
//Progress Report
procedure Report;
begin
ClearDebug;
Debug(['<========================Nashi========================>']);
Debug(['Worked for ', TimeRunning]);
Debug(['You have cut approximately ', LogsCut, ' Logs!']);
Debug(['You have gained approximately ', ExperienceGained, ' Experience!']);
PlayerStats;
Debug(['<=====================================================>']);
SRLRandomsReport;
end;
//Check if you don't have an axe
function NoAxe: Boolean;
begin
Result := (Pos('You do not have an axe', GetBlackChatMessage) > 0);
end;
//Checks if there are active players
function NoneActive: Boolean;
var
T: Integer;
begin
Result := True;
for T := 0 to HowManyPlayers - 1 do
if (Players[T].Active) then Result := False;
end;
//My function for checking for 'Click to continue'
function ClickHereToContinue: Boolean;
begin
if (GetColor(218, 440) = 16711680) and
(GetColor(228, 441) = 16711680) and
(GetColor(329, 447) = 16711680) and
(GetColor(334, 446) = 16711680) and
(GetColor(347, 444) = 16711680) then
begin
Mouse(290, 446, 50, 2, True);
Wait(250 + 500);
Result := True;
end else
Result := False;
end;
//Gets the version of the Script
function GetVersion: Integer;
var
Version: String;
begin
Version := GetPage('http://www.freewebs.com/dafilestorage/Mitch/Scripts/NashiPowerCutter/Ver.html');
Version := StrGet(Version, 2);
Result := StrToInt(Version);
end;
const
CurVersion = 2; //Script Version
//Downloads a new script if needed
procedure Update;
var
NewScript: TStringList;
begin
if GetVersion > CurVersion then
begin
NewScript := TStringList.Create;
GetApplication.MessageBox('Your script is outdated and will now Download the latest version from my website' + Chr(13) + 'when the new Script is downloaded a Box will come up prompting you to Reload the script' + Chr(13) + 'Select Ok and restart the script.', 'Nashi Script Updater', 0);
NewScript.Text := GetPage('http://www.freewebs.com/dafilestorage/Mitch/Scripts/NashiPowerCutter/NashiPowerCutter.scar');
GetApplication.MessageBox('Script successfully updated.', 'Nashi Script Updater', 0);
SaveToFile(NewScript, ScriptPath + 'NashiPowerCutter.scar');
NewScript.Free;
TerminateScript;
end;
end;
//My custom way of writing to the Stats.ini file, Because it uses Variants
procedure WriteToLog(Name, Value: Variant);
begin
WriteINI('PowerCutter', Name, Value, AppPath + 'NashiPowerCutter\Stats.ini');
end;
//My custom way of reading from the Stats.ini file, Because it uses Variants
function ReadFromLog(Name: Variant): Variant;
begin
Result := ReadINI('PowerCutter', Name, AppPath + 'NashiPowerCutter\Stats.ini');
end;
//Saves the Outer Script stats
procedure SaveGlobalStats;
begin
WriteToLog('Logs', LogsCut + gLogsCut);
WriteToLog('EXP', ExperienceGained + gExperienceGained);
end;
//Loads the Outer Script stats
procedure LoadGlobalStats;
begin
try
gLogsCut := ReadFromLog('Logs');
gExperienceGained := ReadFromLog('EXP');
except
WriteToLog('Logs', 0);
WriteToLog('EXP', 0); //Reset if error(Eg, First time, or Some other weird thing?)
end;
end;
//My procedure for doing an Introduction of the script.
procedure Intro;
begin
Writeln('N N AAA SSSSS H H IIII');
Writeln('NN N A A SS H H II ');
Writeln('N N N AAAAA SSSSS HHHHH II '); //My lame ass Logo, I needed something xP
Writeln('N NN A A SS H H II ');
Writeln('N N A A SSSSS H H IIII');
Debug(['Total Logs Cut: ', gLogsCut]);
Debug(['Total EXP Gained: ', gExperienceGained]);
Update;
end;
//If none active then script will finish, otherwise it will declare the current player false and next player
procedure FinishScript(Reason: String);
begin
Players[CurrentPlayer].Loc := Reason;
Players[CurrentPlayer].Active := False;
Report;
Debug([Reason]);
if NoneActive then begin
LogOut;
TerminateScript;
end;
NextPlayer(False);
MarkTime(LogMark);
end;
function FindFastRandoms: Boolean; // By WT-Fakawi, Modded by Nashi
var
i: Integer;
begin
for I := 1 to 12 do
begin
case I of
1: if FindDead then
Result := True;
2: if FindMod then
Result := True;
3: if FindMime then
Result := True;
4: if FindMaze then
Result := True;
5: if FindQuiz then
Result := True;
6: if FindDemon then
Result := True;
7: if InBlack then
begin
Result := True;
FinishScript('In Black');
Exit;
end;
8: if NoGameTab then
begin
Result := True;
FinishScript('No GameTab');
Exit;
end;
9 : if RC then //Hell if you wanna add it in go for it
Result := True;
10: if FindTalk then
Result := True;
11: if FindFight then
begin
Debug(['Found Fight']);
RunTo('W', True);
end;
12: if ClickHereToContinue then
Result := True;
end;
Wait(1);
end;
end;
//This is my antiban which is based off Weibs AntiBan
procedure NantiBan;
begin
case 1 + Random(6) of
1 : BoredHuman;
2 : PickUpMouse;
3 : HoverSkill('random', false);
4 : RandomMovement;
5 : RandomRClick;
6 : GameTab(1 + Random(13));
end;
end;
//This is my randoms procedure
procedure NashiWCRandoms;
begin
if not LoggedIn then LogInPlayer;
if FindDead then
FinishScript('Player dead');
FindFastRandoms;
if Random(3) = 0 then FindNormalRandoms;
if Random(10) = 9 then NantiBan;
if Random(3) > 0 then Exit;
if NoAxe then
begin
TypeSend('Gah');
FinishScript('No Usable Axe');
end;
end;
{*******************************************************************************
Function NClickAllItemsBmpMaskTolWait(bmp:integer; option: string; tol, ctol, waitnum:
Integer):Integer;
By: WT-Fakawi, Edited for personal Use by Nashi
Description: Performs option popupmenu action on all items with bmp bitmap and
tol tolerance ctol CountourTolerance in inventory. (e.g. 'store all')
Returns number of performed operations.
*******************************************************************************}
Function NClickAllItemsBmpMaskTolWait(bmp:integer; option: string; tol, ctol, waitnum:
Integer):Integer;
var
i, x, y: Integer;
TB: Tbox;
arr:array of Integer;
begin
arr :=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,
18,19,20,21,22,23,24,25,26,27,28];
for i := 1 to 28 - 4 do
Swap(arr[RandomRange(i - 1, i + 4)], arr[RandomRange(i - 1, i + 4)] );
GameTab(4);
for i := 0 to 27 do
begin
TB := InvBox(arr);
if ExistsItem(arr) then
if FindBitmapMaskTolerance(bmp, x, y, TB.x1, TB.y1, TB.x2, TB.y2, tol, ctol) then
begin
if (not (option = '')) then
begin
MouseItem(arr, False);
ChooseOption(option);
Inc(Result);
end
else
MouseItem(arr, True);
Wait(waitnum);
FindFastRandoms;
end;
end;
end;
//Returns a random direction for the compass
function RBearing: Char;
begin
case Random(4) of
0: Result := 'N';
1: Result := 'E';
2: Result := 'S';
3: Result := 'W';
end;
end;
//Checks for randoms then attempts to change compass direction
procedure NewCompass;
begin
NashiWCRandoms;
MakeCompass(RBearing);
end;
//This is the Ent Detector I used in my KYAB Oak Cutter, It seems to work if used correctly,
//I've tweaked it a bit though.
function UberEnt: Boolean;
var
x,y:integer;
begin
if (FindColorTolerance(x, y, 383705, 9, 9, 233, 24, 20)) or
(FindColorTolerance(x, y, 65535, 9, 9, 233, 24, 20)) then
begin
GetMousePos(x, y);
Mouse(x, y, 5, 5, False);
if (FindText(x, y, 'Chop down', upchars, x - 50, y - 50, x + 100, y + 50)) then
begin
if (FindColor(x, y, 65535, x + 70, y, x + 100, y + 10)) then
begin
Writeln('Found ent! Waiting for it to go away');
Result := True;
EntsAvoided := EntsAvoided + 1;
Mouse(MMCX, MMCY, 1, 1, True);
NewCompass;
end;
end else
ChooseOption('Cancel');
end;
end;
//Saves info from the form when chaning player setup
procedure SaveStats;
begin
Players[CurrentPlayer].Name := txtUser.Text;
Players[CurrentPlayer].Pass := txtPass.Text;
Players[CurrentPlayer].Nick := txtNick.Text;
Players[CurrentPlayer].Active := chkActive.Checked;
SetArrayLength(Players[CurrentPlayer].Strings, 1);
SetArrayLength(Players[CurrentPlayer].Integers, 3);
SetArrayLength(Players[CurrentPlayer].Extendeds, 1);
Players[CurrentPlayer].Strings[0] := cmbTreeType.Text
Players[CurrentPlayer].Extendeds[0] := 0.0;
try
Players[CurrentPlayer].Integers[0] := StrToInt(txtHMTC.Text);
Players[CurrentPlayer].Integers[1] := StrToInt(txtChange.Text);
except
ShowMessage('Invalid entry for Logs to Cut and Mins before Change, Please go back and fill in again.');
end;
end;
//Loads info on form when changing player
procedure LoadStats;
begin
if CurrentPlayer < 0 then CurrentPlayer := 0;
txtUser.Text := Players[CurrentPlayer].Name;
txtPass.Text := Players[CurrentPlayer].Pass;
txtNick.Text := Players[CurrentPlayer].Nick;
chkActive.Checked := Players[CurrentPlayer].Active;
try
if Players[CurrentPlayer].Strings[0] = '' then
cmbTreeType.Text := 'Which Tree To Cut'
else
cmbTreeType.Text := Players[CurrentPlayer].Strings[0];
txtHMTC.Text := IntToStr(Players[CurrentPlayer].Integers[0]);
txtChange.Text := IntToStr(Players[CurrentPlayer].Integers[1]);
except
Writeln('New SRL are Pwnz0r');
end;
lblCurPlayer.Caption := 'Player: ' + IntToStr(CurrentPlayer);
HowManyPlayers := GetArrayLength(Players);
end;
//Changes information on form
procedure ChangePlayer(Sender: TObject);
begin
SaveStats;
if Sender = cmdBack then
CurrentPlayer := CurrentPlayer - 1
else
CurrentPlayer := CurrentPlayer + 1;
if CurrentPlayer = GetArrayLength(Players) then NumberOfPlayers(GetArrayLength(Players) + 1);
LoadStats;
txtUser.SetFocus;
end;
//Saves the player array to a file
procedure SavePlayerArray;
var
SaveBuffer: TStringList;
I: Integer;
begin
SaveBuffer := TStringList.Create;
try
SaveBuffer.Add(IntToStr(GetArrayLength(Players)));
for I := 0 to GetArrayLength(Players) - 1 do
begin
SaveBuffer.Add(Players.Name);
SaveBuffer.Add(Players.Pass);
SaveBuffer.Add(Players.Nick);
SaveBuffer.Add(BoolToStr(Players.Active));
SaveBuffer.Add(Players.Strings[0]);
SaveBuffer.Add(IntToStr(Players.Integers[0]));
SaveBuffer.Add(IntToStr(Players.Integers[1]));
end;
SaveToFile(SaveBuffer, AppPath + 'NashiPowerCutter\PlayerArray.txt');
Writeln('Saved player array to ' + AppPath + 'NashiPowerCutter\PlayerArray.txt');
finally
SaveBuffer.Free;
end;
end;
//Loads the player array from a file
procedure NLoadPlayerArray;
var
LoadBuffer: TStringList;
I, Z: Integer;
begin
LoadBuffer := TStringList.Create;
try
if LoadFromFile(LoadBuffer, AppPath + 'NashiPowerCutter\PlayerArray.txt') then
for I := 0 to StrToInt(LoadBuffer.Strings[0]) - 1 do
begin
SetArrayLength(Players, I + 1);
SetArrayLength(Players.Strings, 1);
SetArrayLength(Players.Integers, 2);
Z := I * 7;
Players.Name := LoadBuffer.Strings[Z + 1];
Players.Pass := LoadBuffer.Strings[Z + 2];
Players.Nick := LoadBuffer.Strings[Z + 3];
Players.Active := StrToBool(LoadBuffer.Strings[Z + 4]);
Players.Strings[0] := LoadBuffer.Strings[Z + 5];
Players.Integers[0] := StrToInt(LoadBuffer.Strings[Z + 6]);
Players.Integers[1] := StrToInt(LoadBuffer.Strings[Z + 7]);
end;
finally
HowManyPlayers := GetArrayLength(Players);
LoadBuffer.Free;
end;
end;
//Replacement for SRL's since it's no longer in SRL(Designed for this Script, Won't work with other peoples)
procedure LoadPlayerArray;
var
I: Integer;
begin
for I := 0 to GetArrayLength(Players) - 1 do
if Players.Name = '' then
begin
SetArrayLength(Players, I);
HowManyPlayers := I;
end;
end;
//This is for ending the form
procedure EndDeclare(Sender: TObject);
var
I: Integer;
begin
SaveStats;
NumberOfPlayers(100);
LoadPlayerArray;
for I := 0 to GetArrayLength(Players) - 1 do
Players.Name := Capitalize(Players.Name);
try
CurrentPlayer := StrToInt(Readln('Which player to start with?'));
except
ShowMessage('Must be an Integer. (0, 1, 2 etc..)');
CurrentPlayer := StrToInt(Readln('Which player to start with?'));
end;
if SRLID = '' then
begin
SRLID := '2554';
SRLPassword := 'password';
end;
frmDeclare.ModalResult := mrOk;
SavePlayerArray;
Debug([GetArrayLength(Players), ' Players, Starting Player: ', Players[CurrentPlayer].Name]);
end;
// This form was parsed using: DFM Form Parser v.23 by Ron.
//Loads the form into memory
procedure InitDPForm;
begin
frmDeclare := CreateForm;
frmDeclare.Left := 250;
frmDeclare.Top := 114;
frmDeclare.Hint := 'Fill in this form with your player information';
frmDeclare.BorderStyle := bsToolWindow;
frmDeclare.Caption := 'Declare Players';
frmDeclare.ClientHeight := 140;
frmDeclare.ClientWidth := 325;
frmDeclare.Color := 0;
frmDeclare.Font.Color := clMaroon;
frmDeclare.Font.Height := -11;
frmDeclare.Font.Name := 'MS Sans Serif';
frmDeclare.Font.Style := [fsBold];
frmDeclare.ShowHint := True;
frmDeclare.PixelsPerInch := 96;
lblUser := TLabel.Create(frmDeclare);
lblUser.Parent := frmDeclare;
lblUser.Left := 56;
lblUser.Top := 8;
lblUser.Width := 37;
lblUser.Height := 13;
lblUser.Caption := 'Name:';
lblUser.Transparent := True;
lblPass := TLabel.Create(frmDeclare);
lblPass.Parent := frmDeclare;
lblPass.Left := 35;
lblPass.Top := 28;
lblPass.Width := 59;
lblPass.Height := 13;
lblPass.Caption := 'Password:';
lblPass.Transparent := True;
lblNick := TLabel.Create(frmDeclare);
lblNick.Parent := frmDeclare;
lblNick.Left := 33;
lblNick.Top := 48;
lblNick.Width := 61;
lblNick.Height := 13;
lblNick.Caption := 'Nickname:';
lblNick.Transparent := True;
lblCurPlayer := TLabel.Create(frmDeclare);
lblCurPlayer.Parent := frmDeclare;
lblCurPlayer.Left := 226;
lblCurPlayer.Top := 35;
lblCurPlayer.Width := 51;
lblCurPlayer.Height := 13;
lblCurPlayer.Caption := 'Player: 0';
lblCurPlayer.Transparent := True;
lblHMTC := TLabel.Create(frmDeclare);
lblHMTC.Parent := frmDeclare;
lblHMTC.Left := -1;
lblHMTC.Top := 71;
lblHMTC.Width := 106;
lblHMTC.Height := 13;
lblHMTC.Hint := 'Type how many Logs you wish to cut and Drop';
lblHMTC.Caption := 'How Many To Cut:';
lblHMTC.Transparent := True;
lblChange := TLabel.Create(frmDeclare);
lblChange.Parent := frmDeclare;
lblChange.Left := 3;
lblChange.Top := 93;
lblChange.Width := 160;
lblChange.Height := 13;
lblChange.Hint := 'How long, In minutes before script changes player';
lblChange.Caption := 'Time before player change: ';
lblChange.Transparent := True;
txtUser := TEdit.Create(frmDeclare);
txtUser.Parent := frmDeclare;
txtUser.Left := 96;
txtUser.Top := 3;
txtUser.Width := 121;
txtUser.Height := 21;
txtUser.Hint := 'What is this characters username?';
txtUser.TabOrder := 8;
txtPass := TEdit.Create(frmDeclare);
txtPass.Parent := frmDeclare;
txtPass.Left := 96;
txtPass.Top := 24;
txtPass.Width := 121;
txtPass.Height := 21;
txtPass.Hint := 'What is this characters password?';
txtPass.PasswordChar := '*';
txtPass.TabOrder := 9;
txtNick := TEdit.Create(frmDeclare);
txtNick.Parent := frmDeclare;
txtNick.Left := 96;
txtNick.Top := 45;
txtNick.Width := 121;
txtNick.Height := 21;
txtNick.Hint := '3-4 lowercase characters from the players username(No spaces)';
txtNick.TabOrder := 10;
chkActive := TCheckBox.Create(frmDeclare);
chkActive.Parent := frmDeclare;
chkActive.Left := 228;
chkActive.Top := 6;
chkActive.Width := 97;
chkActive.Height := 17;
chkActive.Hint := 'Will this player be used?';
chkActive.Caption := 'Active?';
chkActive.ParentColor := True;
chkActive.TabOrder := 11;
cmdBack := TButton.Create(frmDeclare);
cmdBack.Parent := frmDeclare;
cmdBack.Left := 23;
cmdBack.Top := 112;
cmdBack.Width := 75;
cmdBack.Height := 25;
cmdBack.Hint := 'Go to last player';
cmdBack.Caption := '<<';
cmdBack.TabOrder := 12;
cmdBack.OnClick := @ChangePlayer;
cmdNext := TButton.Create(frmDeclare);
cmdNext.Parent := frmDeclare;
cmdNext.Left := 218;
cmdNext.Top := 112;
cmdNext.Width := 75;
cmdNext.Height := 25;
cmdNext.Hint := 'Go to next player';
cmdNext.Caption := '>>';
cmdNext.TabOrder := 13;
cmdNext.OnClick := @ChangePlayer;
cmdDPStart := TButton.Create(frmDeclare);
cmdDPStart.Parent := frmDeclare;
cmdDPStart.Left := 105;
cmdDPStart.Top := 112;
cmdDPStart.Width := 106;
cmdDPStart.Height := 25;
cmdDPStart.Hint := 'Start Script';
cmdDPStart.Caption := '&Start';
cmdDPStart.TabOrder := 14;
cmdDPStart.OnClick := @EndDeclare;
cmbTreeType := TComboBox.Create(frmDeclare);
cmbTreeType.Parent := frmDeclare;
cmbTreeType.Left := 179;
cmbTreeType.Top := 67;
cmbTreeType.Width := 145;
cmbTreeType.Height := 21;
cmbTreeType.Hint := 'Select which tree to cut from this drop down Box';
cmbTreeType.ItemHeight := 13;
cmbTreeType.TabOrder := 15;
cmbTreeType.Text := 'Which Tree To Cut?';
cmbTreeType.Items.Add('Tree');
cmbTreeType.Items.Add('Oak');
cmbTreeType.Items.Add('Willow');
txtHMTC := TEdit.Create(frmDeclare);
txtHMTC.Parent := frmDeclare;
txtHMTC.Left := 105;
txtHMTC.Top := 67;
txtHMTC.Width := 72;
txtHMTC.Height := 21;
txtHMTC.Hint := 'Type how many Logs you wish to cut and Drop';
txtHMTC.TabOrder := 16;
txtChange := TEdit.Create(frmDeclare);
txtChange.Parent := frmDeclare;
txtChange.Left := 159;
txtChange.Top := 89;
txtChange.Width := 61;
txtChange.Height := 21;
txtChange.Hint := 'How long, In minutes before script changes player';
txtChange.TabOrder := 17;
try
LoadStats;
except
Writeln('First run');
end;
end;
//Safe call of 'InitDPForm'
procedure SafeInitDPForm;
var
V : TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('InitDPForm', V);
end;
//Shows the form 'frmDeclare'
procedure ShowDPFormModal;
begin
frmDeclare.ShowModal;
end;
//Safe call of 'ShowDPFormModal'
procedure SafeShowDPFormModal;
var
V : TVariantArray;
begin
SetArrayLength(V, 0);
ThreadSafeCall('ShowDPFormModal', V);
end;
//Initiates Declare Player Form
procedure MainInitDPForm;
begin
NumberOfPlayers(1);
NLoadPlayerArray;
SafeInitDPForm;
SafeShowDPFormModal;
FreeForm(frmDeclare);
end;
//Adds 'Plus' to 'Number'
procedure Add(var Number: Integer; Plus: Integer);
begin
Number := Number + Plus;
end;
//Gets teh experience of the Current Players TreeType
function GetEXP: Integer;
begin
case Players[CurrentPlayer].Strings[0] of
'Tree' : Result := 15;
'Oak' : Result := 37;
'Willow': Result := 62;
end;
end;
//Gets teh report vars indec of the Current Players TreeType
function RV: Integer;
begin
case LowerCase(Players[CurrentPlayer].Strings[0]) of
'tree' : Result := 0;
'oak' : Result := 1;
'willow': Result := 2;
end;
end;
//Checks if player has cut allocated logs
function DoneChop: Boolean;
begin
if Players[CurrentPlayer].Integers[2] >= Players[CurrentPlayer].Integers[0] then
Result := True;
end;
//Checks if player has worked for allocated time
function DoneTime: Boolean;
begin
if TimeFromMark(LogMark) >= (Players[CurrentPlayer].Integers[1] * 60000) then
Result := True;
end;
//Drops all logs and updates variables
procedure DropEm;
var
bmpLogMask, T: Integer;
begin
bmpLogMask := BitmapFromString(18, 14, 'z78DA3330A015704302' +
'067404F4B471D4AEA162D7D0F5911B5E405D3369E15ADA85C3504' +
'F27F40400D1E72874');
Status('Dropping Logs');
Gametab(4);
T := NClickAllItemsBmpMaskTolWait(bmpLogMask, 'rop', 20, 25, 30 + Random(30));
Add(ReportVars[RV], T); //Number of ? tree logs cut(? = type of tree, normal, oak, etc)
Add(ReportVars[3], Round(T * GetEXP)); //Experience gained
Add(ReportVars[4], T); //Total Amount of Logs Dropped
Inc(ReportVars[5]); //Loads Cut
Add(Players[CurrentPlayer].Integers[2], T);
Add(LogsCut, T);
Add(ExperienceGained, T * GetEXP);
Players[CurrentPlayer].Extendeds[0] := Players[CurrentPlayer].Integers[2] * GetEXP;
Report;
SaveGlobalStats;
FreeBitmap(bmpLogMask);
end;
//Chops any of the three Supported trees
function Chop(TreeName: string): Boolean;
var
Nx, Ny, N: Integer;
Colours: TIntegerArray;
begin
case LowerCase(TreeName) of
'tree' : Colours := [4156042, 2971727, 2439992];
'oak' : Colours := [3561845, 486492, 1064758];
'willow': Colours := [4150100, 2974794, 3297881];
end;
for N := 0 to 5 do
begin
NashiWCRandoms; //eg, Tree becomes ree, Oak = ak, Willow = illow
if FindObjCustom(Nx, Ny, [TreeName, 'Chop down ' + TreeName, Copy(TreeName, 2, Length(TreeName))], Colours, N) and not UberEnt then
begin
if Random(5) = 4 then
begin
Mouse(Nx, Ny, 1, 1, False);
Wait(250 + Random(300));
ChooseOption('Chop down');
end else
Mouse(Nx, Ny, 1, 1, True);
Wait(500 + Random(300));
Flag;
NashiWCRandoms;
Result := True;
Exit;
end;
end;
NewCompass;
if Random(2) = 1 then HighestAngle else LowestAngle;
end;
//My main loop, I prefer not to have it in the actual Main loop since it gets crowded
procedure NMainLoop;
var
ChopMark: Integer;
begin
if not LoggedIn then
LogInPlayer
else
NickNameBMP := CreateBitmapMaskFromText(Players[CurrentPlayer].Nick, UpChars);
repeat
MarkTime(LogMark);
repeat
repeat
if not LoggedIn then LogInPlayer;
NashiWCRandoms;
if Chop(Players[CurrentPlayer].Strings[0]) then
begin
MarkTime(ChopMark);
repeat
NashiWCRandoms;
Wait(300 + Random(500));
until(TimeFromMark(ChopMark) >= (TreeWait + Random(2000) - Random(1000)));
end;
until(InvFull);
DropEm;
until(DoneChop or DoneTime);
NextPlayer(True);
until(IsFKeyDown(2));
end;
begin
ClearDebug;
SetUpSRL;
ScriptID := '214';
LoadGlobalStats;
Intro;
MainInitDPForm;
MouseSpeed := 10 + Random(10);
Disguise('No page to display - Microsoft Internet Explorer');
NMainLoop;
end.