Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль

Купить рекламу на форуме 15-35 тыс рублей в месяц

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы Поиск в этой теме
Старый 09.08.2022, 08:06   #11
Razuvai
Пользователь
 
Регистрация: 27.10.2021
Сообщений: 14
По умолчанию

Там нету персонажа!
Razuvai вне форума Ответить с цитированием
Старый 09.08.2022, 10:13   #12
Razuvai
Пользователь
 
Регистрация: 27.10.2021
Сообщений: 14
По умолчанию

Управление мышкой.
Razuvai вне форума Ответить с цитированием
Старый 09.08.2022, 15:03   #13
Razuvai
Пользователь
 
Регистрация: 27.10.2021
Сообщений: 14
По умолчанию Помогите разобраться с кодом Delphi...

Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
сетка 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.

Последний раз редактировалось BDA; 09.08.2022 в 20:05.
Razuvai вне форума Ответить с цитированием
Старый 09.08.2022, 16:52   #14
macomics
Форумчанин
 
Регистрация: 17.04.2022
Сообщений: 888
По умолчанию

В обработчике TForm1.FormCreate переставьте
Код:
//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;
эти строчки в начало процедуры. Иначе у вас таймер срабатывает до инициализации Pers.Current.
macomics вне форума Ответить с цитированием
Старый 09.08.2022, 19:42   #15
Razuvai
Пользователь
 
Регистрация: 27.10.2021
Сообщений: 14
По умолчанию

Ошибка здесь if map[i,j,4]=Pers.Current then
Razuvai вне форума Ответить с цитированием
Старый 09.08.2022, 20:00   #16
macomics
Форумчанин
 
Регистрация: 17.04.2022
Сообщений: 888
По умолчанию

Ну так проверьте их на попадание в границы массива
Код:
if (i in [Low(map) .. High(map)]) and (j in [Low(map[i]) .. High(map[i])]) and (map[i,j,4] = Pers.Current) then ...
macomics вне форума Ответить с цитированием
Старый 11.08.2022, 12:03   #17
Razuvai
Пользователь
 
Регистрация: 27.10.2021
Сообщений: 14
По умолчанию

В System.Classes ошибка
raise EFOpenError.CreateResFmt(@SFOpenErr orEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);
Razuvai вне форума Ответить с цитированием
Ответ
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как составить программу для робота, чтобы он зигзагом обходил любое количество бутылок? Камил Помощь студентам 17 10.04.2017 15:17
Как сделать чтобы бд работала без установки Delphi Ol'ga БД в Delphi 7 05.06.2012 16:22
Как сделать чтобы программа не закрывалась при нажатии клавиш alt+f4 (Delphi) zig1 Помощь студентам 1 12.12.2011 06:18
Delphi OpenGL: анимированный персонаж *.GMS (3D Studio Max) Vova777 Общие вопросы Delphi 0 05.08.2011 19:42
Как сделать чтобы xml файл открывался в Delphi KlErik Общие вопросы Delphi 2 24.05.2007 11:02