Hoạt ảnh tùy chỉnh Delphi - phát hiện va chạm

Question

Tôi đang làm việc với bản vẽ tùy chỉnh/hoạt ảnh 2D và tôi đang cố gắng tìm ra cách phát hiện khi đối tượng chuyển động va chạm với một bức tường trên bản đồ. Người dùng giữ các phím mũi tên trên bàn phím để di chuyển đối tượng và bản đồ được lưu trữ dưới dạng cấu trúc mảng của các điểm. Các bức tường trong bản đồ có thể được góc cạnh, nhưng không có các bức tường cong.

Sử dụng cấu trúc bản đồ (FMap: TMap;) trong mã của tôi bên dưới, trong thuộc tính DoMove, làm cách nào để phát hiện đối tượng đang va chạm với bất kỳ bức tường nào trên bản đồ và ngăn không cho nó di chuyển qua? Trong DoMove, tôi cần phải đọc FMap (tham khảo DrawMap để xem cách hoạt động của FMap) và bằng cách nào đó xác định xem đối tượng có đang tiếp cận bất kỳ bức tường nào và dừng nó không.

Tôi có thể thực hiện một vòng lặp X/Y lặp lại mọi pixel có thể giữa mỗi điểm trong mỗi phần của mỗi bản đồ, nhưng tôi đã biết điều này sẽ rất nặng, xem xét thủ tục này sẽ được gọi nhanh chóng miễn là đối tượng di chuyển.

Tôi đã nghĩ về việc đọc các màu pixel theo hướng di chuyển của đối tượng và nếu có màu đen (từ các đường bản đồ), hãy xem đó là một bức tường. Nhưng cuối cùng sẽ có nhiều bản vẽ tùy chỉnh hơn của nền, vì vậy việc đọc các màu pixel sẽ không hoạt động.

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 - Đoạn mã này chỉ là một tước và dummied phiên bản của dự án đầy đủ của tôi để chứng minh cách mọi thứ hoạt động.

---

EDIT

Tôi chỉ nhận ra một yếu tố quan trọng: Ngay bây giờ, tôi đã chỉ thực hiện một đối tượng chuyển động. Tuy nhiên, sẽ có nhiều đối tượng chuyển động. Vì vậy, sự va chạm có thể xảy ra với một bức tường bản đồ hoặc đối tượng khác (mà tôi sẽ có mỗi đối tượng trong một danh sách). Dự án đầy đủ vẫn còn rất thô như mẫu này, nhưng nhiều mã hơn là có liên quan cho câu hỏi này.

Answer 1

Tôi đã trả lời một nửa câu hỏi của chính mình trong câu hỏi về bản thân nó. Một điều tôi đã nghĩ đến là đọc các điểm ảnh của hình ảnh theo hướng chuyển động, và kiểm tra xem có đường dây ở đó hay không. Bây giờ tôi nhận ra rằng tôi có thể có thêm một lớp dưới lớp bản đồ FBMap cho nền, và rời khỏi lớp bản đồ vì nó chỉ với các bức tường va chạm được vẽ.

Khi di chuyển, quét các pixel theo hướng chuyển động trên lớp cụ thể đó, chứ không phải hình ảnh đầy đủ. Vì tôi đã có một lớp được vẽ sẵn ở đó, tôi có thể đọc nó hơn là hình ảnh chính. Dựa trên tốc độ di chuyển, tôi chỉ cần nhìn nhiều pixel phía trước (ít nhất một vài pixel so với số điểm ảnh của chuyển động).

Ngoài ra, trong trường hợp nền của hình ảnh có hình ảnh đại diện cho các bức tường chứ không phải là các đường trơn thẳng, thì lớp này thậm chí không cần phải rút ra chút nào. Lớp này có thể được sử dụng một cách rõ ràng chỉ để quét một vài điểm ảnh trước chuyển động cho các vùng va chạm. Như một vấn đề của thực tế, vì tôi cũng cần phải nhận ra va chạm với các đối tượng chuyển động khác, tôi có thể vẽ tất cả các đối tượng trên đây là tốt (màu đen/trắng).

Một vài lần lặp lượng pixel trên một canvas, ví dụ 20, là gì so với lần lặp rộng rãi thông qua các đường bản đồ, ví dụ 2000.

Answer 2

Mỗi lần nhấn phím, bạn tính toán tọa độ mới của đối tượng sau khi di chuyển sẽ được thực hiện. Sau đó, bạn có thể kiểm tra các giao lộ giữa quỹ đạo đối tượng và đường trong bản đồ.

Vì bản đồ của bạn có thể được coi là một tập hợp các đoạn đường và được cho là đường dẫn đối tượng của bạn là tuyến tính, bạn có thể tìm thấy tất cả các xung đột có thể xảy ra bằng cách tìm giao lộ giữa đường dẫn đối tượng và các đường trên đó bản đồ nằm. Bạn sẽ chỉ có hai sườn cho đường dẫn đối tượng: 0 và vô cùng. Vì vậy, đối với mỗi đoạn bản đồ:

1. Tính toán độ dốc của nó. Nếu độ dốc đoạn bản đồ giống với độ dốc đường dẫn đối tượng, chúng sẽ không cắt nhau.
2. Tính ngã tư giữa các dòng rằng phân khúc đồ và con đường đối tượng là một (xem here ví dụ)
3. Kiểm tra xem phân khúc đồ kết thúc trước thời điểm va chạm: nếu có, thì không có va chạm
4. Kiểm tra xem đường dẫn đối tượng kết thúc trước điểm va chạm: nếu có, thì không có va chạm

Answer 3

đơn vị này được tìm thấy trên web (không thể nhớ nơi nào, không có tác giả đề cập, có thể ai đó có thể cung cấp liên kết) sẽ cung cấp cho bạn khả năng tính toán va chạm và góc phản xạ.

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 thực hiện ví dụ sẽ là

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. 

Answer 4

Nếu không làm điều đó cho mình là OK, bạn có thể sử dụng sẵn sàng thư viện thực hiện cho nhiệm vụ này. Box2D có phiên bản Delphi here