Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
сетка 50 на 50 пикселей. Управление мышкой.
Выдаёт ошибку: Range check error
сетка 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: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer2Timer(Sender: TObject);
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: TObject);
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: TObject);
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.Current);
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: TObject);
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;
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.Current);
end;
end;
Pers.Current:=0;
end;
end.
Последнее редактирование модератором:
