qwerty Вот кое-что из моих старых программ (можешь поиграться с k и divider)
Код
uses crt, graph;
type
TVector =
record
X, Y: real;
end;
const
divider = 1;
k = 0.7;
ball_size = 5;
var
pos, v: TVector;
procedure ShowBall(color: byte);
begin
setcolor(color);
circle(trunc(pos.X), trunc(pos.Y), ball_size);
end;
procedure RecalcBall;
procedure ChangeDirectionX;
begin
pos.X := pos.X - v.X * divider;
v.X := - v.X * k
end;
procedure ChangeDirectionY;
begin
pos.Y := pos.Y - v.Y * divider;
v.Y := - v.Y * k
end;
begin
ShowBall(black);
pos.X := pos.X + v.X * divider;
if pos.X >= getmaxx - ball_size then
ChangeDirectionX
else
if pos.X <= ball_size then
ChangeDirectionX;
{
else inc(pos.X, v.X * divider);
}
pos.Y := pos.Y + v.Y * divider;
if pos.Y >= getmaxy - ball_size then
ChangeDirectionY
else
if pos.Y <= ball_size then
ChangeDirectionY;
{
else inc(pos.Y, v.Y * divider);
}
ShowBall(white)
end;
var
grDriver, grMode, errCode: Integer;
to_exit: boolean;
begin
grDriver := Detect;
initgraph(grDriver, grMode,'');
errCode := graphresult;
if errCode <> grOk then
begin
writeln('Graphics error:', grapherrormsg(errCode));
halt
end;
v.X := random(7) + 4; v.Y := 10;
pos.X := getmaxx div 2; pos.y := 0;
to_exit := false;
ShowBall(white);
repeat
RecalcBall;
delay(10000);
if keypressed then
begin
to_exit := (readkey = #27);
while keypressed do readkey
end
until to_exit;
setcolor(white);
end.