Динамические массивы объектов, проблема с перекрестной индексацией.

[Василиск]

Есть некий код волнового алгоритма работает хорошо если бы не одно НО, в процессе поиска пути непонятно из-за чего нарушется индексация объектов.
Вот код.

var
x,y,x2,y2,i,j,maxsteps,lengthwave:integer;
ss,sl,ss2,sl2:integer;
bbb:integer;
www:integer;
  begin
  //If cper=76 then MainUNit.ShowMessage('Давай'+IntToStr(id)+' индекс поиска'+IntToStr(s));
  bbb:=id;
  lengthwave:=1;
  if MainUnit.Dots[id].Energy div MainUnit.Dots[id].Stats[5]>20 then maxsteps:=20 else maxsteps:=MainUnit.Dots[id].Energy div MainUnit.Dots[id].Stats[5];
  if maxsteps>100-MainUnit.Dots[id].Age then maxsteps:=100-MainUnit.Dots[id].Age;
  for x:=1 to 40 do
  for y:=1 to 40 do
    WaysMap[x,y]:=maxsteps;
  WaysMap[MainUnit.Dots[id].X,MainUnit.Dots[id].Y]:=0;
  ss:=0;
  sl:=1;
  way[1,0].x:=MainUnit.Dots[id].X;
  way[1,0].y:=MainUnit.Dots[id].Y;
  www:=1;
  repeat
    ss2:=1000-ss;
    sl2:=0;
    for i:=0 to sl-1 do
      begin
      x:=way[1,ss+i].x;
      y:=way[1,ss+i].y;
      for j:=1 to 4 do
        begin
        x2:=ConversionXY(x+dx[j]);
        y2:=ConversionXY(y+dy[j]);
        if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 1'+IntToStr(CPer)+' '+IntToStr(id));//ТУТ ВСЕ ГУД
        if (CheckTarget(x2,y2,s,id)=True)and((lengthwave<=maxsteps)) then
          begin
          Go(x2,y2,lengthwave,id,s);
          exit;
        end;
        if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 3'+IntToStr(CPer)+' '+IntToStr(id));//А ВОТ ТУТ УЖЕ НЕТ
        if (CheckWay(x2,y2,id)=True) and (MainUnit.WaysMap[x2,y2]>lengthwave) then
          begin
          way[1,ss2+sl2].x:=x2;
          way[1,ss2+sl2].y:=y2;
          inc(sl2);
          WaysMap[x2,y2]:=lengthwave;
        end;
      end;
    end;
    ss:=ss2;
    sl:=sl2;
    inc(lengthwave);
  until sl=0;

Прошу помочь в нахождении ошибки, уже месяц бьюсь, уже хочу руки наложить, то ли на себя то ли на машину.
PS - Delphi 7

[Василиск]

Продолжение кода...

function CheckTarget(x,y,s,id:integer):Boolean;
var
j,i,k:integer;
  begin
  Result:=False;
  //Еда
  if s=1 then
    begin
    if MainUnit.Map[x,y].TypeBlock>=3 then
      Result:=True
    else exit;
  end;
  //Партнер для размножения
  if s=2 then
    begin
    if MainUnit.Map[x,y].TypeObject=1 then
    if MainUnit.Dots[MainUnit.Map[x,y].IdObjects[0]].ColorDot=MainUnit.Dots[id].ColorDot then
    for j:=0 to MainUnit.Map[x,y].LengthIdObjects-1 do
      begin
      if (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Stats[6]-MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Motivation[1] div 20<MainUnit.Dots[id].Stats[6])and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Eat=False)and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Work=-1)and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Id<>id)then
        begin
        NewWork(id,1);
        SearchWork(MainUnit.Map[x,y].IdObjects[j],LengthArrWorks-1);
        Result:=True;
        exit;
      end;
    end;
  end;
  if Length(IntToStr(s))>=2 then
    begin
    if StrToInt(Copy(IntToStr(s),1,1))=1 then
      begin
      for j:=0 to MainUnit.Map[x,y].LengthIdObjects-1 do
        begin
        if MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].ID=StrToInt(Copy(IntToStr(s),2,Length(IntToStr(s)))) then
          begin
          Result:=True;
          exit;
        end;
      end;
    end;
  end;
end;

[asmodey1]

Что за процедуры ?

NewWork(id,1);
SearchWork(MainUnit.Map[x,y].IdObjects[j],LengthArrWorks-1);

В них и портятся ваши индексы, поскольку эта связка:

if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 1'+IntToStr(CPer)+' '+IntToStr(id));//ТУТ ВСЕ ГУД
{if (CheckTarget(x2,y2,s,id)=True)and((lengthwave<=maxsteps)) then
begin
Go(x2,y2,lengthwave,id,s);
exit;
end;}
CheckTarget(x2,y2,s,id);
if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 3'+IntToStr(CPer)+' '+IntToStr(id));//А ВОТ ТУТ УЖЕ НЕТ

Вроде бы иначе никак не может ничего подпортить...

З.Ы. Прежде чем накладывать на себя руки или начинать кусаться, приложите еще немного усилий и сообщите, какие индексы портятся, как портятся...
Уже поздно и все экстрасенсы спят...

[Василиск]

