Delphi自定义动画 - 碰撞检测

时间：2013-03-09 06:42:55

标签： delphi animation drawing delphi-xe2 collision-detection

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

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

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

我想到了在物体移动方向上读取像素颜色，如果有任何黑色（来自地图线），请将其视为墙。但最终会有更多自定义绘制背景，因此读取像素颜色将无法正常工作。

Image of app

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 - 这段代码只是我完整项目的一个剥离和愚蠢的版本，用于演示工作原理。

修改

我刚刚意识到一个重要因素：现在，我只实现了一个移动物体。但是，也会有多个移动物体。因此，碰撞可能发生在地图墙或另一个对象（我将列表中的每个对象）。完整的项目仍然非常原始，就像这个样本一样，但代码要多于这个问题。

4 个答案:

答案 0 :(得分：4)

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

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.

答案 1 :(得分：2)

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

由于您的地图可以被视为一组线段，并且假设您的对象路径是线性，您可以通过查找对象路径与其上的线之间的交叉点来找到所有可能的碰撞地图的各个部分都在。对象路径只有两个斜率：零和无穷大。因此，对于每个地图片段：

  1. 计算其坡度。如果地图段斜率与对象路径斜率相同，则它们将不相交。
  2. 计算地图段和对象路径为1的行之间的交集（例如，请参阅here）
  3. 检查地图段是否在碰撞点之前结束：如果是，则不发生碰撞
  4. 检查对象路径是否在碰撞点之前结束：如果是，则不发生碰撞

答案 2 :(得分：1)

如果没有自己动手就可以了，你可以使用现成的库来完成这项任务。 Box2D有Delphi版本here

答案 3 :(得分：0)

我已经在自己的问题中半途回答了自己的问题。我想到的一件事是在运动方向上读取图像的像素，并检查是否有一条线。我现在意识到我可以在FBMap地图图层下面为背景添加一个额外的图层，并保留地图图层，只绘制可碰撞的墙。

移动时，扫描特定图层上移动方向的像素，而不是整个图像。由于我已经有一个预先绘制的图层，我可以阅读它而不是主图像。基于移动速度，我只需要在前方看到如此多的像素（至少比移动像素的数量多几个像素）。

此外，如果图像的背景具有表示墙壁而不是直线的图片，则甚至不必绘制该图层。该层可以明确地用于在碰撞区域的移动之前扫描几个像素。事实上，由于我还需要识别与其他移动物体的碰撞，我也可以在这里绘制所有物体（黑/白）。

画布上的几个像素迭代（例如20）与通过地图线的广泛迭代相比没有什么，例如2000.

相关问题
最新问题