Delphi自定义动画-碰撞检测

Question

我正在处理自定义绘图/2D 动画，我正在尝试找出如何检测移动物体何时与 map 中的墙壁碰撞。用户按住键盘上的方向键来移动对象， map 存储为点的数组结构。 map 中的墙壁可能是有角度的，但没有弯曲的墙壁。

在下面的代码中使用 map 结构 (FMap: TMap;)，在 DoMove 属性中，如何检测对象是否与中的任何墙壁发生碰撞 map 并阻止其移动？在DoMove中，我需要读取FMap(请参阅DrawMap以了解FMap如何工作)并以某种方式确定是否物体正在接近任何墙壁并阻止它。

我可以做一个双 X/Y 循环，迭代每个 map 每个部分中每两个点之间的每个可能的像素，但我已经知道这会很重，考虑到只要对象在移动，这个过程就会被快速调用.

我想读取物体移动方向上的像素颜色，如果有任何黑色(来自 map 线)，则将其视为一堵墙。但最终将会有更多的自定义背景绘制，因此读取像素颜色将不起作用。

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 - 这段代码只是我的完整项目的精简和虚拟版本，用于演示事情是如何工作的。

<小时/>

编辑

我刚刚意识到一个重要因素:现在，我只实现了一个移动对象。然而，也会有多个移动物体。因此，碰撞可能会发生在 map 墙或另一个对象上(我将每个对象都放在一个列表中)。完整的项目仍然非常原始，就像这个示例一样，但代码比与这个问题相关的代码多得多。

Answer 1

在网络上找到的这个单元(不记得在哪里，没有提到作者，也许有人可以提供链接)将使您能够计算碰撞和反射角度。

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.

一个示例实现是

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.