Code:
program Crafter;
var
x1, ShopX, ShopY: Integer;
procedure FindClient;
var
I: Integer;
begin
for I := 0 to 600 do
begin
if (GetColor(I, 420) = 2437688) then x1 := I;
if x1 > 0 then
begin
WriteLn('Clientti loyty (X='+IntToStr(x1)+')');
Exit;
end;
end;
end;
procedure C(x, y: Integer; Left: Boolean);
begin
MoveMouse(x-258+x1, y);
Wait(70);
ClickMouse(x-258+x1, y, Left);
Wait(70);
Wait(7000);
end;
function ShopScreen: Boolean;
begin
Result := (GetColor(222+x1, 41) = 2070783);
end;
procedure CloseShop;
var
I: Integer;
begin
while ShopScreen do
begin
MoveMouse(697-258+X1, 37);
Wait(30);
ClickMouse(697-258+X1, 37, True);
while ShopScreen and (I < 350) do
begin
Wait(10);
Inc(I);
end;
if I < 350 then Exit;
I := 0;
end;
end;
function OpenShop: Boolean;
var
x, y, I, II, III, A: Integer;
NewX: Integer;
begin
repeat
if IsFKeyDown(10) then TerminateScript;
MoveMouse(ShopX-257+X1, ShopY);
while (CountColorTolerance(255463, 315-258+X1, 5, 360-258+X1, 15, 35) < 7) do
begin
Wait(10);
A := A + 1;
if A = 150 then
begin
ClickMouse(790-258+X1, 263, True);
Wait(80);
ClickMouse(790-258+X1, 263, True);
Wait(80);
MoveMouse(ShopX-257+X1, ShopY);
end;
if A = 300 then
begin
for A := 300 to 400 do
begin
NewX := ShopX+A-300;
MoveMouse(NewX-257+X1, ShopY);
Wait(100);
if (CountColorTolerance(255463, 315-258+X1, 5, 360-258+X1, 15, 35) > 6) then Break;
NewX := ShopX-A+300;
MoveMouse(NewX-257+X1, ShopY);
Wait(100);
if (CountColorTolerance(255463, 315-258+X1, 5, 360-258+X1, 15, 35) > 6) then Break;
end;
if A < 400 then ShopX := NewX
else TerminateScript;
end;
end;
ClickMouse(ShopX-257+X1, ShopY, False);
III := 0;
while (III < 50) do
begin
if FindColor(x, y, 65535, ShopX-280+X1, ShopY-30, ShopX-255+X1, ShopY+80) then
begin
ClickMouse(ShopX, Y+20, True);
Break;
end;
Inc(III);
Wait(5)
end;
if III > 49 then Continue;
//Wait(100);
//ClickMouse(ShopX-258+X1, ShopY+42, True);
I := 0;
repeat
Wait(10);
I := I+1;
until(ShopScreen or (I > 200));
until(ShopScreen);
MoveMouse(445-258+X1, 130);
Wait(50);
ClickMouse(445-258+X1, 130, False);
while not FindColor(x, y, 65536, 445-258+X1, 130, 450-257+X1, 135) do Wait(5);
ClickMouse(435-258+X1, 216, True);
Wait(50);
CloseShop;
repeat
Wait(10);
II := II+1
until(((GetColor(960-258+X1, 450) <> 3357765) and (GetColor(920-258+X1, 450) <> 3357765))) or (II > 200);
end;
procedure Clicks;
var
x, y: Integer;
begin
MoveMouse(970, 445);
Wait(50);
repeat
if IsFKeyDown(10) then TerminateScript;
MoveMouse(953-258+X1, 445);
Wait(10);
ClickMouse(953-258+X1, 445, True);
Wait(40);
MoveMouse(931-258+X1, 445);
Wait(10);
ClickMouse(931-258+X1, 445, True);
Wait(40);
until(GetColor(960-258+X1, 450) = 3357765) or (GetColor(920-258+X1, 450) = 3357765);
ClickMouse(790-258+X1, 263, True);
Wait(10);
ClickMouse(790-258+X1, 263, True);
Wait(10);
ClickMouse(790-258+X1, 263, True);
Wait(15);
end;
begin
Wait(3000);
FindClient;
//GetMousePos(ShopX, ShopY);
ShopX := 517;
ShopY := 167;
repeat
Clicks;
OpenShop;
until(false);
end.