Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 05.06.2012, 18:23   #1 (permalink)
Léon
С# - learn or die
 
Аватар для Léon
 
Регистрация: 17.12.2011
Сообщений: 2,438
Записей в дневнике: 8
Сказал(а) спасибо: 21
Поблагодарили 49 раз(а) в 11 сообщениях
Репутация: 19701
По умолчанию Использование библиотеки модуля GRAPH. Free Pascal

Помогите, пожалуйста! Как сделать, чтобы шар не заходил за границы? Я суть понимаю, а как сделать - нет.
Задание такое: Изобразить на экране движение шара по бильярду без луз (первоначальное перемещение получить случайным образом).
Код:
uses Graph, Crt;
var
 r,p:integer;
 dx,dy,cdx,cdy,x,y:real;
 dt:integer;

 grDriver:integer;
 grMode:integer;
 grPath:string;
 ErrCode:integer;

begin
 grDriver := VGA;
 grMode:=VGAHi;
 grPath:='c:\bp\bgi';

 InitGraph(grDriver, grMode,grPath);
 ErrCode := GraphResult;
 if ErrCode <> grOk then
   begin
     writeln('Ошибка инициализации графического режима');
     writeln('Для завершения работы нажмите <Enter>');
     readln;
     Halt;
  end;
 randomize;
 x:=105+random(400);
 y:=115+random(200);
 r:=10;
 dx:=random(100)-50.5; cdx:=abs(dx)*0.01;
 dy:=random(100)-50.5; cdy:=abs(dy)*0.01;
 dt:=1650;
 Setfillstyle(1,2);
 bar(80,90,560,390);
repeat
        Setfillstyle(1,0);bar(1,1,560,109);
        Setfillstyle(1,0);bar(1,371,580,460);
        Setfillstyle(1,0);bar(1,1,109,390);
        Setfillstyle(1,0);bar(541,1,620,390);
        x:=x+dx;y:=y+dy;
        if (x>535)or(x<105) then dx:=-dx;
        if (y>365)or(y<115) then dy:=-dy;
       SetColor(0);
       circle(round(x),round(y),r);
       Delay(1900);
       SetColor(2);
       Circle(round(x),round(y),r);
       dx:=dx-dx/abs(dx)*cdx;
       dy:=dy-dy/abs(dy)*cdy;
until (keypressed)or(abs(dx)<=0.1)or(abs(dy)<=0.1);
SetColor(0);
Circle(round(x),round(y),r);
delay(50000);
CloseGraph;
end.
Léon вне форума   Ответить с цитированием

Старый 05.06.2012, 18:23
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Рекомендую вам внимательно прочитать содержимое данных тем

Free Pascal, помогите сделать задачу
Помогите решить три задачи в Free Pascal
Пытаюсь разобраться с массивами в Free Pascal IDE
Помогите с матрицами по Free Pascal
Пожалуйста, помогите с программой. Free Pascal

Старый 05.06.2012, 18:59   #2 (permalink)
AlexZir
support
 
Аватар для AlexZir
 
Регистрация: 19.08.2007
Адрес: Зея
Сообщений: 14,457
Записей в дневнике: 57
Сказал(а) спасибо: 123
Поблагодарили 150 раз(а) в 62 сообщениях
Репутация: 59633
По умолчанию

Сделайте ограничение для координат шара, в цикле координаты изменяйте не до минимальной и максимальной, а до минимальная+радиус и максимальная-радиус. Например, предположим, что у вас стенки поля - прямоугольник с координатами (5,5,635,270), а радиус окружности R, тогда, для того, чтобы окружность доходила только до стены при движении, вам нужно изменять координаты центра окружности до координат X->(5+R;635-R), Y->(5+R;270-R). Так как координаты точки взаимодействия окружности и стенки вы задаете случайным образом, то в нашем случае, например, сдвиг можно задавать таким образом: для (x const, y random) - (5+R, random(265)+5+R) или (635-R, random(265)+5-R); для (x random, y const) - (random(630)+5-R, 5+R) или (random(630)+5+R, 270+R). Возможны другие вариации координат.
AlexZir на форуме   Ответить с цитированием
Старый 06.06.2012, 12:23   #3 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от 11Angelav Посмотреть сообщение
Помогите, пожалуйста! Как сделать, чтобы шар не заходил за границы? Я суть понимаю, а как сделать - нет.
Да, Анжелика, задачка-то оказалось - ой! Отладил, конечно, но в итоге какой-то монстр получился, а как иначе - не ведаю. Но уж что есть:
Код:
uses Graph, Crt;
const
 r=10;
 Xmin=80;
 Xmax=560;
 Ymin=90;
 Ymax=390;

function Ball_in(Xb,Yb:Word):Boolean;
begin
 Ball_in:=(Xb>=Xmin+r) and (Xb<=Xmax-r) and
          (Yb>=Ymin+r) and (Yb<=Ymax-r);
end;

