Forum in READ ONLY mode! All questions and discussions on Discord official server, invite link: https://discord.gg/VxsGzJ7

Самопальный вариант одевания одежды

тут можно задать вопрос по скриптингу
Post Reply
Hrenik
Neophyte
Neophyte
Posts: 16
Joined: 22.12.2013 10:11

Самопальный вариант одевания одежды

Post by Hrenik »

Немного поработав напильником написал скрипт который:
1. Просматриает все слои одежды
2. Сохраняет имеющиюся одежду в текст файл в корневом каталоге стелса
3. При необходимости загружает айдишники из этого файла и одевает.

Code: Select all

Program DressMod;
uses SysUtils;
{$Include 'all.inc'}
var
Layer : array[1..20] of Byte;
LID : array [1..20] of Integer;
mode: Word;
MyStringList : TStringList;
a,i,ID : integer;
S : String;

function LoadLayersFromFile (Filepath : String) : Boolean;
begin
  Result := true;
  try
    MyStringList := TStringList.Create;
    MyStringList.LoadFromFile(Filepath);
    if MyStringList.Count = 0 then Result := false
    else for i := 0 to MyStringList.Count - 1 do
    begin
      S := MyStringList.Strings[i];
      ID := StrToInt(Copy(S,1,10));
      LID[i+1] := ID;
    end; {end for}
    finally
    MyStringList.Free;
  end;
end;

procedure WriteToFile(filepath: string; data: string);
begin
  if FileExists(filepath) then mode := fmOpenReadWrite
  else
  mode := fmCreate;
  with TFileStream.Create(filepath,mode) do
  try
    Seek(0,soFromEnd);
    WriteBuffer(data,Length(data)*2);
    finally
    Free;
  end;
end;

