Наслоение менюшек
Posted: 29.11.2012 20:28
Доброго вечера. Подошла пора для прокачки карпентри. Ничего толкового не нашёл, пришлось переделывать... Насобирал вот такую ахинею, которая ,вроде, работает, но , когда делает вещь, не хочет закрывать менюшки и они набираются пачками и начинаются тормоза. Буду рад подсказке, как решить проблему.
По такому же принципу насобирал простенький скрипт на тинкер и та же проблема - менюшки
Code: Select all
Program Carpentry;
{$Include 'all.inc'}
const
Sunduk=$40311AFE;
Tools=$1033;
log=$1BDD;
eda=$097B;
Izdelie=$0DBF;
Trash=$404DF27F;
color=$-1;
var
k, l : integer;
TimeStart : TDateTime;
procedure Check_Izdelie;
begin
FindType(Izdelie,Backpack);
if FindCount>0 then
begin
MoveItem(FindItem,1,Trash,0,0,0);
wait(500);
end
end;
procedure Check_Connect;
begin
if not Connected then
while not Connected do
begin
Connect;
wait(1000);
end
end;
procedure Check_logs;
begin
FindType(log,Backpack);
if (FindCount=0) OR (Count(log)<1) then
begin
UseObject(Sunduk);
wait(1000);
FindType(log,Sunduk);
if (FindCount>0) and (CountEx(log,color,Sunduk)>1) then
begin
MoveItem(FindType(log,Sunduk),100,Backpack,0,0,0);
wait(1000);
AddToSystemJournal('Добрали 100 логов. На данный момент имеем '+IntToStr(Count(log))+' штук. Осталось ещё '+IntToStr(CountEx(log,color,Sunduk))+' Логов. l='+IntToStr(l)+'; Count='+IntToStr(Count(Izdelie))+';');
end
else
AddToSystemJournal('Ошибка во время добора Логов.');
exit;
end;
FindType(log,Ground);
if FindCount>0 then
begin
MoveItem(FindItem,0,Sunduk,0,0,0);
wait(500);
end
end;
procedure Check_Food;
begin
UseObject(Sunduk)
wait(250);
FindType(eda,Sunduk);
if FindCount>0 then
begin
MoveItem(FindItem,1,Backpack,0,0,0);
wait(250);
UseObject(FindItem);
FindType(eda,Backpack);
if FindCount=0 then AddToSystemJournal('Покушали.');
if FindCount>0 then MoveItem(FindItem,1,Sunduk,0,0,0);
end
else
AddToSystemJournal('Еда не нашлась в сундуке в сундуке.');
end;
procedure Check_Tools;
begin
FindType(Tools,backpack);
if FindCount=0 then
begin
FindType(Tools,Sunduk);
if FindCount > 0 then
begin
moveitem(FindItem,1,backpack,0,0,0);
end
end
end;
Begin
ClearJournal;
CancelMenu;
AutoMenu( 'Carpentry' , 'Weapons & Tools' );
AutoMenu( 'Weapons & Tools' , 'fishing pole' );
FindDistance:=1;
while not Dead do
begin
useobject(sunduk);
wait(1000);
useobject(Trash);
wait(1000);
Check_Tools;
repeat
Check_logs;
k:=0;
TimeStart:=Now;
UseObject(FindType(Tools,Backpack));
repeat
wait(100);
checksave;
until (InJournalBetweenTimes('You put|fail', TimeStart, Now)<>-1);
wait(500);
if InJournal('put')<>-1 then
begin
Check_Izdelie;
end;
ClearJournal;
until l=255
if l=255 then
begin
l:=0;
end;
end;
End.Code: Select all
Program Tinker;
{$Include 'all.inc'}
const
Sunduk=$40230CB8;
Tools=$1EBC;
ingot=$1BEF;
eda=$097B;
Izdelie=$0f43;
Trash=$40230CB8;
color=$-1;
var
k, l : integer;
TimeStart : TDateTime;
procedure Check_Izdelie;
begin
FindType(Izdelie,Backpack);
if FindCount>0 then
begin
MoveItem(FindItem,1,Trash,0,0,0);
wait(500);
end
end;
procedure Check_Connect;
begin
if not Connected then
while not Connected do
begin
Connect;
wait(1000);
end
end;
procedure Check_ingot;
begin
FindType(ingot,Backpack);
if (FindCount=0) OR (Count(ingot)<1) then
begin
UseObject(Sunduk);
wait(1000);
FindType(ingot,Sunduk);
if (FindCount>0) and (CountEx(ingot,color,Sunduk)>1) then
begin
MoveItem(FindType(ingot,Sunduk),100,Backpack,0,0,0);
wait(1000);
AddToSystemJournal('Добрали 100 инготов. На данный момент имеем '+IntToStr(Count(ingot))+' штук. Осталось ещё '+IntToStr(CountEx(ingot,color,Sunduk))+' Логов. l='+IntToStr(l)+'; Count='+IntToStr(Count(Izdelie))+';');
end
else
AddToSystemJournal('Ошибка во время добора инготов.');
exit;
end;
FindType(ingot,Ground);
if FindCount>0 then
begin
MoveItem(FindItem,0,Sunduk,0,0,0);
wait(500);
end
end;
procedure Check_Food;
begin
UseObject(Sunduk)
wait(250);
FindType(eda,Sunduk);
if FindCount>0 then
begin
MoveItem(FindItem,1,Backpack,0,0,0);
wait(250);
UseObject(FindItem);
FindType(eda,Backpack);
if FindCount=0 then AddToSystemJournal('Покушали.');
if FindCount>0 then MoveItem(FindItem,1,Sunduk,0,0,0);
end
else
AddToSystemJournal('Еда не нашлась в сундуке в сундуке.');
end;
procedure Check_Tools;
begin
FindType(Tools,backpack);
if FindCount=0 then
begin
FindType(Tools,Sunduk);
if FindCount > 0 then
begin
moveitem(FindItem,1,backpack,0,0,0);
end
end
end;
Begin
ClearJournal;
CancelMenu;
AutoMenu( 'Tinkering' , 'Tools' );
AutoMenu( 'Tools' , 'hatchet' );
FindDistance:=1;
while not Dead do
begin
useobject(sunduk);
wait(1000);
useobject(Trash);
wait(1000);
Check_Tools;
repeat
Check_ingot;
k:=0;
TimeStart:=Now;
UseObject(FindType(Tools,Backpack));
repeat
wait(100);
checksave;
until (InJournalBetweenTimes('You put|fail', TimeStart, Now)<>-1);
wait(500);
if InJournal('put')<>-1 then
begin
Check_Izdelie;
end;
ClearJournal;
until l=255
if l=255 then
begin
l:=0;
end;
end;
End.