procedure NewWork(p,t:integer);
var
i,k:integer;
  begin
  if MainUnit.Dots[p].ColorDot=1 then CBlueWorks:=CBlueWorks+1 else CRedWorks:=CRedWorks+1;
  LengthArrWorks:=LengthArrWorks+1;
  SetLength(Works,LengthArrWorks);
  MainUnit.Works[LengthArrWorks-1]:=TVWork.Create;
  MainUnit.Dots[p].Work:=LengthArrWorks-1;
  MainUnit.Works[LengthArrWorks-1].TypeWork:=t;
  MainUnit.Works[LengthArrWorks-1].Id:=LengthArrWorks-1;
  //Ðàçìíîæåíèå
  if t=1 then
    begin
    MainUnit.Works[LengthArrWorks-1].LengthWorkers:=1;
    SetLength(MainUnit.Works[LengthArrWorks-1].Workers,MainUnit.Works[LengthArrWorks-1].LengthWorkers);
    MainUnit.Works[LengthArrWorks-1].Workers[0]:=p;
    MainUnit.Works[LengthArrWorks-1].TimeWork:=3;
    MainUnit.Works[LengthArrWorks-1].ResultWork:=1;
  end;
end;

procedure SearchWork(p,id:integer);
  begin
  MainUnit.Dots[p].Work:=id;
  MainUnit.Works[id].LengthWorkers:=MainUnit.Works[id].LengthWorkers+1;
  SetLength(MainUnit.Works[id].Workers,MainUnit.Works[id].LengthWorkers);
  MainUnit.Works[id].Workers[MainUnit.Works[id].LengthWorkers-1]:=p;
end;

Объясню на пальцах параметр S это цель поиска при вызове процедуры проверяется индекс работы Work он должен быть равен -1 ("ГУТ") но в момент поиска этот индекс становится не -1 хотя когда идет присвоение процедура должна прерываться, на одном форуме весь исходник программы чел просмотрел, ответа так и не нашел я уже грешу на компилятор.
Вот объекты и переменные

  //Точка
  TVDot = class(TObject)
  Id:integer;//Индекс
  TypeDot:integer;//Тип
  ColorDot:integer;//Цвет
  X,Y:integer;//Координаты
.....
  Work:integer;//Ðàáîòà
  Eat:Boolean;//Ôàêòîð ïîèñêà ïèùè
  end;

//Работа
  TVWork = class(TObject)
  Id:integer;//Индекс
  TypeWork:integer;//Тип
  ResultWork:integer;//Результат
  TimeWork:integer;//Время работы
  LengthWorkers:integer;//Кол рабочих
  Workers:array of integer;//Рабочие
  end;

//Карта путей
  WaysMap:array[1..40,1..40] of integer;
  dy:array[1..4] of integer;
  dx:array[1..4] of integer;
  way:array[1..2,0..2000] of record x,y:integer end;

[Василиск]

Иными словами нерабочий объект ищет работу, в момент поиск становится рабочим и продолжает искать работу из-за этого утечка памяти, и выход за границы массива, если необходимо выложу весь код касаемый индексов, но ошибку вывел только тут путем вывода вот этой не точности по поводу работы и индекса поиска.

[asmodey1]

Ну, я ж вам показал - ваши строки //ТУТ ВСЕ ГУД и //А ВОТ ТУТ УЖЕ НЕТ абсолютно идентичны, за исключением номера шага.
А вот между ними у вас всегда выполняется функция CheckTarget(), в которой происходит вызов NewWork() и SearchWork().
То есть "поплыть" ваши индексы могут только в CheckTarget()...
Кстати, вы так и не сказали, какой индекс плывет - S ? Так это вроде и не индекс...
Ну так сделайте поиск по "S:=" и т.п., и проверьте все места, где он меняется.
Хотя, с другой стороны, я все просмотрел - эта переменная участвует только в операциях сравнения...
По шагам-то отлаживали ?
Может, у вас там еще и таймер какой-нибудь есть, по событию которого вызывается нечто, портящее индексы ?
А может, вы просто где-то допустили описку в имени переменной...

[Василиск]

Меняется индекс работы, но непонятно в каком месте он может измениться только при NeWWork, но при этом процедура должна завершиться exit, но почему то она либо продолжается либо я не знаю если посмотреть на проверочные условия то они одинаковы но последнее вообще не должно вызываться никогда.\
ККрасным помечен индекс который меняется с -1 на индекс работы.
Синим что ищем.

if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Øàã 3'+IntToStr(CPer)+' '+IntToStr(id));

if (CheckTarget(x2,y2,s,id)=True)and(lengthwave<=maxsteps) then
          begin
          Go(x2,y2,lengthwave,id,s);
          exit;
        end;
//Эта строчка по определению не может выполнятся если она не выполнялась до поиска цели, а она не выполнялась....МИСТИКА
       if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Øàã 3'+IntToStr(CPer)+' '+IntToStr(id));

Эта штука и вызывается по таймеру вернее вызывается цикл из которого вызывается эта чтука.
Сам объект id тотже проверял по всем параметрам.
Скажите пожалуйста хотябы что еще может на это повлиять...

[asmodey1]

MainUnit.Dots[id].Work у вас меняется в двух местах:
MainUnit.Dots[p].Work:=LengthArrWorks-1;
и
MainUnit.Dots[p].Work:=id;
Ставьте туда бряки и смотрите начальное значение и конечное...

[GunSmoker]

Рекомендую ещё включить опцию Range Check Errors и сделать проекту Build (не Compile).

Есть хороший шанс на переполнение буфера.

[Василиск]

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

Рекомендую ещё включить опцию Range Check Errors и сделать проекту Build (не Compile).

Есть хороший шанс на переполнение буфера.

А по подробнее к чему может привести переполнение буфера???