procedure ScanLayer;
begin
  checksave;
  a := 0;
  for a:= 1 to 20 do
  begin
    AddToSystemJournal(IntToStr(a) +' Layer: ' +IntToStr(ObjAtLayer(Layer[a]) ));
    {if (a < 20) then}
    WriteToFile(charname+'.txt', IntToStr(ObjAtLayer(Layer[a])) + #13#10);
    {if (a = 20) then WriteToFile(charname+'.txt', IntToStr(ObjAtLayer(Layer[a]))+ #13);}
    wait(1000);
  end;
  AddToSystemJournal('DressLayer scanned');
end;

BEGIN
  Layer[1] := RhandLayer;
  Layer[2] := LhandLayer;
  Layer[3] := ShoesLayer;
  Layer[4] := PantsLayer;
  Layer[5] := ShirtLayer;
  Layer[6] := HatLayer;
  Layer[7] := GlovesLayer;
  Layer[8] := RingLayer;
  Layer[9] := TalismanLayer;
  Layer[10] := NeckLayer;
  Layer[11] := WaistLayer;
  Layer[12] := TorsoLayer;
  Layer[13] := BraceLayer;
  Layer[14] := TorsoHLayer;
  Layer[15] := EarLayer;
  Layer[16] := ArmsLayer;
  Layer[17] := CloakLayer;
  Layer[18] := RobeLayer;
  Layer[19] := EggsLayer;
  Layer[20] := LegsLayer;

  if not (FileExists(charname +'.txt')) then ScanLayer;
  //if FileExists(filepath) then DeleteFile(charname +'.txt');
  if LoadLayersFromFile(charname +'.txt') then
  begin
    a := 0
    AddToSystemJournal('File Loaded');
    for a := 1 to 20 do
    begin
      if not (WearItem(Layer[a], LID[a])) and (LID[a] >0)  then Equip(Layer[a], LID[a]);
      wait(700);
    end;
  end
  else AddToSystemJournal('Error Loading Layers from file');
end.
Теперь вопрос:

Если я запускаю этот скрипт то он успешно все слои просматривает и сохраняет в файл, но не одевает одежду на персонажа:
Так как:
12:52:29:459 [skn1488]: DressLayer scanned
12:52:29:464 [skn1488]: File Loaded
12:52:29:471 [skn1488]: Drag error: Object not found.
12:52:42:723 [skn1488]: Succesfully executed

Файл имеет структуру:
  • 1076410890
    1077156196
    0
    1077086461
    0
    1075482279
    0
    1075482336
    0
    0
    0
    0
    1075482338
    0
    0
    0
    1074364804
    0
    0
    0
В конце файла имеется лишний перевод на новую строчку, и если я его вручную стираю то после этого скрипт замечательно работает и одевает одежду.

Если же я этот лишний перевод изначально учитываю в массиве и не прописываю на последнем проходе, то опять ничего не работает:

Code: Select all

a := 0;
for a:= 1 to 20 do
begin
if (a < 20) then WriteToFile(charname+'.txt', IntToStr(ObjAtLayer(Layer[a])) + #13#10);
if (a = 20) then WriteToFile(charname+'.txt', IntToStr(ObjAtLayer(Layer[a])));
end;
в чём проблема кроме кривых рук?
User avatar
Vizit0r
Developer
Developer
Posts: 3958
Joined: 24.03.2005 17:05
Contact:

Re: Самопальный вариант одевания одежды

Post by Vizit0r »

может

Code: Select all

    else for i := 0 to MyStringList.Count - 2 do
но лучше так:

Code: Select all

   begin
      S := MyStringList.Strings[i];
      if S = '' then Continue;
      ID := StrToInt(Copy(S,1,10));
      LID[i+1] := ID;
    end; {end for}
кстати, убери {end for}
"Пишите код так, как будто сопровождать его будет склонный к насилию психопат, который знает, где вы живете". (с) Макконнелл, "Совершенный код".
Hrenik
Neophyte
Neophyte
Posts: 16
Joined: 22.12.2013 10:11

Re: Самопальный вариант одевания одежды

Post by Hrenik »

спасибо, частично помогло. Но проблема немного видоизменилась.

Мотодом проб и ошибок удалось ограничить проблему на этой функции:

Code: Select all

function LoadLayersFromFile (Filepath : String) : Boolean;
begin
  Result := true;
  try
    MyStringList := TStringList.Create;         
    MyStringList.LoadFromFile(Filepath);
    AddToSystemJournal('Count: '+IntToStr(MyStringList.Count)); 
    if MyStringList.Count = 1 then Alarm;
    if MyStringList.Count = 0 then Result := false
    else for i := 0 to MyStringList.Count -1 do
    begin      
    
      S := MyStringList.Strings[i];
      if S = '' then Continue;
      ID := StrToInt(Copy(S,1,10));
      LID[i+1] := ID;
      //AddToSystemJournal('S: ' +' '+S +' ID: ' +inttostr(ID) +' i: '+IntToStr(i) );       
    end;
    finally
    MyStringList.Free;
  end;
end;
а именно на сочетании MyStringList.Count

если ничего в сохранённом файле не менять (оставить сноску на новую строчку) то количество стрингов в списке показывается как 1 и дальнейшая обработка файла стопорится:

Code: Select all

10:07:10:499 [skn1488]: Compiling
10:07:10:532 [skn1488]: Compiled succesfully
10:07:10:618 [skn1488]: Count: 1
10:07:10:625 [skn1488]: File Loaded
10:07:10:630 [skn1488]: 1 Layer: 1 LID: 1
10:07:10:637 [skn1488]: Drag error: Object not found.
10:07:11:344 [skn1488]: 2 Layer: 2 LID: 0
10:07:12:054 [skn1488]: 3 Layer: 3 LID: 0
10:07:12:761 [skn1488]: 4 Layer: 4 LID: 0
10:07:13:470 [skn1488]: 5 Layer: 5 LID: 0
10:07:14:177 [skn1488]: 6 Layer: 6 LID: 0
10:07:14:884 [skn1488]: 7 Layer: 7 LID: 0
10:07:15:681 [skn1488]: 8 Layer: 8 LID: 0
10:07:16:389 [skn1488]: 9 Layer: 9 LID: 0
10:07:17:097 [skn1488]: 10 Layer: 10 LID: 0
10:07:17:810 [skn1488]: 11 Layer: 12 LID: 0
10:07:18:516 [skn1488]: 12 Layer: 13 LID: 0
10:07:19:223 [skn1488]: 13 Layer: 14 LID: 0
10:07:19:932 [skn1488]: 14 Layer: 17 LID: 0
10:07:20:639 [skn1488]: 15 Layer: 18 LID: 0
10:07:21:347 [skn1488]: 16 Layer: 19 LID: 0
10:07:22:058 [skn1488]: 17 Layer: 20 LID: 0
10:07:22:839 [skn1488]: 18 Layer: 22 LID: 0
10:07:23:549 [skn1488]: 19 Layer: 23 LID: 0
10:07:24:259 [skn1488]: 20 Layer: 24 LID: 0
10:07:24:966 [skn1488]: Succesfully executed
если же вручную открыть файл и стереть сноску то всё работает православно:

Code: Select all

10:08:25:816 [skn1488]: Compiling
10:08:25:858 [skn1488]: Compiled succesfully
10:08:25:952 [skn1488]: Count: 20
10:08:25:981 [skn1488]: File Loaded
10:08:25:987 [skn1488]: 1 Layer: 1 LID: 1076410890
10:08:26:751 [skn1488]: 2 Layer: 2 LID: 1077156196
10:08:27:515 [skn1488]: 3 Layer: 3 LID: 0
10:08:28:223 [skn1488]: 4 Layer: 4 LID: 1077086461
10:08:28:986 [skn1488]: 5 Layer: 5 LID: 0
10:08:29:692 [skn1488]: 6 Layer: 6 LID: 1075482279
10:08:30:442 [skn1488]: 7 Layer: 7 LID: 0
10:08:31:150 [skn1488]: 8 Layer: 8 LID: 1075482336
10:08:31:992 [skn1488]: 9 Layer: 9 LID: 0
10:08:32:703 [skn1488]: 10 Layer: 10 LID: 0
10:08:33:411 [skn1488]: 11 Layer: 12 LID: 0
10:08:34:121 [skn1488]: 12 Layer: 13 LID: 1074712490
10:08:34:869 [skn1488]: 13 Layer: 14 LID: 1075482338
10:08:35:616 [skn1488]: 14 Layer: 17 LID: 1074712495
10:08:36:378 [skn1488]: 15 Layer: 18 LID: 0
10:08:37:085 [skn1488]: 16 Layer: 19 LID: 1074712488
10:08:37:835 [skn1488]: 17 Layer: 20 LID: 1074364804
10:08:38:597 [skn1488]: 18 Layer: 22 LID: 0
10:08:39:378 [skn1488]: 19 Layer: 23 LID: 0
10:08:40:085 [skn1488]: 20 Layer: 24 LID: 0
10:08:40:791 [skn1488]: Succesfully executed
пуркуа?
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Самопальный вариант одевания одежды

Post by drabadan »

а почему бы не использовать инифайлы?
Скрипт

Code: Select all

Program Dresser;

const
    FilePath = 'd:\'; 
    
var
    TestVar : Integer;

procedure TestIniWriteInteger;
var  
    f : TIniFile;
begin
  f := TIniFile.Create(FilePath + CharName + '.ini');
  try
    f.WriteInteger('General', 'Hello', 100500);
  finally
    f.Free;
  end;        
end;

procedure ReadInteger;
var
    f : TIniFile;
begin
    f := TIniFile.Create(FilePath + CharName + '.ini');
    try
        TestVar := f.ReadInteger('General', 'Hello', 0);
    finally
        f.Free;
    end;      
end;

begin  
    TestIniWriteInteger;
    ReadInteger;
    
    if TestVar > 0 then AddToSystemJournal(IntToStr(TestVar + 100));
end.

Code: Select all

21:05:40:546 [accMessi]: Compiling
21:05:40:558 [accMessi]: Compiled succesfully
21:05:40:563 [accMessi]: 100600
21:05:40:566 [accMessi]: Succesfully executed
21:05:40:568 [accMessi]: Script Dresser.sc stopped successfuly
я накидал рабочий пример, работы с инистрокой которая не строкой а сразу интегером получается...
разбирая твой скрипт у меня появилось пара идей как бы его написать покороче...
Hrenik
Neophyte
Neophyte
Posts: 16
Joined: 22.12.2013 10:11

Re: Самопальный вариант одевания одежды

Post by Hrenik »

ндаа драбадан, чуствую надо было консилиум сразу как ты предложил проводить. Скрипт в итоге работает более чем хорошо.

Code: Select all

Program Dresser;

const
FilePath = 'c:\';

var
Layer : array[1..20] of Byte;
a,LID : integer;


procedure ScanLayer;
var
f : TIniFile;
begin
  a := 0;
  f := TIniFile.Create(FilePath + 'SavedDress' + '.ini');
  try
    for a:= 1 to 20 do
    Begin
      AddToSystemJournal(IntToStr(a) +' Layer: ' +IntToStr(ObjAtLayer(Layer[a]) ));
      f.WriteInteger(Charname, 'Layer'+IntToStr(a), ObjAtLayer(Layer[a]));
    end;
    finally
    f.Free;
  end;
  AddToSystemJournal('DressLayer scanned');
end;

procedure DressLayer;
var
f : TIniFile;

begin
  a := 0
  f := TIniFile.Create(FilePath + 'SavedDress' + '.ini');
  try
    for a:= 1 to 20 do
    Begin
      LID := f.ReadInteger(Charname, 'Layer'+IntToStr(a), 0);
      //if LID = 0 then AddToSystemJournal('No Cloth on LayerNr: '+intToStr(a));
      if not (WearItem(Layer[a], LID)) and (LID >0)  then Equip(Layer[a], LID);
      wait(700);
    end;
    finally
    f.Free;
  end;
end;

BEGIN

  Layer[1] := RhandLayer;
  Layer[2] := LhandLayer;
  Layer[3] := ShoesLayer;
  Layer[4] := PantsLayer;
  Layer[5] := ShirtLayer;
  Layer[6] := HatLayer;
  Layer[7] := GlovesLayer;
  Layer[8] := RingLayer;
  Layer[9] := TalismanLayer;
  Layer[10] := NeckLayer;
  Layer[11] := WaistLayer;
  Layer[12] := TorsoLayer;
  Layer[13] := BraceLayer;
  Layer[14] := TorsoHLayer;
  Layer[15] := EarLayer;
  Layer[16] := ArmsLayer;
  Layer[17] := CloakLayer;
  Layer[18] := RobeLayer;
  Layer[19] := EggsLayer;
  Layer[20] := LegsLayer;

  ScanLayer;
  DressLayer;

end.
можно конечно ещё отшлифовать, но изначально задуманные действия производятся на ура.
Благодарю.


З.Ы. предпочтительней наверное каждому чару свой ини файл предоставлять чтоб коллизий никаких не было при многократно запущенном скрипте?
drabadan
Expert
Expert
Posts: 730
Joined: 13.12.2012 17:35
Contact:

Re: Самопальный вариант одевания одежды

Post by drabadan »

Code: Select all

f := TIniFile.Create(FilePath + 'SavedDress' + '.ini');
-->

Code: Select all

f := TIniFile.Create(FilePath + 'SavedDress_' + CharName + '.ini');
типа так?

Очень рад, что тебе пригодилось!
Захочется еще консультаций пиши в аську, буду рад помочь!
Post Reply