Ошибка 201 паскаль - Исправление ошибок и поиск оптимальных решений проблем

I have tried to make a simple snake game with Free Pascal, when I started the programme, it drew the map exactly what I want but after that, I pressed the button that I have set to control the snake and it exited with exit code 201.

I don’t know much about that exit code, could you explain me the problems of the programme? This is the longest program I have ever made with Pascal.

Here is the code:

    uses crt;

    type 
      ran=record
        x:byte;
        y:byte;
      end;

    var 
      f:ran;
      s:array[1..1000] of ran;
      i,j:longint;
      st,l:byte;

    function getkey:integer;
    var 
      k:integer;
    begin
      k:=ord(readkey);
      if k=0 then k:=-ord(readkey);
      getkey:=k;
    end;

    procedure fa;
    begin
      randomize;
      f.x:=random(98)+1;
      f.y:=random(23)+1;
      gotoxy(f.x,f.y);
      writeln('o');
    end;

    procedure draw;
    begin
      gotoxy(1,1);
      st:=1;
      for i:=1 to 25 do begin
        for j:=1 to 100 do write('X');
        writeln
      end;
      gotoxy(st+1,st+1);
      for i:=1 to 23 do begin
        for j:=1 to 98 do write(' ');
        gotoxy(st+1,i+2);
      end;
    end;

    procedure sts;
    begin
      s[1].x:=19;
      s[1].y:=6;
      gotoxy(s[1].x,s[1].y);
      writeln('@');
    end;

    procedure fa1;
    begin
      f.x:=29;
      f.y:=5;
      gotoxy(f.x,f.y);
      writeln('o');
    end;

    procedure eat;
    begin
      if (s[1].x=f.x) and (s[1].y=f.y) then begin
        l:=l+1;
        fa;
      end;
    end;

    function die:boolean;
    begin
      die:=false;
      if (s[1].x=1) or (s[1].x=100) or (s[1].y=1) or (s[1].y=25) then 
        die:=true;
      if l>=5 then
        for i:=5 to l do
          if (s[1].x=s[i].x) and (s[1].y=s[i].y) then 
            die:=true;
    end;

    procedure up;
    begin
      for i:=l downto 2 do begin
        s[i].y:=s[i-1].y;
        gotoxy(s[i].x,s[i].y);
        writeln('+');
      end;
      gotoxy(s[l].x,s[l].y+1);
      writeln(' ');
      s[1].y:=s[1].y-1;
      gotoxy(s[1].x,s[1].y);
      writeln('@');
    end;

    procedure down;
    begin
      for i:=l downto 2 do begin
        s[i].y:=s[i-1].y;
        gotoxy(s[i].x,s[i].y);
        writeln('+');
      end;
      gotoxy(s[l].x,s[l].y-1);
      writeln(' ');
      s[1].y:=s[1].y+1;
      gotoxy(s[1].x,s[1].y);
      writeln('@');
    end;

    procedure left;
    begin
      for i:=l downto 2 do begin
        s[i].x:=s[i-1].x;
        gotoxy(s[i].x,s[i].y);
        writeln('+');
      end;
      gotoxy(s[l].x+1,s[l].y);
      writeln(' ');
      s[1].x:=s[1].x-1;
      gotoxy(s[1].x,s[1].y);
      writeln('@');
    end;

    procedure right;
    begin
      for i:=l downto 2 do begin
        s[i].x:=s[i-1].x;
        gotoxy(s[i].x,s[i].y);
        writeln('+');
      end;
      gotoxy(s[l].x-1,s[l].y);
      writeln(' ');
      s[1].x:=s[1].x+1;
      gotoxy(s[1].x,s[1].y);
      writeln('@');
    end;

    procedure auto(k:integer);
    begin
      case k of
        -72:up;
        -80:down;
        -75:left;
        -77:right;
        119:up;
        115:down;
        97:left;
        100:right;
      end;
    end;

    procedure ingame(t:integer);
    var 
      d,e:boolean;
    begin
      repeat
        auto(t);
        d:=die;
        if d=true then exit;
        eat;
      until (keypressed);
      if keypressed then t:=getkey;
      case t of
        -72:up;
        -80:down;
        -75:left;
        -77:right;
        119:up;
        115:down;
         97:left;
        100:right;
      end;
      eat;
      d:=die;
      if d=true then exit;
    end;

    procedure first;
    var
      k:integer;
    begin
      draw;
      fa1;
      sts;
      if keypressed then k:=getkey;
      ingame(k);
    end;

    BEGIN
      clrscr;
      first;
      readln
    END.

