Полезные функции

QaK · 04.10.2007, 12:10

Мой вариант "инвентаризации", описание атрибутов объектов и действий над ними взял у Shura1oplot'a

Код:

//Инвентаризация by QaK

var ItemCount:integer; //количество занятых слотов/количество вещей
    Inventory: array[1..250,1..10]of integer; //массив инвентаря
    //инвентарь
    //1 - ItemType1
    //2 - ObjectID
    //3 - ItemID
    //4 - ItemCount
    //5 - ItemType2
    //6 - CustType1
    //7 - IsEquipped
    //8 - BodyPart
    //9 - EnchantLevel
    //10 - CustType2
procedure Init; //Вызывается при включении скрипта
begin

end;

procedure Free; //Вызывается при выключении скрипта
begin

end;

//процедура считывания параметров одного предмета
procedure ItemAction(var Counter:integer;CurrentSlot:integer);
//Counter - Позиция считываемая из пакета, модифицируется функциями ReadC,ReadD
//CurrentSlot - Индекс в массиве Inventory (от 1 до 250)
var c1:integer;
begin
for c1:=1 to 10 do
begin //Если значение однобайтное
      if (c1=1)or(c1=5)or(c1=6)or(c1=7)or(c1=9) then
      begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
            inc(Counter);
      end;
      //Если значение четырехбайтное
      if (c1=2)or(c1=3)or(c1=4)or(c1=8) then
      begin Inventory[CurrentSlot,c1]:=ReadD(Counter);
      end;
      //Если значение последнее
      if c1=10 then
      begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
            Counter:=Counter+2;
      end;
end;
end;

//Пакет от сервера 1В - создаем или модифицируем весь инвентарь
procedure CreateItemBase;
var
i,j: integer;
begin
ItemCount:=ReadC(4);//Считываем количество вещей в инвентаре
j:=6;
for i:=1 to ItemCount do ItemAction(j,i);
end;

//Пакет от сервера 27 - действия (доавить/изменить/удалить) над одним/несколькими предметами
procedure UpdateItemBase;
var
  i,ij,ijk:integer; //простые счетчики для перебора значений
  j:integer; //Текущая позиция, откуда считываем значения из пакета
  count:integer; //Количество изменяемых предметов
  Action: integer; //Действие над предметом
  k:boolean; //Нашли ли мы удаляемый предмет?
