9

我正在使用自定义绘图/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 - 这段代码只是我完整项目的剥离和虚拟版本，用于演示事情是如何工作的。

编辑

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

4

4 回答 4

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.
于 2013-03-09T07:56:08.540 回答
2

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

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

  1. 计算它的斜率。如果地图段坡度与对象路径坡度相同，则它们不会相交。
  2. 计算地图段和对象路径为一的线之间的交点（例如，请参见此处）
  3. 检查地图段是否在碰撞点之前结束：如果是，则没有碰撞
  4. 检查物体路径是否在碰撞点之前结束：如果是，则没有碰撞
于 2013-03-09T07:40:08.733 回答
1

如果你自己不做也没关系，你可以使用现成的库来完成这个任务。Box2D这里有 Delphi 版本

于 2013-03-09T08:02:05.167 回答
0

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

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

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

与通过地图线的大量迭代（例如 2000 次）相比，画布上的几次像素迭代（例如 20 次）微不足道。

于 2013-03-09T09:47:34.140 回答