Источник

Hello I have been given the task of reading file input of 3 digit month abbreviations and a day and I must calculate the Julian date for each (sum of days since jan 1)
No matter what I do when I add two INTEGERS I get error 201 (incompatible data types). I have tried making a new program and gotten it to work but once I implement it into my existing code it doesn’t work anymore. This is very frustrating, please help. I’m sick of this stupid class making me take this language where I can’t find shit online to help.
Here is the code:

program prg6_150;
const
      MONABV:array[1..12] of string[03] = ('JAN','FEB','MAR','APR','MAY','JUN',
                                           'JUL','AUG','SEP','OCT','NOV','DEC');
      MONDAYS:array[1..12] of integer = (31,28,31,30,31,30,31,31,30,31,30,31);

var
      more_rec:Boolean;                    { EOF flag }
      DAY:integer;                         { input day }
      MONTH:string[03];                    { input month abbreviation }
      JULIAN:integer;                      { computed Julian day }
      ch:char;                             { spacer character for input }
      FileIn:Text;
      FileOut:Text;

{ your module, to be called "JULIAN_DAY" inserted here }


    procedure JULIAN_DAY;
    var
    j,sum_days:integer;
    begin
    j := 0;
    sum_days := 0;
    if MONTH = 'JAN' then j := 1 else
    if MONTH = 'FEB' then j := 2 else
    if MONTH = 'MAR' then j := 3 else
    if MONTH = 'APR' then j := 4 else
    if MONTH = 'MAY' then j := 5 else
    if MONTH = 'JUN' then j := 6 else
    if MONTH = 'JUL' then j := 7 else
    if MONTH = 'AUG' then j := 8 else
    if MONTH = 'SEP' then j := 9 else
    if MONTH = 'OCT' then j := 10 else
    if MONTH = 'NOV' then j := 11 else
    if MONTH = 'DEC' then j := 12; 
    for J:= 2 to 12 do
    repeat
        sum_days := MONDAYS[1] + sum_days;
        j := j - 1
    until j = 1;
    Julian := DAY + sum_days;
    end;

    procedure read_rec;
    begin
      if Eof(FileIn) then
        more_rec := False
      else
        readln(FileIn,day,ch,month)
    end;  { read_rec }

    procedure initialize;
    begin
      more_rec := True;
      Assign(FileIn,'JULIAN.DAT');
      Reset(FileIn);
      Assign(FileOut,'JULIAN.OUT');
      Rewrite(FileOut);
      read_rec
    end;  { initialize }

    procedure process;
    begin
      Julian_Day;
      writeln(FileOut,day:2,' ',month,' ',julian:3);
      read_rec
    end;  { process }

    procedure wrapup;
    begin
      Close(FileOut);
      Close(FileIn)
    end;  { wrapup }

    begin  { main }
      initialize;
      while more_rec do
        process;
      wrapup
    end.

Command Prompt Error

Источник

program prg6_150;
const
      MONABV:array[1..12] of string[03] = ('JAN','FEB','MAR','APR','MAY','JUN',
                                           'JUL','AUG','SEP','OCT','NOV','DEC');
      MONDAYS:array[1..12] of integer = (31,28,31,30,31,30,31,31,30,31,30,31);

var
      more_rec:Boolean;                    { EOF flag }
      DAY:integer;                         { input day }
      MONTH:string[03];                    { input month abbreviation }
      JULIAN:integer;                      { computed Julian day }
      ch:char;                             { spacer character for input }
      FileIn:Text;
      FileOut:Text;

