1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
|
unit Unit1;
interface
uses
SysUtils, Windows, Forms, Classes, Controls, StdCtrls;
type
TImpact = (iDrop, iTopBottom, iLeftRight);
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
// Paramètres initiaux: lâcher ou collision
T0: Cardinal; // Instant initial
X0: Integer; // Abscisse initiale
Y0: Integer; // Ordonnée initiale
Vx: Extended; // Vitesse initiale horizontale
Vy: Extended; // Vitesse initiale verticale
// Cadre de d'évolution
LimitX, LimitY: Integer;
const
G = 9.81 * 50; // Accélération de la pesanteur
E = 0.65; // Coefficient de restitution à la collision
implementation
{$R *.dfm}
uses
Math;
procedure InitParams(AImpact: TImpact; const VxI, VyI: Extended);
begin
T0 := GetTickCount;
X0 := Mouse.CursorPos.X;
Y0 := Mouse.CursorPos.Y;
case AImpact of
iDrop:
begin
Vx := VxI;
Vy := VyI;
end;
iTopBottom:
begin
Vx := VxI * E;
Vy := -VyI * E;
end;
iLeftRight:
begin
Vx := -VxI * E;
Vy := VyI * E;
end;
end;
end;
function GetXYPos: TPoint;
var
T: Cardinal;
Vt: Extended;
begin
T := GetTickCount - T0;
result.X := Trunc(Vx * (T / 1000) + X0);
result.Y := Trunc(0.5 * G * Power(T / 1000, 2) + Vy * (T / 1000) + Y0);
Vt := G * (T / 1000) + Vy;
if (result.X <= 0) or (result.X >= LimitX) then
InitParams(iLeftRight, Vx, Vt)
else if (result.Y <= 0) or (result.Y >= LimitY) then
InitParams(iTopBottom, Vx, Vt);
end;
procedure DropMouse;
var
Pt: TPoint;
begin
LimitX := GetSystemMetrics(SM_CXSCREEN) - GetSystemMetrics(SM_CXCURSOR);
LimitY := GetSystemMetrics(SM_CYSCREEN) - GetSystemMetrics(SM_CYCURSOR);
InitParams(iDrop, 300, -400);
repeat
Sleep(20);
Pt := GetXYPos;
SetCursorPos(Pt.X, Pt.Y);
until (Abs(Vx) < 2) or (Abs(Vy) < 2);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DropMouse;
end;
end. |
Partager