Форум на Исходниках.RU

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

RusSun — Sun, 21 Aug 2022 05:38:14 +0000

RusSun: to Разувай Если всё, то пора закрывать тему. :scratch:

др твоя тема(название тоже похоже) №1
др твоя тема(название тоже похоже) №2
др твоя тема(название тоже похоже) №3
др твоя тема(название тоже похоже) №4
др твоя тема(название тоже похоже) №5

ссылки на справочный материал, добавлено из тем и интернета
Алгоритмы поиска пути added by macomics
№2 Поиск кратчайшего пути added by macomics
№3 igra_tanchiki_chast_1
№4 igra_tanchiki_chast_2
№5 igra_tanchiki_chast_3
№6 igra_tanchiki_chast_4_zavershenie
№7 Readme. Создание игры Танчики

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

RusSun — Tue, 16 Aug 2022 16:26:11 +0000

RusSun:

Цитата Разувай @ 16.08.22, 12:09

Вот проект.

Добавлено Сегодня, 15:10
[attach=#0][/attach]

-> [attach=#0][/attach] это означает, что не прикрепился. Папка по прежнему большая по размеру. :o
=> Пока "Вот" = "нулю" :-? :blink: :scratch:

Скрытый текст

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

Разувай — Tue, 16 Aug 2022 12:09:13 +0000

Разувай: Вот проект.

Добавлено 16.08.22, 12:10
[attach=#0][/attach]

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

RusSun — Mon, 15 Aug 2022 13:43:47 +0000

RusSun: В целом есть два способа. :jokingly:

Скрытый текст

;)

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

Разувай — Thu, 11 Aug 2022 09:04:31 +0000

Разувай: В System.Classes ошибка
raise EFOpenError.CreateResFmt(@SFOpenErrorEx, [ExpandFileName(AFileName), SysErrorMessage(GetLastError)]);

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

macomics — Tue, 09 Aug 2022 13:55:54 +0000

macomics: Переставьте в 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;

эти строчки в начало процедуры. Иначе у вас Timer1 срабатывает до инициализации Pers.Current.

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

Разувай — Tue, 09 Aug 2022 12:05:14 +0000

Разувай: Сделал обход препятствий (Волновой алгоритм Ли) персонажем.
сетка 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 if Image1.Left div 50>a div 50 then Image1.Left:=Image1.Left-1;
if Image1.Left div 50 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.