{ your module, to be called "JULIAN_DAY" inserted here }


    procedure JULIAN_DAY;
    var
    j,sum_days:integer;
    begin
    j := 0;
    sum_days := 0;
    if MONTH = 'JAN' then j := 1 else
    if MONTH = 'FEB' then j := 2 else
    if MONTH = 'MAR' then j := 3 else
    if MONTH = 'APR' then j := 4 else
    if MONTH = 'MAY' then j := 5 else
    if MONTH = 'JUN' then j := 6 else
    if MONTH = 'JUL' then j := 7 else
    if MONTH = 'AUG' then j := 8 else
    if MONTH = 'SEP' then j := 9 else
    if MONTH = 'OCT' then j := 10 else
    if MONTH = 'NOV' then j := 11 else
    if MONTH = 'DEC' then j := 12; 
    for J:= 2 to 12 do
    repeat
        sum_days := MONDAYS[1] + sum_days;
        j := j - 1
    until j = 1;
    Julian := DAY + sum_days;
    end;

    procedure read_rec;
    begin
      if Eof(FileIn) then
        more_rec := False
      else
        readln(FileIn,day,ch,month)
    end;  { read_rec }

    procedure initialize;
    begin
      more_rec := True;
      Assign(FileIn,'JULIAN.DAT');
      Reset(FileIn);
      Assign(FileOut,'JULIAN.OUT');
      Rewrite(FileOut);
      read_rec
    end;  { initialize }

    procedure process;
    begin
      Julian_Day;
      writeln(FileOut,day:2,' ',month,' ',julian:3);
      read_rec
    end;  { process }

    procedure wrapup;
    begin
      Close(FileOut);
      Close(FileIn)
    end;  { wrapup }

    begin  { main }
      initialize;
      while more_rec do
        process;
      wrapup
    end.

Command Prompt Error

Источник

program  simplecs;
type mas=array[1..100] of real;
     mas1=array[1..100] of integer;
     label 2, 3, 10;
     var
         r,s,t,a,u,x,xk:mas;
         nb:mas1;
        i,l,k,z1,mi,m1,ni,ne,ip,m,n:integer;
         eps,tmin,teta:real;
procedure sol00(r,s,t:mas;var a,x:mas; n,m:integer);
   var k1,k2,k3,j,mj,l,i:integer;
   BEGIN
       l:=m-2;
   for j:=1 to n do
   begin
   mj:=m*j;
   a[mj]:=0;
   for i:=1 to l do
   begin
   k1:=m*(j-1)+i;
   k2:=l*(j-1)+i;
   a[k1]:=r[k2];
   a[mj]:=a[mj]-r[k2];
   end;
   end;
   for i:=1 to n do
   begin
   k3:=m*i-1;
   a[k3]:=t[i];
   end;
   x[m-1]:=0;
   x[m]:=0;
   for i:=1 to l do
   begin
   x[i]:=s[i];
   x[m]:=x[m]-x[i];
end;END;
 procedure sol01(var u:mas;m:integer);
 var i,j,l:integer;
    BEGIN
    for j:=1 to m do
    for i:=1 to m do
    begin
      l:=m*(j-1)+i;
      u[l]:=0;
      if (i-j)=0 then
      u[l]:=1;
      end;
      END;
  procedure sol02(u,a:mas;m,n,j:integer;var del:real);
  var i,im,ij:integer;
  begin
  del:=0;
  for i:=1 to m do
  begin
  im:=i*m;
  ij:=m*(j-1)+i;
  del:=del+u[im]*a[ij];
  end;
  EnD;
  procedure sol03(var tmin:real;a,u:mas;nb:mas1;m,n:integer;var k:integer);
               var  bul,i,j,m1:integer;
               del:real;
     begin
     tmin:=0;
     m1:=m-2;
     for j:=1 to n do
     begin
    bul:=1;
    i:=1;
    while (bul=1) and (i<=m1) do
    if (j-nb[i])=0  then bul:=2
    else
    i:=i+1;
    if bul<>2 then
    begin
    sol02(u,a,m,n,j,del);
    if (del-tmin)<=0 then
    begin
    tmin:=del;
    k:=j;
    end;
    end;
    end;
    end;
    procedure sol04(u,a:mas;m,n,k:integer;var xk:mas);
    var
        ij,jk,i,j:integer;
      begin
     for i:=1 to m do
     begin
     xk[i]:=0;
     for j:=1 to m do
     begin
     ij:=m*(j-1)+i;
     jk:=m*(k-1)+j;
     xk[i]:=xk[i]+u[ij]*a[jk];
     end;
     end;
     end;
 procedure sol05(x,xk:mas;m:integer;var l:integer;var teta:real;eps:real);
 var
    i,m1:integer;
    r:real;
  begin
    teta:=10000;
    m1:=m-2;
     for i:=1 to m1 do
     if(xk[i]-eps)>=0 then
     begin
     r:=x[i]/xk[i];
    if (r-teta)<=0 then
    begin
    teta:=r;
    l:=i;
    end;
    end;
    end;
  procedure sol06(var x,xk:mas;m,l:integer;var teta:real);
  var i:integer;
  begin
    for i:=1 to m do begin
    If (i-l)<>0 then
    x[i]:=x[i]-teta*xk[i]
    else
    x[i]:=teta;
    end;
    end;
  procedure sol07(var u:mas;m,l:integer;xk:mas);
  var
        m1,j,lj,i,ij:integer;
       begin
    m1:=m-2;
    for j:=1 to m1 do
    begin
    lj:=m*(j-1)+l;
    u[lj]:=u[lj]/xk[l];
    end;
    for i:=1 to m do
    for j:=1 to m1 do
    if (i-l)<>0 then
    begin
    ij:=m*(j-1)+i;
    lj:=m*(j-1)+l;
    u[ij]:=u[ij]-u[lj]*xk[i];
    end;
    end;
  procedure sol08(u,a:mas;m,j:integer;var del:real);
  var mi,ij,i:integer;
  begin
  del:=0;
    for i:=1 to m do
    begin
    mi:=m*i-1;
    ij:=m*(j-1)+i;
    del:=del+u[mi]*a[ij];
    end;
    end ;
 procedure sol09(var tmin:real;var k:integer;a,u:mas;nb:mas1;m,n:integer);
 var bul,m1,i,j:integer;
     del:real;
   begin
   tmin:=0;
   m1:=m-2;
   for j:= 1 to n do
   begin
   bul:=1;
   i:=1;
   while (bul=1)  and (i<=m1) do
   if (j-nb[i])=0 then
   bul:=2
   else
   i:=i+1;
   if bul<>2 then
   begin
   sol08(u,a,m,j,del);
   if (del-tmin)<=0 then
   begin
   tmin:=del;
   k:=j;
   end;
   end;
   end;
   end;
procedure sol10(var tmin:real;u,a:mas;nb:mas1;m,n:integer;var k:integer;
eps:real);
 var bul,m1,i,j:integer;
   del,del1:real;
   begin
       tmin:=0;
       m1:=m-2;
    for j:=1 to n do
      begin
        bul:=1;
        i:=1;
     while (bul=1) and (i<=m1) do
         if (j-nb[i])=0 then
           bul:=2
           else
     i:=i+1;
     if bul<>2 then
     begin
     sol02(u,a,m,n,j,del);
     sol08(u,a,m,j,del1);
     if (abs(del1)-eps)<=0 then
     if (del-tmin)<=0 then
     begin
     tmin:=del;
     k:=j;
     end;
     end;
     end;
     end;
