カスタム描画/2D アニメーションを使用しており、移動オブジェクトがマップ内の壁に衝突したときを検出する方法を見つけようとしています。ユーザーはキーボードの矢印キーを押したままオブジェクトを移動し、マップはポイントの配列構造として保存されます。マップ内の壁は角度が付いている場合がありますが、曲がった壁はありません。
FMap: TMap;
以下のコードのプロパティでマップ構造 ( ) を使用DoMove
すると、オブジェクトがマップ内の壁に衝突しているかどうかを検出し、移動を防ぐにはどうすればよいですか? では、オブジェクトが壁に近づいているかどうかDoMove
を読み取りFMap
(参照しDrawMap
てくださいFMap
)、オブジェクトが壁に近づいているかどうかを判断して停止する必要があります。
各マップの各部分の各 2 点間で可能なすべてのピクセルを反復するデュアル X/Y ループを実行することもできますが、オブジェクトが移動している限り、この手順が急速に呼び出されることを考えると、これが重くなることは既にわかっています。
オブジェクトの移動方向のピクセルの色を読み取り、(マップ ラインからの) 黒があれば、それを壁と見なすことを考えました。しかし、最終的には背景のカスタム描画が増えるため、ピクセルの色の読み取りは機能しません。
uMain.pas
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
const
//Window client size
MAP_WIDTH = 500;
MAP_HEIGHT = 500;
type
TKeyStates = Array[0..255] of Bool;
TPoints = Array of TPoint;
TMap = Array of TPoints;
TForm1 = class(TForm)
Tmr: TTimer;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure TmrTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
FBMain: TBitmap; //Main rendering image
FBMap: TBitmap; //Map image
FBObj: TBitmap; //Object image
FKeys: TKeyStates; //Keyboard states
FPos: TPoint; //Current object position
FMap: TMap; //Map line structure
procedure Render;
procedure DrawObj;
procedure DoMove;
procedure DrawMap;
procedure LoadMap;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Math, StrUtils;
procedure TForm1.FormCreate(Sender: TObject);
begin
FBMain:= TBitmap.Create;
FBMap:= TBitmap.Create;
FBObj:= TBitmap.Create;
ClientWidth:= MAP_WIDTH;
ClientHeight:= MAP_HEIGHT;
FBMain.Width:= MAP_WIDTH;
FBMain.Height:= MAP_HEIGHT;
FBMap.Width:= MAP_WIDTH;
FBMap.Height:= MAP_HEIGHT;
FBObj.Width:= MAP_WIDTH;
FBObj.Height:= MAP_HEIGHT;
FBObj.TransparentColor:= clWhite;
FBObj.Transparent:= True;
FPos:= Point(150, 150);
LoadMap; //Load map lines into array structure
DrawMap; //Draw map lines to map image only once
Tmr.Enabled:= True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Tmr.Enabled:= False;
FBMain.Free;
FBMap.Free;
FBObj.Free;
end;
procedure TForm1.LoadMap;
begin
SetLength(FMap, 1); //Just one object on map
//Triangle
SetLength(FMap[0], 4); //4 points total
FMap[0][0]:= Point(250, 100);
FMap[0][1]:= Point(250, 400);
FMap[0][2]:= Point(100, 400);
FMap[0][3]:= Point(250, 100);
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
FKeys[Key]:= True;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
FKeys[Key]:= False;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0, 0, FBMain); //Just draw rendered image to form
end;
procedure TForm1.DoMove;
const
SPD = 3; //Speed (pixels per movement)
var
X, Y: Integer;
P: TPoints;
begin
//How to keep object from passing through map walls?
if FKeys[VK_LEFT] then begin
//Check if there's a wall on the left
FPos.X:= FPos.X - SPD;
end;
if FKeys[VK_RIGHT] then begin
//Check if there's a wall on the right
FPos.X:= FPos.X + SPD;
end;
if FKeys[VK_UP] then begin
//Check if there's a wall on the top
FPos.Y:= FPos.Y - SPD;
end;
if FKeys[VK_DOWN] then begin
//Check if there's a wall on the bottom
FPos.Y:= FPos.Y + SPD;
end;
end;
procedure TForm1.DrawMap;
var
C: TCanvas;
X, Y: Integer;
P: TPoints;
begin
C:= FBMap.Canvas;
//Clear image first
C.Brush.Style:= bsSolid;
C.Pen.Style:= psClear;
C.Brush.Color:= clWhite;
C.FillRect(C.ClipRect);
//Draw map walls
C.Brush.Style:= bsClear;
C.Pen.Style:= psSolid;
C.Pen.Width:= 2;
C.Pen.Color:= clBlack;
for X := 0 to Length(FMap) - 1 do begin
P:= FMap[X]; //One single map object
for Y := 0 to Length(P) - 1 do begin
if Y = 0 then //First iteration only
C.MoveTo(P[Y].X, P[Y].Y)
else //All remaining iterations
C.LineTo(P[Y].X, P[Y].Y);
end;
end;
end;
procedure TForm1.DrawObj;
var
C: TCanvas;
R: TRect;
begin
C:= FBObj.Canvas;
//Clear image first
C.Brush.Style:= bsSolid;
C.Pen.Style:= psClear;
C.Brush.Color:= clWhite;
C.FillRect(C.ClipRect);
//Draw object in current position
C.Brush.Style:= bsClear;
C.Pen.Style:= psSolid;
C.Pen.Width:= 2;
C.Pen.Color:= clRed;
R.Left:= FPos.X - 10;
R.Right:= FPos.X + 10;
R.Top:= FPos.Y - 10;
R.Bottom:= FPos.Y + 10;
C.Ellipse(R);
end;
procedure TForm1.Render;
begin
//Combine map and object images into main image
FBMain.Canvas.Draw(0, 0, FBMap);
FBMain.Canvas.Draw(0, 0, FBObj);
Invalidate; //Repaint
end;
procedure TForm1.TmrTimer(Sender: TObject);
begin
DoMove; //Control movement of object
DrawObj; //Draw object
Render;
end;
end.
uMain.dfm
object Form1: TForm1
Left = 315
Top = 113
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'Form1'
ClientHeight = 104
ClientWidth = 207
Color = clBtnFace
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnKeyUp = FormKeyUp
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object Tmr: TTimer
Enabled = False
Interval = 50
OnTimer = TmrTimer
Left = 24
Top = 8
end
end
PS - このコードは、私の完全なプロジェクトを取り除いてダミー バージョンにしたもので、どのように機能するかを示しています。
編集
重要な要素に気付きました。現在、移動するオブジェクトは 1 つしか実装していません。ただし、複数の移動オブジェクトも存在します。そのため、衝突はマップの壁または別のオブジェクト (リストに各オブジェクトを含める) のいずれかで発生する可能性があります。プロジェクト全体は、このサンプルのように非常に生のままですが、この質問に関連するコードよりもはるかに多くのコードがあります。