Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Помогите разобраться с кодом Delphi... 
:(
    Опции темы
Razuvai
Дата 9.8.2022, 15:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 9.8.2022

Репутация: нет
Всего: нет



Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
сетка 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[i]:=TBitmap.Create;
Ground[i].LoadFromFile(path+'\img\'+inttostr(i)+'.bmp');
end;

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

//panel
for i:=0 to 2 do begin
Panel[i]:=TBitmap.Create;
Panel[i].TransparentColor:=clwhite;
Panel[i].Transparent:=true;
Panel[i].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(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.Current);
end;
end;

Pers.Current:=0;
end;


end.
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0949 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.