BEGIN
  write(' n');
  read(n);
  writeln('m');readln(m);
  writeln(' (eps)=>');read(eps);
  writeln('ip(ip=1 if MAKS;ip=0 if MIN )=>');
  read(ip);
  for i:=1 to n do
  begin
    writeln('t[',i, ']= ');
    read(t[i]);
    end;
  for i:=1 to m-2 do
  begin
  writeln('s[',i, ']= ');
  read(s[i]);
  end;
  for i:=1 to (m-2)*n do
  begin
   writeln('r[',i, ']= ' );
  read(r[i]);end;
  sol00(r,s,t,a,x,n,m);
  if (ip-1)=0 then
  for i:=1 to n do
  begin
   mi:=m*i-1;
   a[mi]:=-a[mi];
 end;
   sol01(u,m);
   m1:=m-2;
   for i:=1 to m1 do
   nb[i]:=100011+i;
   ni:=0;
   ne:=1;
3:sol03(tmin,a,u,nb,m,n,k);
2:if (tmin+eps)>=0 then
   if (ne)=1 then
   if (x[m]+eps)>=0 then
   begin
   ne:=2;
   for i:=1 to m1 do
   if (nb[i]-10000)>0 then
   ne:=3 ;
   if ne=3 then
   begin
   sol10(tmin,u,a,nb,m,n,k,eps);
    goto 2;
    end  else
    begin
    sol09(tmin,k,a,u,nb,m,n);
    goto 2;
    end;end else
    begin
    ip:=2;
    goto 10;
    end
    else
    if (ip-1)<>0 then
    begin
    x[m-1]:=-x[m-1];
    ip:=1;
    goto 10;
    end
    else
    begin
    ip:=1;
    goto 10;
    end
    else
    begin
    sol04(u,a,m,n,k,xk);
    sol05(x,xk,m,l,teta,eps);
    if (teta+5-10000)<0 then
    begin
    sol06(x,xk,m,l,teta);
    sol07(u,m,l,xk);
    nb[l]:=k;
    ni:=ni+1;
    if ne<>1 then
    if ne=2 then
    begin
    sol09(tmin,k,a,u,nb,m,n);
    goto 2;
    end
    else
    begin
    sol10(tmin,u,a,nb,m,n,k,eps);
    goto 2;
    end
    else
    goto 3;end
     else
     begin
     ip:=3;
     goto 10;
     end; end;
10:  writeln('ip=',ip);
 if ip=1 then begin
    for i:=1 to m-2 do
        writeln('x[', nb[i], ']=',x[i]:13);
        for i:=1  to m-2  do
        writeln('nb[',i,']=',nb[i]);end;
        writeln('f=', x[m-1]:13);
        readln; readln;readln;
END.

Источник

Pascal. Ошибка в программе. Exitcode = 201., При работе с текстовым файлом

	27.08.2013 0:32 Сообщение #1
Группа: Пользователи Сообщений: 6 Пол: Мужской Реальное имя: Александр Репутация: 0	Здравствуйте, уважаемые программисты, администраторы, пользователи и т.д. Суть программы: меню для игры. Столкнулся с Exitcod’ом 201. Вылет происходит при использовании цикла чтения из текстового файла и присваивания строк файла массиву. Что-то я делаю явно не так, вопрос — что? Собственно, ниже код. Прошу прощения, если форматирование текста кода не является удобночитаемым. Пишу на Free Pascal, желательно, чтобы программа компилировалась и на Borland Pascal 7.0. Благодарю за внимание. Спойлер (Показать/Скрыть) Сообщение отредактировано: SaheR — 27.08.2013 0:35

Ромаха	28.08.2013 12:47 Сообщение #2
Новичок Группа: Пользователи Сообщений: 26 Пол: Мужской Реальное имя: Роман Репутация: 0	Добрый день. Для начала стоит освежить знания о Run-time errors. А точнее вспомнить что ж за зверь такой 201 и с чем его едят.. 201 Range check error If you compiled your program with range checking on, then you can get this error in the following cases: An array was accessed with an index outside its declared range. Trying to assign a value to a variable outside its range (for instance an enumerated type). То есть выход за пределы. Начать нужно с того, что или Вы даете нам какой-нить уровень (чтобы не было exitcode = 2). Или Вы пошагово пытаетесь выйти на ошибку.. Удачи!

