Delphi custom animation - collision detection

Question

I'm working with custom drawing / 2D animation and I'm trying to figure out how to detect when the moving object collides with a wall in the map. User holds arrow keys on the keyboard to move the object, and the map is stored as an array structure of points. The walls in the map may be angled, but no curved walls.

Using the map structure (FMap: TMap;) in my code below, in the DoMove property, how do I detect if the object is colliding with any wall in the map and prevent it from moving through? In DoMove, I need to read FMap (refer to DrawMap to see how FMap works) and somehow determine if the object is approaching any wall and stop it.

I could do a dual X/Y loop iterating every possible pixel between each two points in each part of each map, but I already know this will be heavy, considering this procedure will be called rapidly so long as the object is moving.

I thought of reading the pixel colors in the direction the object's moving, and if there's any black (from map lines), consider it a wall. But eventually there will be more custom drawing of a background, so reading pixel colors wouldn't work.

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 - This code is just a stripped and dummied version of my full project to demonstrate how things work.

---

EDIT

I just realized an important factor: Right now, I've only implemented one moving object. However, there will be multiple moving objects as well. So, the collision may occur with either a map wall or another object (which I'll have each object in a list). The full project is still very raw like this sample, but much more code than is relevant for this question.

Answer 1

this unit found on the web (can't remember where, no author mentioned, perhaps someone can provide a link) would give you the ability of calculating collisions and reflection angles.

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.

An example implementation would be

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.