Here's a ball bouncing in a constant force field (e.g., the field of gravity close to the surface of the Earth). The lateral walls and the floor are bouncing surfaces. You can add additional forces using the arrow keys:
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TRealVect = record
X, Y: real;
end;
const
ZeroVect: TRealVect = (X: 0; Y: 0);
type
TForm5 = class(TForm)
Timer1: TTimer;
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
function ACC: TRealVect;
const
RADIUS = 16;
DAMPING = 0.8;
DT = 0.2;
GRAVITY: TRealVect = (X: 0; Y: 10);
var
FForce: TRealVect;
FPos: TRealVect;
FVel: TRealVect;
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
function RealVect(X, Y: real): TRealVect;
begin
result.X := X;
result.Y := Y;
end;
function Add(A, B: TRealVect): TRealVect;
begin
result.X := A.X + B.X;
result.Y := A.Y + B.Y;
end;
function Scale(A: TRealVect; C: real): TRealVect;
begin
result.X := C*A.X;
result.Y := C*A.Y;
end;
function TForm5.ACC: TRealVect;
begin
result := Add(GRAVITY, FForce);
end;
procedure TForm5.FormCreate(Sender: TObject);
begin
FPos := RealVect(Width div 2, 10);
FVel := RealVect(0, 0);
end;
procedure TForm5.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_UP:
FForce := RealVect(0, -20);
VK_DOWN:
FForce := RealVect(0, 10);
VK_RIGHT:
FForce := RealVect(10, 0);
VK_LEFT:
FForce := RealVect(-10, 0);
end;
end;
procedure TForm5.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
FForce := ZeroVect;
end;
procedure TForm5.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color := clRed;
Canvas.Ellipse(round(FPos.X - RADIUS), round(FPos.Y - RADIUS),
round(FPos.X + RADIUS), round(FPos.Y + RADIUS));
end;
procedure TForm5.Timer1Timer(Sender: TObject);
begin
FVel := Add(FVel, Scale(ACC, DT));
FPos := Add(FPos, Scale(FVel, DT));
if FPos.Y + RADIUS >= ClientHeight then
begin
FVel.Y := -DAMPING*FVel.Y;
FPos.Y := ClientHeight - RADIUS - 1;
end;
if FPos.X - RADIUS <= 0 then
begin
FVel.X := -DAMPING*FVel.X;
FPos.X := RADIUS + 1;
end;
if FPos.X + RADIUS >= ClientWidth then
begin
FVel.X := -DAMPING*FVel.X;
FPos.X := ClientWidth - RADIUS - 1;
end;
Invalidate;
end;
end.
Set the timer's interval to 30
, as 'usual'.
Compiled sample EXE