Важная информация
Показано с 1 по 7 из 7

Тема: Помогите разобраться с кодом Delphi...

  1. #1 Помогите разобраться с кодом Delphi... 
    Новичок
    Регистрация
    09.08.2022
    Сообщений
    6
    Сказал(а) спасибо
    0
    Поблагодарили 0 раз(а) в 0 сообщениях
    Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
    сетка 50 на 50 пикселей. Управление мышкой.
    Выдаёт ошибку: Range check error.

    Pascal Code:
    1. unit Unit1;
    2.  
    3. interface
    4.  
    5. uses
    6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
    8.  
    9. type
    10. TPers=record
    11. X,Y,Xn,Yn,Povorot,Anim,Speed,Current:integer;
    12. way:array of TPoint;
    13. end;
    14.  
    15.   TForm1 = class(TForm)
    16.     Timer1: TTimer;
    17.     Image1: TImage;
    18.     Timer2: TTimer;
    19.     procedure FormCreate(Sender: TObject);
    20.     procedure Timer1Timer(Sender: TObject);
    21.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
    22.       Shift: TShiftState; X, Y: Integer);
    23.     procedure Timer2Timer(Sender: TObject);
    24.   private
    25.     { Private declarations }
    26.   public
    27.     { Public declarations }
    28.   end;
    29.  
    30. var
    31.   Form1: TForm1;
    32.   Buf,Obj,ManImg: TBitmap;
    33.   Ground:array[0..1] of TBitmap;
    34.  
    35.   Predmet:array[1..2] of TBitmap;
    36.   Bild:array[1..2,1..3] of TBitmap;
    37.   Panel:array[0..2] of TBitmap;
    38.   Doo:array[1..3] of TBitmap;
    39.   Path:String;
    40.   map:array[0..9,0..9,0..4] of integer;
    41.   Pers:TPers;
    42.  
    43.  
    44.   procedure FindWay;
    45.  
    46. implementation
    47.  
    48. {$R *.dfm}
    49.  
    50. procedure TForm1.FormCreate(Sender: TObject);
    51. var
    52. i,j,n: integer;
    53. begin
    54. Path:=ExtractFileDir(Application.ExeName);
    55. Buf:=TBitmap.Create;
    56. Buf.Width:=640;
    57. Buf.Height:=640;
    58. //Obj
    59. Obj:=TBitmap.Create;
    60. Obj.Transparent:=true;
    61. Obj.LoadFromFile(path+'\img\w1.bmp');
    62. //ground
    63. for i:=0 to 1 do begin
    64. Ground[i]:=TBitmap.Create;
    65. Ground[i].LoadFromFile(path+'\img\'+inttostr(i)+'.bmp');
    66. end;
    67.  
    68. //Doo
    69. for i:=1 to 3 do begin
    70. Doo[i]:=TBitmap.Create;
    71. Doo[i].Transparent:=true;
    72. Doo[i].LoadFromFile(path+'\img\x'+inttostr(i)+'.bmp');
    73. end;
    74.  
    75. //panel
    76. for i:=0 to 2 do begin
    77. Panel[i]:=TBitmap.Create;
    78. Panel[i].TransparentColor:=clwhite;
    79. Panel[i].Transparent:=true;
    80. Panel[i].LoadFromFile(path+'\img\p'+inttostr(i)+'.bmp');
    81. end;
    82.  
    83. //man
    84.  
    85. ManImg:=TBitmap.Create;
    86. ManImg.Transparent:=true;
    87. ManImg.LoadFromFile(path+'\img\c11.bmp');
    88.  
    89. //Bild
    90. for i:=1 to 2 do begin
    91. for j:=1 to 3 do
    92. begin
    93. Bild[i,j]:=TBitmap.Create;
    94. Bild[i,j].Transparent:=true;
    95. Bild[i,j].LoadFromFile(path+'\img\q'+inttostr(i)+inttostr(j)+'.bmp');
    96. end;
    97. end;
    98.  
    99. for i:=0 to 9 do
    100. for j:=0 to 9 do
    101. for n:=0 to 4 do
    102. begin
    103. if n=0 then map[i,j,n]:=1
    104. else map[i,j,n]:=0;
    105. end;
    106.  
    107. map[3,3,0]:=0;
    108. map[4,3,0]:=0;
    109. map[5,3,0]:=0;
    110. //pers
    111. Pers.X:=0;
    112. Pers.Y:=0;
    113. Pers.Xn:=0;
    114. Pers.Yn:=0;
    115. Pers.Povorot:=1;
    116. Pers.Anim:=1;
    117. Pers.Speed:=2;
    118. Pers.Current:=-1;
    119.  
    120. end;
    121.  
    122. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
    123.   Shift: TShiftState; X, Y: Integer);
    124. begin
    125. Pers.Xn:=X;
    126. Pers.Yn:=Y;
    127. FindWay;
    128. end;
    129.  
    130. procedure TForm1.Timer1Timer(Sender: TObject);
    131. var i,j,n: integer;
    132. begin
    133.  
    134. if Pers.Current>-1 then
    135. begin
    136. if (Pers.Y+49) div 50 > Pers.Way[Pers.Current].Y then Pers.Y:=Pers.Y-1;
    137. if Pers.Y div 50 < Pers.Way[Pers.Current].Y then Pers.Y:=Pers.Y+1;
    138. if (Pers.X+49) div 50 > Pers.Way[Pers.Current].X then Pers.X:=Pers.X-1;
    139. if Pers.X div 50 < Pers.Way[Pers.Current].X then Pers.X:=Pers.X+1;
    140. if ((Pers.X div 50 = Pers.way[Pers.Current].X) and (Pers.Y div 50 = Pers.way[Pers.Current].Y)) and
    141. (((Pers.X+49) div 50=Pers.way[Pers.Current].X) and ((Pers.Y+49) div 50=Pers.way[Pers.Current].Y)) then inc(Pers.Current);
    142. if Pers.Current>length(Pers.way)-1 then Pers.Current:=-1;
    143.  
    144. end;
    145.  
    146. for i:=0 to 9 do
    147. for j:=0 to 9 do
    148. begin
    149. //ground
    150. Buf.Canvas.Draw(i*50,j*50,Ground[map[i,j,0]]);
    151. end;
    152.  
    153. for i:=1 to 6 do
    154. for j:=1 to 2 do
    155. begin//prorisovka persa
    156. Buf.Canvas.Draw(Pers.X,Pers.Y,ManImg);
    157. end;
    158. form1.Canvas.Draw(0,0,Buf);
    159. end;
    160.  
    161. procedure TForm1.Timer2Timer(Sender: TObject);
    162. begin
    163.  
    164. {if Image1.Top div 50>b div 50 then Image1.Top:=Image1.Top-1;
    165. if Image1.Top div 50<b div 50 then Image1.Top:=Image1.Top+1;
    166. if Image1.Left div 50>a div 50 then Image1.Left:=Image1.Left-1;
    167. if Image1.Left div 50<a div 50 then Image1.Left:=Image1.Left+1;}
    168. end;
    169.  
    170. procedure FindWay;
    171. var i,j,n: integer;
    172. begin
    173. for i:=0 to 9 do begin
    174. for j:=0 to 9 do
    175. begin
    176. if (map[i,j,0]>0) then map[i,j,4]:=0;
    177. if (map[i,j,0]=0) then map[i,j,4]:=-1;
    178. end;
    179. end;
    180.  
    181. map[Pers.X div 50,Pers.Y div 50,4]:=99;
    182.  
    183. if (Pers.X div 50-1>=0) and (map[Pers.X div 50-1,Pers.Y div 50,0]>0) then map [Pers.X div 50-1,Pers.Y div 50,4]:=1;
    184. if (Pers.X div 50+1<=9) and (map[Pers.X div 50+1,Pers.Y div 50,0]>0) then map [Pers.X div 50+1,Pers.Y div 50,4]:=1;
    185. if (Pers.Y div 50-1>=0) and (map[Pers.X div 50,Pers.Y div 50-1,0]>0) then map [Pers.X div 50,Pers.Y div 50-1,4]:=1;
    186. if (Pers.Y div 50+1<=9) and (map[Pers.X div 50,Pers.Y div 50+1,0]>0) then map [Pers.X div 50,Pers.Y div 50+1,4]:=1;
    187.  
    188. n:=1;
    189. while (n<=20) do
    190. begin
    191. for i:=0 to 9 do begin
    192. for j:=0 to 9 do
    193. begin
    194. if map[i,j,4]=n then
    195. begin
    196. if (i-1>=0) and (map[i-1,j,4]=0) then map[i-1,j,4]:=n+1;
    197. if (i+1<=9) and (map[i+1,j,4]=0) then map[i+1,j,4]:=n+1;
    198. if (j-1>=0) and (map[i,j-1,4]=0) then map[i,j-1,4]:=n+1;
    199. if (j+1<=9) and (map[i,j+1,4]=0) then map[i,j+1,4]:=n+1;
    200. end;
    201. end;
    202. end;
    203. inc(n);
    204. end;
    205. Setlength(Pers.way,map[Pers.Xn div 50,Pers.Yn div 50,4]);
    206.  
    207. Pers.way[map[Pers.Xn div 50,Pers.Yn div 50,4]-1].X:=Pers.Xn;
    208. Pers.way[map[Pers.Xn div 50,Pers.Yn div 50,4]-1].Y:=Pers.Yn;
    209.  
    210. Pers.Current:=length(Pers.way)-1;
    211. while (Pers.Current>0) do
    212. begin
    213. for i:=Pers.way[Pers.Current].X-1 to Pers.way[Pers.Current].X+1 do begin
    214. for j:=Pers.way[Pers.Current].Y-1 to Pers.way[Pers.Current].Y+1 do
    215. begin
    216. if map[i,j,4]=Pers.Current then
    217. begin
    218. Pers.way[Pers.Current-1].X:=i;
    219. Pers.way[Pers.Current-1].Y:=j;
    220. break;
    221. end;
    222. end;
    223. dec(Pers.Current);
    224. end;
    225. end;
    226.  
    227. Pers.Current:=0;
    228. end;
    229.  
    230.  
    231. end.
    Последний раз редактировалось >Quiet Snow<; 10.08.2022 в 22:59. Причина: Тег
    Ответить с цитированием  
     

  2. #2  
    Супер модератор Аватар для Kakos_nonos
    Регистрация
    07.01.2011
    Адрес
    Кубань
    Сообщений
    1,555
    Сказал(а) спасибо
    129
    Поблагодарили 439 раз(а) в 297 сообщениях
    Записей в блоге
    6
    В какой строке генерирует ошибку?
    Ответить с цитированием  
     

  3. #3  
    Новичок
    Регистрация
    09.08.2022
    Сообщений
    6
    Сказал(а) спасибо
    0
    Поблагодарили 0 раз(а) в 0 сообщениях
    Не знаю точно.
    Ответить с цитированием  
     

  4. #4  
    Супер модератор Аватар для >Quiet Snow<
    Регистрация
    11.04.2011
    Адрес
    Планета земля
    Сообщений
    4,601
    Сказал(а) спасибо
    2,002
    Поблагодарили 1,084 раз(а) в 939 сообщениях
    Записей в блоге
    1
    Волновые алгоритмы - это алгоритмы каскадной логики, на коленке за день не пишутся, инфа соточка.
    И тем не менее они самые простые из "путевых" и самые медленные, как правило нахдят минимальный маршрут.
    Для пары десятков юнитов - сгодятся, больше - уже нет. Всё что кроме этого - научная область.
    Можно колупать чужие исходники, но в сети не видел ничего путного на эту тему, в своё время перелистал
    страниц 10 гугла. Нормальных быстрых алгоритмов(без минимального пути, линейным способом) не нашёл.
    Советую найти алгоритм A* и если нужен прогрессивный его вариант рассмотреть эвристики к нему.
    Информации в гугле по нему полно.
    Обучение прикладному программированию(по skype), качественно, недорого, 18+, вопросы в личку.
    «Если вы ничего не сделаете, я уверяю вас, ничего и не произойдёт» © Жак Фреско
    Ограниченно модерирую.
    Ответить с цитированием  
     

  5. #5  
    Новичок
    Регистрация
    09.08.2022
    Сообщений
    6
    Сказал(а) спасибо
    0
    Поблагодарили 0 раз(а) в 0 сообщениях
    Ошибка здесь if map[i,j,4]=Pers.Current then
    Ответить с цитированием  
     

  6. #6  
    Новичок
    Регистрация
    09.08.2022
    Сообщений
    6
    Сказал(а) спасибо
    0
    Поблагодарили 0 раз(а) в 0 сообщениях
    В System.Classes ошибка
    raise EFOpenError.CreateResFmt(@SFOpenErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
    Ответить с цитированием  
     

  7. #7  
    Супер модератор Аватар для >Quiet Snow<
    Регистрация
    11.04.2011
    Адрес
    Планета земля
    Сообщений
    4,601
    Сказал(а) спасибо
    2,002
    Поблагодарили 1,084 раз(а) в 939 сообщениях
    Записей в блоге
    1
    Цитата Сообщение от Razuvai Посмотреть сообщение
    В System.Classes ошибка
    Там не может быть ошибки, если ты не правил эти юниты. Ошибка где-то в коде.
    Razuvai, у нас тут на дельфе даже не помню кто кодит, таких, чтобы прям серьёзных кодеров в данный момент нет.
    Если разбираешь чисто алгоритм рекомендую использовать что попроще, FreePascal например и процедурку.
    Всё равно алгоритм будет по сути в отдельном модуле. И разбирать чисто его, без лишнего кода. Да и вообще сначала
    сядь за письменный стол и разбери сам алгоритм и все его нюансы. По шагам.

    Судя по последнему параметру
    Pascal Code:
    1. map:array[0..9,0..9,0..4] of integer;

    всё таки RTS, мол 5 юнитов в клетке, C&C Red Alert стайл. А следовательно никакие алгоритмы Ли и A* там особо не помогут,
    там использовался линейный кастомный алгоритм которых в интернете нету просто потому что из разработчиков стратегий тех лет
    их никто не распространял.
    И 10x10 для первичной отладки - маловато. Нужно хотя бы 40x40, чтобы пару препятствий можно было сделать сложной
    полуокруглой формы, это даст возможность выявить множественные косяки с аттачем к препятствию.
    Обучение прикладному программированию(по skype), качественно, недорого, 18+, вопросы в личку.
    «Если вы ничего не сделаете, я уверяю вас, ничего и не произойдёт» © Жак Фреско
    Ограниченно модерирую.
    Ответить с цитированием  
     

Информация о теме
Пользователи, просматривающие эту тему

Эту тему просматривают: 1 (пользователей: 0 , гостей: 1)

Похожие темы

  1. Срочно! Помогите разобраться
    от tattiana в разделе Delphi
    Ответов: 5
    Последнее сообщение: 31.01.2017, 20:51
  2. Помогите с кодом!
    от Ruslan Drach в разделе QBasic
    Ответов: 1
    Последнее сообщение: 22.04.2015, 13:44
  3. Помогите, пожалуйста, разобраться
    от Marisha в разделе Сети
    Ответов: 0
    Последнее сообщение: 14.01.2014, 15:49
  4. Помогите разобраться с GW-BASIC
    от stamos в разделе Basic
    Ответов: 6
    Последнее сообщение: 20.12.2011, 10:23
  5. Помогите разобраться с QBASIC
    от Лёха в разделе QBasic
    Ответов: 1
    Последнее сообщение: 05.09.2011, 19:23
Ваши права
  • Вы не можете создавать новые темы
  • Вы не можете отвечать в темах
  • Вы не можете прикреплять вложения
  • Вы не можете редактировать свои сообщения
  •