SetupPlayers; has been put into Players, so you must edit teh one in player form to
procedure SetupPlayers2;
begin
if FileName = '' then FileName := 'chars';
SafeInitForm;
SafeShowFormModal;
FreeForm(FrmDesign);
frmDesign := nil;
ok := nil;
NewUserButton := nil;
SetArrayLength(Names, 0);
SetArrayLength(Passes, 0);
SetArrayLength(Nicks, 0);
SetArrayLength(Location, 0);
SetArrayLength(Skill, 0);
SetArrayLength(Active, 0); //should free ALL memory used
HowManyPlayers := GetArrayLength(players);
if (howmanyplayers = 0) then
begin
WriteLn('You cant run this script without active players');
TerminateScript;
end;
end;
And then use this
{
---Edited by mat_de_b---
__________ BY PANCAKES __ __
\______ \_______ ____ |__| ____ _____/ |_
| ___/\_ __ \/ _ \ | |/ __ \_/ ___\ __\
| | | | \( <_> ) | \ ___/\ \___| |
|____| |__| \____/\__| |\___ >\___ >__|
\______| \/ \/
___________ __ .__
\_ _____/___ _____ _/ |_| |__ ___________ ______
| __)/ __ \\__ \\ __\ | \_/ __ \_ __ \/ ___/
| \\ ___/ / __ \| | | Y \ ___/| | \/\___ \
\___ / \___ >____ /__| |___| /\___ >__| /____ >
\/ \/ \/ \/ \/ \/
}
{===================================================================================}
{ This script will buy feathers from Gerrant, the port sarim fishing equipment
{ seller. You can set the maximum price for it to buy at (meaning it will wait
{ for more feathers to be restocked if they are too expensive). You can also
{ set the amount of feathers to buy, the time per player, and the chance that
{ the script has to 'value' the feather instead of buying (used to check prices).
{ TO USE THIS SCRIPT
{
{
{
{
{
{===================================================================================}
program ProjectFeathers;
{.include SRL\SRL.Scar}
{.include SRL\SRL\misc\PlayerForm.Scar}
{===================================================================================}
var GerrantFound, ShopBMP, CloseBMP, FeathersBought, FeatherDTM, RotateTimes, TimePlayed, FeatherPrice : Integer;
var TheClose : Boolean;
var
MyForm : TForm;
Button1 : TButton;
Button2 : TButton;
const
GerrantCol1 = 6977436;
GerrantCol2 = 15855601;
GerrantCol3 = 12303300;
GerrantTol = 3;
FeathersToBuy = 100000; //Just put a big number if you want it to buy forever.
TimePerPlayer = 20; //In SECONDS
MaxFeather = 4; {The maximum price a feather can cost and still buy it.
Otherwise, we will wait until the feather price goes down again.}
ValueChance = 10; //1 out of ValueChance chance to value the feathers before buying.
{===================================================================================}
procedure AddPic;
var
Picture : Integer;
Canvas : TCanvas;
begin
Picture := BitmapFromString2(False, 'a52AE978DAED99E18E8320' +
'0CC75F0910103E22A3EFFF486BC9B29B87202ABB25B7FE499A06B' +
'0D4F597AA991042062D5041A23136A0B5523DAD498E7C43D6384B' +
'BE17CF190574AD0AE9C78F1441DDDCB6EF688F31912CE4687408C' +
'EE498E073FC09EDBCD0CE39D2C2EC733E0BFA52E7F929E4CB58AC' +
'F70858AC41DAE2CA5AF2BFD3923CCA5AB6E72C73C55C3157CCD5F' +
'FE20A02B8F59313BF465C634FF637AAE684DE8BB351650BA27E56' +
'4A491F3FE55529DC629B2B8838C263BB069D52FFAA0F3ED8D5AFE' +
'7A38F3694557848824CEBD540F7BB9AF138ECC90CB3BFC1439167' +
'75E738AE1CE8DD5ABFEEC9758429C5E371BAB82AE29C3BA53AFF9' +
'BABA2B257564B2A76E67BB8EACF21530D338EA93FC207FB15DE29' +
'C0A25CA3EEC3B86AF6AB3675A7B8BAD0AF56ABCD3E50E5AA23C24' +
'E0E0B0E1F518BAAF2D3D157DFDFAFDACC54EB75B4EF71BF1ADEAF' +
'6AA7F4E7F339AE6ACFC1AEF7AB9EB7A3CBEF5743B96AF78ABFE1A' +
'A3F87DA73B0E88AEFEF57FC3DC896B962AE982BE6EADBB862B146' +
'FE3FC8628DD51D440');
Canvas := GetBitmapCanvas(Picture);
CopyCanvas(Canvas, MyForm.Canvas, 1, -1, 100, 15, 0, 0, 297, 40);
end;
procedure btnSetupPlayers(sender : TObject);
begin
MyForm.Close;
end;
procedure btnExit(sender : TObject);
begin
MyForm.Close;
TheClose := True;
end;
procedure PaintMyForm(sender : TObject);
begin
AddPic;
end;
procedure MyInitForm;
begin
MyForm := CreateForm;
MyForm.Left := 250;
MyForm.Top := 114;
MyForm.BorderStyle := bsNone;
MyForm.Caption := '[Project Feathers]';
MyForm.ClientHeight := 65;
MyForm.ClientWidth := 297;
MyForm.Color := clBlack;
MyForm.Font.Color := clWindowText;
MyForm.Font.Height := -11;
MyForm.Font.Name := 'MS Sans Serif';
MyForm.Font.Style := [];
MyForm.Visible := False;
MyForm.PixelsPerInch := 96;
MyForm.ONPAINT := @PaintMyForm;
Button1 := TButton.Create(MyForm);
Button1.Parent := MyForm;
Button1.Left := 203;
Button1.Top := 40;
Button1.Width := 95;
Button1.Height := 25;
Button1.Caption := 'Setup Players >>';
Button1.TabOrder := 8;
Button1.OnClick := @btnSetupPlayers;
Button2 := TButton.Create(MyForm);
Button2.Parent := MyForm;
Button2.Left := 0;
Button2.Top := 40;
Button2.Width := 75;
Button2.Height := 25;
Button2.Caption := '<< Exit';
Button2.TabOrder := 9;
Button2.OnClick := @btnExit;
end;
procedure SafeMyInitForm;
var v : TvariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('MyInitForm', v);
end;
procedure MyShowFormModal;
begin
MyForm.ShowModal;
end;
procedure SafeMyShowFormModal;
var v : TVariantArray;
begin
setarraylength(v, 0);
ThreadSafeCall('MyShowFormModal', v);
end;
{===================================================================================}
procedure LoadPictures; //So we know what to look for...
begin
FeatherDTM := DTMFromString('78DA63FCCCC8C0A00AC44860C7DA350CFF813' +
'448F43F1030FE05B22450D54064612490FE0D64291250F31DC8D2' +
'22A0E62390A54740CD3B204B89809AD784ED020082450EDD');
ShopBMP := BitmapFromString(53, 17, 'z78DAED97C10D002008035772' +
'0AF71FC90D0CA18005DBA70F4B2F18612D4962D43628CF9127699' +
'72C0CF4A2EA11BD1A7A51A9A7D2CBB8E75EADC5372AB5CF37BBF7' +
'F014BEFB115FFB79CDCBCDEBA51FE8D553123DBCB7BBD363F8055' +
'E4DCB33B624ED8CA2574349DCF0695C4CF875002E2F4F95');
CloseBMP := BitmapFromString(16, 17, 'z78DA33301805830BB821015A' +
'ABC7AF8B7895A4EAA5C464FCE650CB64626C19D8781F0CEEA75DF' +
'8D32EFDD03AFDD35AFDD002009A8E4DE8');
end;
function MyCloseWindow : Boolean;
var x, y : Integer;
begin
if (FindBitmapMaskTolerance(CloseBMP, x, y, MSX1, MSY1, MSX2, MSY2, 4, 4)) then
begin
Result := True;
Mouse(x, y, 3, 3, True);
end else
begin
Result := False;
end;
end;
function MyShopScreen : Boolean;
var x, y : Integer;
begin
Result := FindBitmapMaskTolerance(ShopBMP, x, y, MSX1, MSY1, MSX2, MSY2, 4, 4);
end;
function OpenShop : Boolean;
var x, y, i : Integer;
begin
if (Not(LoggedIn)) then Exit;
if (MyShopScreen) then
begin
Result := True;
Exit;
end;
for i := 0 to 2 do
begin
Wait(10 + Random(100));
if (FindColorSpiralTolerance(x, y, GerrantCol1, MSX1, MSY1, MSX2, MSY2, GerrantTol))
or (FindColorSpiralTolerance(x, y, GerrantCol2, MSX1, MSY1, MSX2, MSY2, GerrantTol))
or (FindColorSpiralTolerance(x, y, GerrantCol3, MSX1, MSY1, MSX2, MSY2, GerrantTol)) then
begin
MMouse(x, y, 2, 2);
Wait(800 + Random(300));
if (IsUpText('errant')) then
begin
Mouse(x, y, 2, 2, False);
Wait(800 + Random(300));
if (ClickOption('rade',1 )) then
begin
FFlag(1);
Result := True;
GerrantFound := GerrantFound + 1;
Wait(1000 + Random(500));
Exit;
end;
Exit;
end;
end;
end;
Result := False;
KeyDown(VK_LEFT);
Wait(300 + Random(100));
KeyUp(VK_Left);
RotateTimes := RotateTimes + 1;
end;
procedure CameraAngle(Direction : String);
begin
if (LowerCase(Direction) = 'down') then
begin
KeyDown(VK_DOWN);
Wait(300 + Random(100));
KeyUp(VK_DOWN);
end;
if (LowerCase(Direction) = 'up') then
begin
KeyDown(VK_UP);
Wait(300 + Random(100));
KeyUp(VK_UP);
end;
end;
procedure CheckRotation;
begin
if (RotateTimes >= 10) and (RotateTimes <= 15) then CameraAngle('Down');
if (RotateTimes >= 16) and (RotateTimes <= 20) then CameraAngle('Up');
if (RotateTimes >= 21) and (RotateTimes <= 25) then CameraAngle('Down');
if (RotateTimes >= 26) and (RotateTimes <= 30) then CameraAngle('Up');
end;
procedure SetupPlayer;
var i : Integer;
begin
ChatsOff;
HighestAngle;
MakeCompass('N');
RotateTimes := 0;
MarkTime(TimePlayed);
for i:= 1 to Random(6) + 1 do
begin
GameTab(1 + Random(7));
end;
end;
procedure SwitchPlayer(Reason:string;Active:boolean); //Credits PhantomBMX, edited a little.
begin
WriteLn('Switching Player: '+Reason);
CloseWindow;
NextPlayer(Active);
SetupPlayer;
end;
function EnoughCoins : Boolean;
begin
if (Not(LoggedIn)) then Exit;
FixChat;
if (FindBlackChatMessage('h coins.')) or (FindBlackChatMessage('enough')) then
begin
Result := False;
Exit;
end;
Result := True;
end;
procedure Progress;
begin
ClearReport;
AddToReport(inttostr(feathersbought) + ' feathers bought so far.');
AddToReport('Feathers cost ' + inttostr(featherprice) + 'gp each at the moment');
end;
function FeatherValue : Integer;
var x, y : Integer;
var ValueMessage : String;
begin
FixChat;
if (FindDTM(FeatherDTM, x, y, MSX1, MSY1, MSX2, MSY2)) then
begin
if (RBool) then
begin
Mouse(x, y, 3, 3, False);
ClickOption('alue', 1);
end else
begin
Mouse(x, y, 3, 3, True);
end;
Wait(900 + Random(500));
ValueMessage := GetBlackChatMessage;
ValueMessage := Right(ValueMessage, 8);
ValueMessage := Left(ValueMessage, 1);
ValueMessage := Trim(ValueMessage);
FeatherPrice := StrToInt(ValueMessage);
Result := FeatherPrice;
end;
end;
function BuyFeathers : Integer;
var x, y, RandFeather : Integer;
begin
if (Not(LoggedIn)) then Exit;
if (FindDTM(FeatherDTM, x, y, MSX1, MSY1, MSX2, MSY2)) then
begin
Mouse(x, y, 2, 2, False);
Wait(50 + Random(100));
RandFeather := Random(6);
case RandFeather of
0: if (ClickOption('uy 5', 1)) then Result := 5;
1: if (ClickOption('uy 5', 1)) then Result := 5;
2: if (ClickOption('uy 10', 1)) then Result := 10;
3: if (ClickOption('uy 10', 1)) then Result := 10;
4: if (ClickOption('uy 10', 1)) then Result := 10;
5: if (ClickOption('uy 10', 1)) then Result := 10;
6: if (ClickOption('uy 10', 1)) then Result := 10;
end;
Exit;
end;
Result := 0;
end;
begin
SetupSRL;
LoadPictures;
Mousespeed := 5;
SafeMyInitForm;
SafeMyShowFormModal;
if (TheClose) then TerminateScript;
SetupPlayers2;
Wait(500);
ActivateClient;
if (Not(LoggedIn)) then LoginPlayer;
repeat
MarkTime(TimePlayed);
Wait(500);
SetupPlayer;
repeat
Wait(100 + Random(50));
CheckRotation;
if (RotateTimes > 30) then begin
SwitchPlayer('Could not find Garret 30 times, where are we?', false);
end;
until(OpenShop);
repeat
if (Not(MyShopScreen)) then
repeat
Wait(100 + Random(50));
CheckRotation;
if (RotateTimes > 30) then begin
SwitchPlayer('Could not find Garret 30 times, where are we?', false);
end;
until(OpenShop);
if (1 + Random(ValueChance) = 1) then
begin
while (FeatherValue > MaxFeather) do
begin
Wait2(20000 + Random(10000), False);
end;
end;
Wait(100 + Random(50));
FeathersBought := FeathersBought + BuyFeathers;
Progress;
if (GetSystemTime - TimePlayed * 1000 >= TimePerPlayer) then Break;
until (Not(EnoughCoins)) or (FeathersBought >= FeathersToBuy) or (GetSystemTime - TimePlayed * 1000 >= TimePerPlayer);
if (MyCloseWindow) then SwitchPlayer('Player ran successfully', true);
until(false);
end.
Im not promising it works, havent tested it