img
00:00
imgФорум Delphi: Помогите разобраться с кодом Delphi...
imgimgimg
Форумы Delphi Помогите разобраться с кодом Delphi... (Всего сообщений: 1)Страницы:  01 
Razuvai
Новичок

Профиль
1 | #7023 | цитата09-08-2022 15:10
Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
сетка 50 на 50 пикселей. Управление мышкой.
Выдаёт ошибку: Range check error.

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
TPers=record
X,Y,Xn,Yn,Povorot,Anim,Speed,Current:integer;
way:array of TPoint;
end;

TForm1 = class(TForm)
Timer1: TTimer;
Image1: TImage;
Timer2: TTimer;
procedure FormCreate(Sender: TObjec smiley ;
procedure Timer1Timer(Sender: TObjec smiley ;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer2Timer(Sender: TObjec smiley ;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Buf,Obj,ManImg: TBitmap;
Ground:array[0..1] of TBitmap;

Predmet:array[1..2] of TBitmap;
Bild:array[1..2,1..3] of TBitmap;
Panel:array[0..2] of TBitmap;
Doo:array[1..3] of TBitmap;
Path:String;
map:array[0..9,0..9,0..4] of integer;
Pers:TPers;


procedure FindWay;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObjec smiley ;
var
i,j,n: integer;
begin
Path:=ExtractFileDir(Application.ExeName);
Buf:=TBitmap.Create;
Buf.Width:=640;
Buf.Height:=640;
//Obj
Obj:=TBitmap.Create;
Obj.Transparent:=true;
Obj.LoadFromFile(path+'\img\w1.bmp');
//ground
for i:=0 to 1 do begin
Ground:=TBitmap.Create;
Ground.LoadFromFile(path+'\img\'+inttostr(i)+'.bmp');
end;

//Doo
for i:=1 to 3 do begin
Doo:=TBitmap.Create;
Doo.Transparent:=true;
Doo.LoadFromFile(path+'\img\x'+inttostr(i)+'.bmp');
end;

//panel
for i:=0 to 2 do begin
Panel:=TBitmap.Create;
Panel.TransparentColor:=clwhite;
Panel.Transparent:=true;
Panel.LoadFromFile(path+'\img\p'+inttostr(i)+'.bmp');
end;

//man

ManImg:=TBitmap.Create;
ManImg.Transparent:=true;
ManImg.LoadFromFile(path+'\img\c11.bmp');

//Bild
for i:=1 to 2 do begin
for j:=1 to 3 do
begin
Bild[i,j]:=TBitmap.Create;
Bild[i,j].Transparent:=true;
Bild[i,j].LoadFromFile(path+'\img\q'+inttostr(i)+inttostr(j)+'.bmp');
end;
end;

for i:=0 to 9 do
for j:=0 to 9 do
for n:=0 to 4 do
begin
if n=0 then map[i,j,n]:=1
else map[i,j,n]:=0;
end;

map[3,3,0]:=0;
map[4,3,0]:=0;
map[5,3,0]:=0;
//pers
Pers.X:=0;
Pers.Y:=0;
Pers.Xn:=0;
Pers.Yn:=0;
Pers.Povorot:=1;
Pers.Anim:=1;
Pers.Speed:=2;
Pers.Current:=-1;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Pers.Xn:=X;
Pers.Yn:=Y;
FindWay;
end;

procedure TForm1.Timer1Timer(Sender: TObjec smiley ;
var i,j,n: integer;
begin

if Pers.Current>-1 then
begin
if (Pers.Y+49) div 50 > Pers.Way[Pers.Current].Y then Pers.Y:=Pers.Y-1;
if Pers.Y div 50 < Pers.Way[Pers.Current].Y then Pers.Y:=Pers.Y+1;
if (Pers.X+49) div 50 > Pers.Way[Pers.Current].X then Pers.X:=Pers.X-1;
if Pers.X div 50 < Pers.Way[Pers.Current].X then Pers.X:=Pers.X+1;
if ((Pers.X div 50 = Pers.way[Pers.Current].X) and (Pers.Y div 50 = Pers.way[Pers.Current].Y)) and
(((Pers.X+49) div 50=Pers.way[Pers.Current].X) and ((Pers.Y+49) div 50=Pers.way[Pers.Current].Y)) then inc(Pers.Curren smiley ;
if Pers.Current>length(Pers.way)-1 then Pers.Current:=-1;

end;

for i:=0 to 9 do
for j:=0 to 9 do
begin
//ground
Buf.Canvas.Draw(i*50,j*50,Ground[map[i,j,0]]);
end;

for i:=1 to 6 do
for j:=1 to 2 do
begin//prorisovka persa
Buf.Canvas.Draw(Pers.X,Pers.Y,ManImg);
end;
form1.Canvas.Draw(0,0,Buf);
end;

procedure TForm1.Timer2Timer(Sender: TObjec smiley ;
begin

{if Image1.Top div 50>b div 50 then Image1.Top:=Image1.Top-1;
if Image1.Top div 50<b div 50 then Image1.Top:=Image1.Top+1;
if Image1.Left div 50>a div 50 then Image1.Left:=Image1.Left-1;
if Image1.Left div 50<a div 50 then Image1.Left:=Image1.Left+1;}
end;

procedure FindWay;
var i,j,n: integer;
begin
for i:=0 to 9 do begin
for j:=0 to 9 do
begin
if (map[i,j,0]>0) then map[i,j,4]:=0;
if (map[i,j,0]=0) then map[i,j,4]:=-1;
end;
end;

map[Pers.X div 50,Pers.Y div 50,4]:=99;

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;
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;
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;
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;

n:=1;
while (n<=20) do
begin
for i:=0 to 9 do begin
for j:=0 to 9 do
begin
if map[i,j,4]=n then
begin
if (i-1>=0) and (map[i-1,j,4]=0) then map[i-1,j,4]:=n+1;
if (i+1<=9) and (map[i+1,j,4]=0) then map[i+1,j,4]:=n+1;
if (j-1>=0) and (map[i,j-1,4]=0) then map[i,j-1,4]:=n+1;
if (j+1<=9) and (map[i,j+1,4]=0) then map[i,j+1,4]:=n+1;
end;
end;
end;
inc(n);
end;
Setlength(Pers.way,map[Pers.Xn div 50,Pers.Yn div 50,4]);

Pers.way[map[Pers.Xn div 50,Pers.Yn div 50,4]-1].X:=Pers.Xn;
Pers.way[map[Pers.Xn div 50,Pers.Yn div 50,4]-1].Y:=Pers.Yn;

Pers.Current:=length(Pers.way)-1;
while (Pers.Current>0) do
begin
for i:=Pers.way[Pers.Current].X-1 to Pers.way[Pers.Current].X+1 do begin
for j:=Pers.way[Pers.Current].Y-1 to Pers.way[Pers.Current].Y+1 do
begin
if map[i,j,4]=Pers.Current then
begin
Pers.way[Pers.Current-1].X:=i;
Pers.way[Pers.Current-1].Y:=j;
break;
end;
end;
dec(Pers.Curren smiley ;
end;
end;

Pers.Current:=0;
end;


end.
Форумы Delphi Помогите разобраться с кодом Delphi... (Всего сообщений: 1)Страницы:  01 
Тему просматривают: 1 гостей, 0 пользователей
Ваше Имя:
 
22000/22000 [Справка по кодам]
 Защита от спамботовВведите ответ:
Помогите разобраться с кодом Delphi... | Ответов: 1
 
Вход
Имя:
Пароль:
Запомнить
Регистрация Забыли пароль?
Мини-чат :)
Необходима регистрация
Архив мини-чата
03-03-2024 16:34
ПаХаН
Надо чтобы этот сайт был жив
20-02-2024 06:12
memoryspeak
обалденный сайт. искал ответ на вопрос, как скриптом закрыть вкладку, и наткнулся на это чудо.
08-02-2024 20:22
stark452
Разработчику огромный респект
08-02-2024 20:21
stark452
Если ее немного допилить
и сделать все правильно
то она может стать чем то весомым
08-02-2024 20:20
stark452
Странно что эта штука не популярна
08-10-2023 02:39
Darian
smiley
just testing the smileys
08-10-2023 02:38
Darian
._. -_- >o) ;(
08-10-2023 02:37
Darian
smiley
08-10-2023 02:36
Darian
smiley smiley smiley smiley :$ :?
Emoji Test
03-09-2023 17:03
DartKane
Yes. Unfortunately, the chat is not so active here. And if someone writes here once and for half a year, this is a huge event (
Статистика
 СегодняВсего
Посетителей11704038069
Запросов3023395135459
Online
Пользователей0
Гостей133
imgimgimgimg
 
img
     00:00