SaheR	28.08.2013 18:52 Сообщение #3
Группа: Пользователи Сообщений: 6 Пол: Мужской Реальное имя: Александр Репутация: 0	Цитата(Ромаха @ 28.08.2013 11:47) Добрый день. Для начала стоит освежить знания о Run-time errors. А точнее вспомнить что ж за зверь такой 201 и с чем его едят.. 201 Range check error If you compiled your program with range checking on, then you can get this error in the following cases: An array was accessed with an index outside its declared range. Trying to assign a value to a variable outside its range (for instance an enumerated type). То есть выход за пределы. Начать нужно с того, что или Вы даете нам какой-нить уровень (чтобы не было exitcode = 2). Или Вы пошагово пытаетесь выйти на ошибку.. Удачи! Спасибо за напоминание, но я написал сюда уже от беспомощности т.к. и не нашёл, где происходит выход за пределы массива. Файл level.txt должен содержать просто названия уровней, которые уже в будущем будут загружаться из одноимённых файлов. Собственно, из-за gotoxy(7, i*2); в этом файле должно быть не более 12 строк. На данный момент, у меня в этом файле находится всего четыре строчки, в каждой по одному слову(если нужно, уточню — в английской раскладке). Когда впервые с этой ошибкою встретился в данном коде, то даже массив arrlevels сделал с индексами от 1 до 150. Благодарю за пожелание удачи :3

SaheR	28.08.2013 19:19 Сообщение #4
Группа: Пользователи Сообщений: 6 Пол: Мужской Реальное имя: Александр Репутация: 0	Всё, ошибку свою нашёл. Вместо readln, при чтении с файла, использовал read.

1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)

Пользователей: 0

Связь с администрацией: bu_gen в домене octagram.name

Источник

Дарова Всем)

Столкнулся с теоретически невозможной ошибкой (!=) округления Real-дробного числа
на таком участке кода:

         drwX1:=round(X1); drwX2:=round(X2);
         drwY1:=round(Y1); drwY2:=round(Y2);

где эти переменные объявлены как:

var
  X1,Y1,X2,Y2: Real;
  drwX1,drwY1,drwX2,drwY2:Integer;

Ошибка происходит на участке

