unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
const
pointR = 5;
ballR = 40;
g = 0.002;
var
Form1: TForm1;
maxPoints: integer = 100;
points: array of TPoint;
bx, by, vx, vy: single;
implementation
{$R *.lfm}
procedure addPoint(x, y: integer);
var
i, l: integer;
begin
if maxPoints <= 0 then exit;
l := Length(points);
if l < maxPoints then begin
SetLength(points, l+1);
points[l].X := x;
points[l].Y := y;
end else begin
for i:=1 to l-1 do begin
points[i-1] := points[i];
end;
points[l-1].X := x;
points[l-1].Y := y;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bx := 200;
by := 100;
vx := 0.1;
vy := 0;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then begin
addPoint(x, y);
// todo: addPointChain
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i: integer;
begin
Canvas.Pen.Color := clBlack;
Canvas.Pen.Width := pointR * 2;
for i:=0 to length(points)-1 do begin
Canvas.MoveTo(points[i].x, points[i].y);
Canvas.LineTo(points[i].x, points[i].y);
end;
Canvas.Pen.Color := clBlue;
Canvas.Pen.Width := ballR * 2;
Canvas.MoveTo(round(bx), round(by));
Canvas.LineTo(round(bx), round(by));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i: integer;
dx, dy, sqlen, minSqlen, dv: single;
collision: boolean;
begin
collision := false;
bx := bx + vx;
by := by + vy;
if bx > ClientWidth - ballR then begin vx := -abs(vx); collision := true; end;
if by > ClientHeight - ballR then begin vy := -abs(vy); collision := true; end;
if bx < ballR then begin vx := abs(vx); collision := true; end;
if by < ballR then begin vy := abs(vy); collision := true; end;
minSqlen := sqr(ballR + pointR);
for i := 0 to length(points)-1 do begin
dx := points[i].X-bx;
dy := points[i].Y-by;
sqlen := sqr(dx) + sqr(dy);
if (sqlen > 0.1*minSqlen) and (minSqlen > sqlen) then begin
dv := -2*(dx*vx + dy*vy)/sqlen;
if dv < 0 then begin
vx := vx + dv*dx;
vy := vy + dv*dy;
collision := true;
end;
end;
end;
if not collision then vy := vy + g;
if collision then refresh;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
Refresh;
end;
end.