Delphi自定义动画-碰撞检测

我正在使用自定义绘图/2D动画，并试图找出如何检测移动对象何时与地图中的墙碰撞。用户按住键盘上的箭头键移动对象，地图存储为点的数组结构。地图中的墙可以是有角度的，但不能是弯曲的墙

使用下面我的代码中的地图结构（

FMap:TMap；

），在

DoMove

属性中，如何检测对象是否与地图中的任何墙碰撞并防止其移动？在

DoMove

中，我需要阅读

FMap

（请参阅

DrawMap

，了解

FMap

的工作原理），并以某种方式确定物体是否正在接近任何墙壁并阻止它

我可以做一个双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-这段代码只是我整个项目的简化版，用来演示如何工作

---

编辑

---

我刚刚意识到一个重要因素：现在，我只实现了一个移动对象。但是，也会有多个移动对象。因此，碰撞可能发生在地图墙或其他对象上（我将在列表中列出每个对象）。完整的项目仍然像这个示例一样原始，但是与这个问题相关的代码要多得多。

每次按下该键，都会在执行移动后计算对象的新坐标。然后可以测试对象轨迹与地图中的直线之间的交点

由于可以将贴图视为一组线段，并且假定对象路径是线性的，因此可以通过查找对象路径与贴图线段所在的直线之间的交点来查找所有可能的碰撞。对象路径只有两个坡度：零和无限。因此，对于每个地图段：

计算它的斜率。如果贴图线段坡度与对象路径坡度相同，则它们不会相交

计算地图线段与对象路径为一条直线之间的交点（请参见示例）

检查贴图段是否在碰撞点之前结束：如果是，则无碰撞

检查对象路径是否在碰撞点之前结束：如果是，则无碰撞

---

这个在网络上找到的单元（不记得在哪里，没有作者提到，也许有人可以提供链接）可以让你计算碰撞和反射角度

unit Vector;

interface

type
  TPoint = record
    X, Y: Double;
  end;

  TVector = record
    X, Y: Double;
  end;

  TLine = record
    P1, P2: TPoint;
  end;

function Dist(P1, P2: TPoint): Double; overload;
function ScalarProd(P1, P2: TVector): Double;
function ScalarMult(P: TVector; V: Double): TVector;
function Subtract(V1, V2: TVector): TVector; overload;
function Subtract(V1, V2: TPoint): TVector; overload;
function MinDistPoint(Point: TPoint; Line: TLine): TPoint;
function Mirror(W, V: TVector): TVector;
function Dist(Point: TPoint; Line: TLine): Double; overload;

implementation

function Dist(P1, P2: TPoint): Double; overload;
begin
  Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y));
end;

function ScalarProd(P1, P2: TVector): Double;
begin
  Result := P1.X * P2.X + P1.Y * P2.Y;
end;

function ScalarMult(P: TVector; V: Double): TVector;
begin
  Result.X := P.X * V;
  Result.Y := P.Y * V;
end;

function Subtract(V1, V2: TVector): TVector; overload;
begin
  Result.X := V2.X - V1.X;
  Result.Y := V2.Y - V1.Y;
end;

function Subtract(V1, V2: TPoint): TVector; overload;
begin
  Result.X := V2.X - V1.X;
  Result.Y := V2.Y - V1.Y;
end;

function MinDistPoint(Point: TPoint; Line: TLine): TPoint;
var
  U: Double;
  P: TPoint;
begin
  U := ((Point.X - Line.P1.X) * (Line.P2.X - Line.P1.X) +
        (Point.Y - Line.P1.Y) * (Line.P2.Y - Line.P1.Y)) /
    (Sqr(Line.P1.X - Line.P2.X) + Sqr(Line.P1.Y - Line.P2.Y));
  if U <= 0 then
    Exit(Line.P1);
  if U >= 1 then
    Exit(Line.P2);
  P.X := Line.P1.X + U * (Line.P2.X - Line.P1.X);
  P.Y := Line.P1.Y + U * (Line.P2.Y - Line.P1.Y);
  Exit(P);
end;

function Mirror(W, V: TVector): TVector;
begin
  Result := Subtract(ScalarMult(V, 2*ScalarProd(v,w)/ScalarProd(v,v)), W);
end;

function Dist(Point: TPoint; Line: TLine): Double; overload;
begin
  Result := Dist(Point, MinDistPoint(Point, Line));
end;

end.

单位向量；
接口
类型
t点=记录
十、 Y:双倍；
结束；
TVector=记录
十、 Y:双倍；
结束；
TLine=记录
P1，P2:t点；
结束；
功能区（P1，P2:T点）：双精度；超载；
函数ScalarProd（P1，P2:TVector）：双精度；
函数ScalarMult（P:TVector；V:Double）：TVector；
函数减法（V1，V2:TVector）：TVector；超载；
函数减法（V1，V2:TPoint）：TVector；超载；
函数MinDistPoint（点：TPoint；线：TLine）：TPoint；
功能镜（W，V:TVector）：TVector；
函数距离（点：t点；线：t线）：双精度；超载；
实施
功能区（P1，P2:T点）：双精度；超载；
开始
结果：=Sqrt（Sqr（P1.X-P2.X）+Sqr（P1.Y-P2.Y））；
结束；
函数ScalarProd（P1，P2:TVector）：双精度；
开始
结果：=P1.X*P2.X+P1.Y*P2.Y；
结束；
函数ScalarMult（P:TVector；V:Double）：TVector；
开始
结果X:=P.X*V；
结果Y:=P.Y*V；
结束；
函数减法（V1，V2:TVector）：TVector；超载；
开始
结果X:=V2.X-V1.X；
结果Y:=V2.Y-V1.Y；
结束；
函数减法（V1，V2:TPoint）：TVector；超载；
开始
结果X:=V2.X-V1.X；
结果Y:=V2.Y-V1.Y；
结束；
函数MinDistPoint（点：TPoint；线：TLine）：TPoint；
变量
U:双倍；
P:TPoint；
开始
U:=（（点.X-线.P1.X）*（线.P2.X-线.P1.X）+
（点Y-线P1.Y）*（线P2.Y-线P1.Y））/
（Sqr（Line.P1.X-Line.P2.X）+Sqr（Line.P1.Y-Line.P2.Y））；
如果U=1，则
出口（P2行）；
P.X:=Line.P1.X+U*（Line.P2.X-Line.P1.X）；
P.Y:=Line.P1.Y+U*（Line.P2.Y-Line.P1.Y）；
出口（P）；
结束；
功能镜（W，V:TVector）：TVector；
开始
结果：=减去（ScalarMult（V，2*ScalarProd（V，w）/ScalarProd（V，V）），w；
结束；
函数距离（点：t点；线：t线）：双精度；超载；
开始
结果：=Dist（点，MinDistPoint（点，线））；
结束；
结束。

一个示例实现是

unit BSP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Vector, ExtCtrls;

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    FLines: array of TLine;
    FP: TPoint;
    FV: TVector;
    FBallRadius: Integer;
    FBallTopLeft: Windows.TPoint;
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
const
  N = 5;

var
  I: Integer;
begin
  Randomize;

  SetLength(FLines, 4 + N);
  FBallRadius := 15;
  // Walls
  FLines[0].P1.X := 0;
  FLines[0].P1.Y := 0;
  FLines[0].P2.X := Width - 1;
  FLines[0].P2.Y := 0;

  FLines[1].P1.X := Width - 1;
  FLines[1].P1.Y := 0;
  FLines[1].P2.X := Width - 1;
  FLines[1].P2.Y := Height - 1;

  FLines[2].P1.X := Width - 1;
  FLines[2].P1.Y := Height - 1;
  FLines[2].P2.X := 0;
  FLines[2].P2.Y := Height - 1;

  FLines[3].P1.X := 0;
  FLines[3].P1.Y := 0;
  FLines[3].P2.X := 0;
  FLines[3].P2.Y := Height - 1;
  for I := 0 to N - 1 do
  begin
    FLines[I + 4].P1.X := 50 + Random(Width - 100);
    FLines[I + 4].P1.Y := 50 + Random(Height - 100);
    FLines[(I + 1) mod N + 4].P2 := FLines[I + 4].P1;
  end;

  FP.X := 50;
  FP.Y := 50;

  FV.X := 10;
  FV.Y := 10;
end;

procedure TForm2.FormPaint(Sender: TObject);
const
  Iterations = 100;
var
  I, MinIndex, J: Integer;
  MinDist, DP, DH: Double;
  MP: TPoint;
  H: TPoint;
begin


  for I := 0 to Length(FLines) - 1 do
  begin
    Canvas.MoveTo(Round(FLines[I].P1.X), Round(FLines[I].P1.Y));
    Canvas.LineTo(Round(FLines[I].P2.X), Round(FLines[I].P2.Y));
  end;

  for I := 0 to Iterations do
  begin
    H := FP;
    FP.X := FP.X + FV.X / Iterations;
    FP.Y := FP.Y + FV.Y / Iterations;
    MinDist := Infinite;
    MinIndex := -1;
    for J := 0 to Length(FLines) - 1 do
    begin
      DP := Dist(FP, FLines[J]);
      DH := Dist(H, FLines[J]);
      if (DP < MinDist) and (DP < DH) then
      begin
        MinDist := DP;
        MinIndex := J;
      end;
    end;

    if MinIndex >= 0 then
      if Sqr(MinDist) < 2*Sqr(FBallRadius * 0.7 / 2)
         then
      begin
        MP := MinDistPoint(FP, FLines[MinIndex]);
        FV := Mirror(FV, Subtract(MP, FP));
      end;
  end;

  FBallTopLeft.X := Round(FP.X - FBallRadius);
  FBallTopLeft.Y := Round(FP.Y - FBallRadius);
  Canvas.Brush.Color := clBlue;
  Canvas.Ellipse(FBallTopLeft.X, FBallTopLeft.Y,
    FBallTopLeft.X + FBallRadius * 2, FBallTopLeft.Y + FBallRadius * 2);

end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  invalidate;
end;

end.

单位BSP；
接口
使用
窗口、消息、系统工具、变体、类、图形、控件、窗体、，
对话框、StdCtrls、向量、ExtCtrls；
类型
TForm2=类别（TForm）
定时器1:TTimer；
程序FormPaint（发送方：TObject）；
过程表单创建（发送方：ToObject）；
程序定时器1定时器（发送方：TObject）；
私有的
{私营部门}
弗林斯：T线阵列；
FP:TPoint；
FV:TVector；
FBallRadius：整数；
FBallTopLeft:Windows.TPoint；
公众的
{公共部门}
结束；
变量
表2:TForm2；
实施
{$R*.dfm}
过程TForm2.FormCreate（发送方：TObject）；
常数
N=5；
变量
I：整数；
开始
随机化；
设定长度（燧石，4+N）；
fball半径：=15；
//墙
FLines[0].P1.X:=0；
FLines[0].P1.Y:=0；
FLines[0].P2.X:=宽度-1；
FLines[0].P2.Y:=0；
FLines[1].P1.X:=宽度-1；
FLines[1].P1.Y:=0；
FLines[1].P2.X:=宽度-1；
FLines[1].P2.Y:=高度-1；
FLines[2].P1.X:=宽度-1；
FLines[2].P1.Y:=高度-1；
FLines[2].P2.X:=0；
FLines[2].P2.Y:=高度-1；
弗林斯[3]