Turbo Pascal, настроить траекторию шарика

@Decsu · Регистрация: 08.06.2021

Author24 — интернет-сервис помощи студентам

Помогите пожалуйста сделать правильную траекторию для шарика.
А то я вообще нечего не могу сделать с ней

Turbo Pascal, настроить траекторию шарика

Помогите пожалуйста дописать задачу

Код

program lb_10;
uses crt, dos, graph;
var d,m:integer;
    x, y: integer;
    vx, vy, _mX, _mY: integer;
    runed, mouse_s, _k:byte;
    k:char;
    Reg:registers;


procedure initMouse;
Begin
     Reg.AX := 0;
     Intr($33, Reg);
End;

procedure MouseOn;
Begin
     Reg.AX := 1;
     Intr($33, Reg);
     mouse_s := 1;
End;

procedure MouseOff;
Begin
     Reg.AX := 2;
     mouse_s := 0;
     Intr($33, Reg);
End;


Begin
     d:=Detect;
     x:=200;
     runed:=0;
     y:=50;
     vx:= 0;
     vy:= 1;
     InitGraph(d, m, '');
     initMouse;
     MouseOn;

     Line(300, 50, 500, 250);
     Line(500, 250, 300, 420);
     Line(130, 250, 300, 420);

     SetFillStyle(1, 15);
     Bar(30, 30, 100, 55);
     OutTextXY(140,450,'Нажмите "Пуск" или клавишу Enter для запуска');
     SetColor(0);
     Rectangle(32, 32, 98, 53);
     OutTextXY(48,40,'Пуск');
     SetColor(15);
     SetLineStyle(0, 0, 2);
     Line(50, 100, 50, 250);
     Circle(x, y, 20);

     while runed = 0 do
     Begin
          Reg.AX := 3;
          Intr($33, Reg);
          _mX:=Reg.CX;
          _mY:=Reg.DX;
          _k := Reg.BX;

          if (_k=1) and (_mX >= 20) and (_mX <= 101) and (_mY >= 29) and (_mY <= 51) then runed :=1;

          if keypressed then
          Begin
               k:=readkey;
               if k = #13 then runed:=1;
          End;
     End;
     MouseOff;
     SetFillStyle(1, 0);
     Bar(120, 450, 600, 460);
     while runed = 1 do
     Begin

          if (x >= 130) and (x <= 300) and (y >= 380) and (y <= 420) then vy:= -vy;
          if (x >= 500) and (x <= 250) and (y >= 300) and (y <= 420) then vx:= -vx;
          if (x >= 300) and (x <= 50) and (y >= 500) and (y <= 250) then vy:= -vy;

          if (x >= 50) and (x <= 100) and (y >= 50) and (y <= 250) then runed:= 0;

          setcolor(0);
          Circle(x, y, 20);
          x:=x+vx;
          y:=y+vy;
          setcolor(15);
          Circle(x, y, 20);
          delay(25);
     End;
     OutTextXY(180,450,'Нажмите клавишу Enter для выхода...');
     readkey;
     CloseGraph;
End.

За решение с заданием буду очень благодарен.

@qbfan · 15.09.2021, 17:36

Pascal

uses graph, WinDos, Crt;
var cpu:Tregisters;
 
var mousex,mousey,select:integer;
 
var menu:record n,x0,y0,w,h,h2:integer;end;
 
procedure mouseinit;
begin
cpu.ax:=0;intr($33,cpu);
end;
 
procedure mouseshow;
begin
cpu.ax:=1;intr($33,cpu);
end;
 
procedure mousehide;
begin
cpu.ax:=2;intr($33,cpu);
end;
 
function mousepoll:integer;
begin
cpu.ax:=3;intr($33,cpu);
mousex:=cpu.cx;
mousey:=cpu.dx;
mousepoll:=cpu.bx;
end;
 
procedure menushow;
var i,x,y,c:integer;
begin
x:=menu.x0;y:=menu.y0;
for i:=1 to menu.n do begin
if i=select then c:=1 else c:=0;
SetFillStyle(1,c);
bar(x,y,x+menu.w,y+menu.h);
rectangle(x,y,x+menu.w,y+menu.h);
SetTextJustify(CenterText,CenterText);
if i=1 then OutTextXY(x+menu.w div 2,y+menu.h div 2,'Start')
else        OutTextXY(x+menu.w div 2,y+menu.h div 2,'Stop');
y:=y+menu.h2;
end;
end;
 
procedure menupoll;
var i,x,y:integer;
begin
if mousepoll<>1 then exit;
mousehide;
x:=menu.x0;y:=menu.y0;
for i:=1 to menu.n do begin
if (mousex>x) and (mousey>y)
   and (mousex<x+menu.w) and (mousey<y+menu.h) then select:=i;
y:=y+menu.h2;
end;
menushow;
mouseshow;
end;
 
 
procedure menunew;
begin
select:=0;
with menu do begin
n:=2;
x0:=550;
y0:=400;
w:=80;
h:=20;
h2:=40;
end;
menushow;
end;
 
{Столкновение движ объекта с линией,
где x,y - координаты объекта,dx,dy-знаки
скорости}
{Константа 15 в цикле зависит то радиуса
круга 10 и его скорости 5}
function hit(x,y,dx,dy:integer):integer;
var i,c:integer;
begin
hit:=0;
for i:=0 to 15 do begin
  c:=getpixel(x,y);if c<>0 then hit:=c;
  x:=x+dx;y:=y+dy;
end;
end;
 
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
x,y,r,dx,dy,x0,y0,x1,y1,moving: Integer;
begin
grDriver := vga;
grMode := vgahi;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if ErrCode <> grOk then exit;
menunew;
moving:=0;
r:=10;x:=220;y:=50;
moveto(320,50);
linerel(240-50,240-50);
linerel(-(240-50),240-50);
linerel(-(240-50),-(240-50));
dx:=0;dy:=1;
 
circle(x,y,r);
mouseinit;
mouseshow;
while (select<>2) and (x>=0) do begin
  if select=1 then moving:=1;
  if moving<>0 then begin
    {mousehide;}
    setcolor(0);circle(x,y,r);
    if hit(x,y,0,1)<>0 then begin dx:=1;dy:=0 end;
    if hit(x,y,1,0)<>0 then begin dx:=0;dy:=-1 end;
    if hit(x,y,0,-1)<>0 then begin dx:=-1;dy:=0 end;
    x:=x+5*dx;y:=y+5*dy;
    setcolor(15);circle(x,y,r);
    {mouseshow;}
    Delay(50);
  end;
  menupoll;
end;
SetTextJustify(CenterText,CenterText);
OutTextXY(320,240,'End of Animation. Click Left mouse button.');
while mousepoll<>0 do Delay(50);
while mousepoll=0 do Delay(50);
while mousepoll<>0 do Delay(50);
mousehide;
CloseGraph;
end.

@Decsu · 15.09.2021, 22:44 **[ТС]**

Огромнейшие спасибо

@Decsu 0 / 0 / 0 Регистрация: 08.06.2021 Сообщений: 16
	15.09.2021, 22:44 [ТС]	3
	Огромнейшие спасибо 0

Опции темы

Turbo Pascal, настроить траекторию шарика

Решение