function Corner(Xc,Yc:Word):Boolean;
begin
 Corner:=(((Xc-r)=Xmin) and ((Yc+r)=Ymax)) or
         (((Xc-r)=Xmin) and ((Yc-r)=Ymin)) or
         (((Xc+r)=Xmax) and ((Yc+r)=Ymax)) or
         (((Xc+r)=Xmax) and ((Yc-r)=Ymin));
end;

var
 x,y:Word;
 dx,dy,dx1,dy1,s:Integer ;

 grDriver:integer;
 grMode:integer;
 grPath:string;
 ErrCode:integer;

begin
 grDriver := VGA;
 grMode:=VGAHi;
 grPath:='c:\bp\bgi';

 InitGraph(grDriver, grMode,grPath);
 ErrCode := GraphResult;
 if ErrCode <> grOk then
  begin
   writeln('Ошибка инициализации графического режима');
   writeln('Для завершения работы нажмите <Enter>');
   readln;
   Halt;
  end;     
 randomize;
 x:=Xmin+r+random(Xmax-Xmin-2*r);
 y:=Ymin+r+random(Ymax-Ymin-2*r);
 dx:=1+random(7);
 s:=random(2);
 If s=0 then s:=s-1;
 dx:=dx*s;
 dy:=Round(Sqrt(100-Sqr(dx)));
 s:=random(2);
 If s=0 then s:=s-1;
 dy:=dy*s;
 SetBkColor(0);
 Setfillstyle(1,2);
 bar(Xmin,Ymin,Xmax,Ymax);
repeat
 x:=x+dx;
 y:=y+dy;
 If Not(Ball_in(x,y)) then
  begin
   x:=x-dx;
   y:=y-dy;
   if (dx>0) and ((x+dx+r)>Xmax) then
    begin
     dx1:=Xmax-x-r;
     dy1:=Round(dy*dx1/dx);
     x:=x+dx1;
     y:=y+dy1;
     If Not(Ball_in(x,y)) then
      repeat
       x:=x-dx1;
       y:=y-dy1;
       dx1:=dx1-1;
       dy1:=Round(dy*dx1/dx);
       x:=x+dx1;
       y:=y+dy1;
      until Ball_in(x,y);
     dx:=-dx;
    end;
   if (dx<0) and ((x+dx-r)<Xmin) then
    begin
     dx1:=Xmin-x+r;
     dy1:=Round(dy*dx1/dx);
     x:=x+dx1;
     y:=y+dy1;
     If Not(Ball_in(x,y)) then
      repeat
       x:=x-dx1;
       y:=y-dy1;
       dx1:=dx1+1;
       dy1:=Round(dy*dx1/dx);
       x:=x+dx1;
       y:=y+dy1;
      until Ball_in(x,y);
     dx:=-dx;
    end;
   if (dy>0) and ((y+dy+r)>Ymax) then
    begin
     dy1:=Ymax-y-r;
     dx1:=Round(dx*dy1/dy);
     x:=x+dx1;
     y:=y+dy1;
     If Not(Ball_in(x,y)) then
      repeat
       x:=x-dx1;
       y:=y-dy1;
       dy1:=dy1-1;
       dx1:=Round(dx*dy1/dy);
       x:=x+dx1;
       y:=y+dy1;
      until Ball_in(x,y);
     dy:=-dy;
    end;
   if (dy<0) and ((y+dy-r)<Ymin) then
    begin
     dy1:=Ymin-y+r;
     dx1:=Round(dx*dy1/dy);
     x:=x+dx1;
     y:=y+dy1;
     If Not(Ball_in(x,y)) then
      repeat
       x:=x-dx1;
       y:=y-dy1;
       dy1:=dy1+1;
       dx1:=Round(dx*dy1/dy);
       x:=x+dx1;
       y:=y+dy1;
      until Ball_in(x,y);
     dy:=-dy;
    end;
  end;
  SetColor(15);
  SetFillStyle(1,15);
  FillEllipse(x,y,r,r);
  Delay(50);
  SetColor(2);
  SetFillStyle(1,2);
  FillEllipse(x,y,r,r);
 until keypressed or Corner(x,y);
 If KeyPressed then ReadKey;
 SetColor(15);
 SetFillStyle(1,15);
 FillEllipse(x,y,r,r);
 delay(1000);
 CloseGraph;
end.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 06.06.2012, 17:40   #4 (permalink)
Léon
С# - learn or die
 
Аватар для Léon
 
Регистрация: 17.12.2011
Сообщений: 2,438
Записей в дневнике: 8
Сказал(а) спасибо: 21
Поблагодарили 49 раз(а) в 11 сообщениях
Репутация: 19701
По умолчанию

Цитата:
Сообщение от Vladimir_S Посмотреть сообщение
Да, Анжелика, задачка-то оказалось - ой! Отладил, конечно, но в итоге какой-то монстр получился, а как иначе - не ведаю.
Ох, Спасибо огромное Владимир! А я вчера с этой задачей и так, и так....,но не вышло. (Также сделала, чтобы быстрее осуществлялось движение шара.) Очень красиво получилось у Вас, реалистично.
И Алексею спасибо за совет!
Léon вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 21:13.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.