{
 
}        drwX1:=round(X1); drwX2:=round(X2);
         drwY1:=round(Y1); drwY2:=round(Y2); {
при попытке округлить X1:real до Integer`а  }

И описыается справкой как:

>> 201: Ошибка Проверки диапазона
>> 201: Range Check Error

Являющаяся ошибкой во время выполнения.
Появляется в случаях когда
1) Индекс Массива вне диапазона
2) Назначение Переменной значения вне её диапазона
3) Передача Функции значения вне её диапазона

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

Вступление:
Пишу Игру.
X1,Y1 и X2,Y2 = это реальные координаты объекта в игре
DrwX1,DrwY1 и DrwX2,DrwY2 = это округленные те же координаты, только округленные.
Используются как параметры для отрисовки объекта на экране.

Реальные координаты (X1,Y1 и X2,Y2) раз в 100мс меняются на значение скорости.
Иксы — смещаются на горизонтальную скорость hspeed,
Игреки — на вертикальную скорость vspeed

var
    hspeed, vspeed:Real;
...
 
     X1:=X1 + hspeed; X2:= X2 + hspeed;
     Y1:=Y1 - vspeed; Y2:= Y2 - vspeed;

Чтобы Объект на своем пути сталкивался с другими объектами, а не перскакивал сразу через 24 пикселя —
Я ввел код Пошагового Передвижения.

                           stp_count:= MaxInt( Ceil_Round(abs(hspeed)) , Ceil_Round(abs(vspeed)) );
                           if (stp_count=0) then
 
                           h_chg:=hspeed/stp_count;
                           v_chg:=vspeed/stp_count;
                           {FOR}
                           for stp:=1 to stp_count do begin
 
                               If not Collision_Place
                               (Objects.pointer[obj], X1+h_chg,Y1+v_chg,X2+h_chg,Y2+v_chg, [PhT_Solid], DefNeighbors)
                               then begin
                                      X1:=X1 + h_chg;
                                      X2:=X2 + h_chg;
                                      Y1:=Y1 + v_chg;
                                      Y2:=Y2 + v_chg;
                               end else break;
 
                           end; {step by step FOR ends}

После такого перемещения рассчитываются новые координаты(DrwX1,DrwY1 и DrwX2,DrwY2) в которых будет отрисован объект.

———————————————————-

Всё! Есть)))
Нашел ошибку!)))

Кусок Призрак попался)))
Я его вам выделил как красную строку:

{stp_count:= MaxInt( Ceil_Round(abs(hspeed)) , Ceil_Round(abs(vspeed)) );}
                           'if (stp_count=0) then'
 
                           h_chg:=hspeed/stp_count;
                           v_chg:=vspeed/stp_count;
                           {FOR}
                           for stp:=1 to stp_count do begin
 
                               If not Collision_Place
                               (Objects.pointer[obj], X1+h_chg,Y1+v_chg,X2+h_chg,Y2+v_chg, [PhT_Solid], DefNeighbors)
                               then begin
                                      X1:=X1 + h_chg;
                                      X2:=X2 + h_chg;
                                      Y1:=Y1 + v_chg;
                                      Y2:=Y2 + v_chg;
                               end else break;
 
                           end; {step by step FOR ends}

Всё)) Спасибо Всем Кто ПрочитаЛ)))
Для любознательных привожу Исходник Системы Передвижения))

 for obj:=1 to Objects.count do
  with (Objects.pointer[obj]^) do begin
 
  { MOVING }
 
   { PLAN }
     {save pos}
     {move}
     {check}
     {collide}
     {replace}
     {step by step}
   { PLAN ENDS }
     stp_count:= MaxInt( Ceil_Round(abs(hspeed)) , Ceil_Round(abs(vspeed)) );
     If stp_count=0 then continue;
      {save pos}
          X1prev:=X1;
          X2prev:=X2;
          Y1prev:=Y1;
          Y2prev:=Y2;
      {move}    {}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}{}
         X1:=X1 + hspeed; X2:= X2 + hspeed;
         Y1:=Y1 - vspeed; Y2:= Y2 - vspeed;

      {check}
         if Collision_Place(Objects.pointer[obj],X1,Y1,X2,Y2,[PhT_solid],DefNeighbors) then begin
                 {collide with Every Neighbour}
                     for col_i:=1 to Objects.Count do if (col_i in DefNeighbors) then
                     Collide_objects(Objects.pointer[obj],Objects.pointer[col_i]);
 
                  {replace}             {to a Start Position}
                           X1:=X1prev;
                           X2:=X2prev;
                           Y1:=Y1prev;
                           Y2:=Y2prev;
 
                  {step by step}
                           {stp_count:= MaxInt( Ceil_Round(abs(hspeed)) , Ceil_Round(abs(vspeed)) );}
{                           if (stp_count<>0) then begin}
 
                           h_chg:=hspeed/stp_count;
                           v_chg:=vspeed/stp_count;
                           {FOR}
                           for stp:=1 to stp_count do begin
 
                               If not Collision_Place
                               (Objects.pointer[obj], X1+h_chg,Y1+v_chg,X2+h_chg,Y2+v_chg, [PhT_Solid], DefNeighbors)
                               then begin
                                      X1:=X1 + h_chg;
                                      X2:=X2 + h_chg;
                                      Y1:=Y1 + v_chg;
                                      Y2:=Y2 + v_chg;
                               end else break;
 
                           end; {step by step FOR ends}
 
         end; {IF collision ends}
 
      {draw}
 
         drwX1:=round(X1); drwX2:=round(X2);
         drwY1:=round(Y1); drwY2:=round(Y2);
...
end; {WITH ends}

Если будут вопросы -пишите в личку
Поки)

———————————————————-

Щас еще скольжение Тела вдоль Соседних физических объектов при невозможности переместится на их положение пропишу))

Вообще класс будет =))

А Потом Экзешку выложу)))
Отпразднуем!)))

Код к задаче: «201: Ошибка Проверки диапазона»

Источник