begin
  k:=false;
  count:=ReadC(1);//Считываем количество изменяемых предметов
  j:=4;
  for i:=1 to count do
  begin Action:=ReadC(j);//Считываем действие
        inc(j);
  {ADD} if Action=1 then
           begin Inc(ItemCount);//Увеличиваем количество занятых слотов
                 ItemAction(j,ItemCount); //Добавляем предмет
           end;
{Update}if Action=2 then for ij:=1 to ItemCount do //Ищем изменяемый предмет по ObjectID
                         If Inventory[ij,2]=ReadD((j-1)*30+8) then //Если нашли
                            begin ItemAction(j,ij); //Изменяем данные о нем
                                  exit;             //Больше проверять не надо - выходим из цикла
                            end;
{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
                                   begin If Inventory[iji,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
                                         If k then //если найден удаляемы объект
                                            for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
                                            Inventory[ij,ijk]:=Inventory[ij+1,ijk];
                                   end;
                               Dec(ItemCount);//Уменьшаем количество занятых слотов
                         end;
  end;
end;

//Получить ObjectID предмета, зная его ItemID
function GetInfo(ItemID:integer):integer;
var c1:integer;
begin Result:=-1;
      for c1:=1 to ItemCount do
      if (ItemID=Inventory[c1,3]) then
      begin Result:=Inventory[c1,2];
            exit;//Если нашли - выходим из цикла
      end;
end;

//Использовать предмет с заданным ItemID
procedure UseItem(ItemID:integer);
var c1:integer;
begin
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin buf:=#$14;
      WriteD(Inventory[c1,2]);
      WriteD(0);
      SendToServer;
      exit; //Чтоб не использовать несколько предметов с одинаковым ItemID (например заточки)
end;
end;

//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
   begin if (pck[1]=#$1B) then
         begin CreateItemBase;
               exit;
         end;
         if (pck[1]=#$27) then
         begin UpdateItemBase;
               exit;
         end;
    end;
end.

}{@KeR · 31.08.2008, 19:39

Цитата:

Сообщение от QaK

Мой вариант "инвентаризации", описание атрибутов объектов и действий над ними взял у Shura1oplot'a

При запуске этого скрипта в l2phx321 показывает ошыбкув месте гле я выделили.

Код:

{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
                                   begin If Inventory[iji,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
                                         If k then //если найден удаляемы объект
                                            for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
                                            Inventory[ij,ijk]:=Inventory[ij+1,ijk];
                                   end;
                               Dec(ItemCount);//Уменьшаем количество занятых слотов
                         end;
  end;
end;

Не сваркайте меня за глупый вопрос но всётаки, пробовал запускать оба скрипта на инвентаризацию и некакой реакции, как он вобще должен работать с инвентарём обьясните нубу???????

QaK · 01.09.2008, 10:16

Цитата:

Сообщение от }{@KeR

Не сваркайте меня за глупый вопрос но всётаки, пробовал запускать оба скрипта на инвентаризацию и некакой реакции, как он вобще должен работать с инвентарём обьясните нубу???????

там ijk должно быть, очепятка =) Скрипт ведет мониторинг инвентаря.

Добавлено через 2 минуты
ItemCount:integer; //количество занятых слотов/количество вещей
Inventory: array[1..250,1..10]of integer; //массив инвентаря
//инвентарь
//1 - ItemType1
//2 - ObjectID
//3 - ItemID
//4 - ItemCount
//5 - ItemType2
//6 - CustType1
//7 - IsEquipped
//8 - BodyPart
//9 - EnchantLevel
//10 - CustType2

описание массива инвентаря, если для тебя непонятно, что это означает, тогда исчи учебники по дельфе.

Insane* · 23.02.2009, 15:04

Добрый день!
Я использую скрипт QaK-а с первой страницы, опечатка исправлена.
Возникает такая проблема, без изменений в скрипте я добавляю следующее:

Код:

procedure Say(msg:string);
begin 
  buf:=hstr('4A 00 00 00 00'); 
  WriteD(2); 
  WriteS(Name); 
  WriteS(msg); 
  SendToClientEx(Name); 
end;


//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
   begin if (pck[1]=#$1B) then
         begin CreateItemBase;
               exit;
         end;
         if (pck[1]=#$27) then
         begin UpdateItemBase;
               exit;
         end;
    end;
if FromClient and (pck=#$1B#06#00#00#00) then begin
useitem(356);
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
SendToServer;
say('we');
end;


end.

Выделенное фиолетовым явно не выполняется (как я понял не выдирается ОИД предмета)
Хотя если я сам нахожу ОИД предмета, например стопки зелий и составляю пакет:
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
то он проходит.
Сервер на Интерлюде. Подскажите, пожалуйста в чем моя ошибка?
Заранее спасибо.

З.Ы. полный текст скрипта:

Код:

//Инвентаризация by QaK
const
name='UltraRich';


var
    ItemCount:integer; //количество занятых слотов/количество вещей
    Inventory: array[1..250,1..10]of integer; //массив инвентаря
    //инвентарь
    //1 - ItemType1
    //2 - ObjectID
    //3 - ItemID
    //4 - ItemCount
    //5 - ItemType2
    //6 - CustType1
    //7 - IsEquipped
    //8 - BodyPart
    //9 - EnchantLevel
    //10 - CustType2
procedure Init; //Вызывается при включении скрипта
begin

end;

procedure Free; //Вызывается при выключении скрипта
begin

end;

//процедура считывания параметров одного предмета
procedure ItemAction(var Counter:integer;CurrentSlot:integer);
//Counter - Позиция считываемая из пакета, модифицируется функциями ReadC,ReadD
//CurrentSlot - Индекс в массиве Inventory (от 1 до 250)
var c1:integer;
begin
for c1:=1 to 10 do
begin //Если значение однобайтное
      if (c1=1)or(c1=5)or(c1=6)or(c1=7)or(c1=9) then
      begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
            inc(Counter);
      end;
      //Если значение четырехбайтное
      if (c1=2)or(c1=3)or(c1=4)or(c1=8) then
      begin Inventory[CurrentSlot,c1]:=ReadD(Counter);
      end;
      //Если значение последнее
      if c1=10 then
      begin Inventory[CurrentSlot,c1]:=ReadC(Counter);
            Counter:=Counter+2;
      end;
end;
end;

//Пакет от сервера 1В - создаем или модифицируем весь инвентарь
procedure CreateItemBase;
var
i,j: integer;
begin
ItemCount:=ReadC(4);//Считываем количество вещей в инвентаре
j:=6;
for i:=1 to ItemCount do ItemAction(j,i);
end;

//Пакет от сервера 27 - действия (доавить/изменить/удалить) над одним/несколькими предметами
procedure UpdateItemBase;
var
  i,ij,ijk:integer; //простые счетчики для перебора значений
  j:integer; //Текущая позиция, откуда считываем значения из пакета
  count:integer; //Количество изменяемых предметов
  Action: integer; //Действие над предметом
  k:boolean; //Нашли ли мы удаляемый предмет?
begin
  k:=false;
  count:=ReadC(1);//Считываем количество изменяемых предметов
  j:=4;
  for i:=1 to count do
  begin Action:=ReadC(j);//Считываем действие
        inc(j);
  {ADD} if Action=1 then
           begin Inc(ItemCount);//Увеличиваем количество занятых слотов
                 ItemAction(j,ItemCount); //Добавляем предмет
           end;
{Update}if Action=2 then for ij:=1 to ItemCount do //Ищем изменяемый предмет по ObjectID
                         If Inventory[ij,2]=ReadD((j-1)*30+8) then //Если нашли
                            begin ItemAction(j,ij); //Изменяем данные о нем
                                  exit;             //Больше проверять не надо - выходим из цикла
                            end;
{Delete}if Action=3 then begin for ij:=1 to ItemCount-1 do //Ищем удаляемый предмет
                                   begin If Inventory[ijk,2]=ReadD((j-1)*30+8) then k:=true; //Если нашли,фиксируем это
                                         If k then //если найден удаляемы объект
                                            for ijk:=1 to 10 do //то сдвигаем элементы массива-инвентаря
                                            Inventory[ij,ijk]:=Inventory[ij+1,ijk];
                                   end;
                               Dec(ItemCount);//Уменьшаем количество занятых слотов
                         end;
  end;
end;

//Получить ObjectID предмета, зная его ItemID
function GetInfo(ItemID:integer):integer;
var c1:integer;
begin Result:=-1;
      for c1:=1 to ItemCount do
      if (ItemID=Inventory[c1,3]) then
      begin Result:=Inventory[c1,2];
            exit;//Если нашли - выходим из цикла
      end;
end;

//Использовать предмет с заданным ItemID
procedure UseItem(ItemID:integer);
var c1:integer;
begin
for c1:=1 to ItemCount do
if (ItemID=Inventory[c1,3]) then
begin buf:=#$14;
      WriteD(Inventory[c1,2]);
      WriteD(0);
      SendToServer;
      exit; //Чтоб не использовать несколько предметов с одинаковым ItemID (например заточки)
end;
end;

procedure Say(msg:string);
begin 
  buf:=hstr('4A 00 00 00 00'); 
  WriteD(2); 
  WriteS(Name); 
  WriteS(msg); 
  SendToClientEx(Name); 
end;


//основная часть скрипта
//вызывается при приходе каждого пакета если скрипт включен
begin
if pck='' then exit;
if FromServer then
   begin if (pck[1]=#$1B) then
         begin CreateItemBase;
               exit;
         end;
         if (pck[1]=#$27) then
         begin UpdateItemBase;
               exit;
         end;
    end;
if FromClient and (pck=#$1B#06#00#00#00) then begin
useitem(356);
pck:=HStr('14 CD 01 42 10 00 00 00 00 ');
SendToServer;
say('we');
end;


end.

Grinch · 23.02.2009, 15:54

Insane*, а массив заполняется инвентарём, помнится там был какой то багнутый скрипт, а если мне память не изменяет исправленный и рабочий, кроме меня и Квака ни кто не видел

QaK · 23.02.2009, 16:36

Insane*, этот скрипт писался под ц4 давным-давно, нужно посотреть и , скорее всего четок переписать под ИЛ.