|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
05.06.2012, 18:23 | #1 (permalink) |
С# - learn or die
Регистрация: 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. |
05.06.2012, 18:23 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Рекомендую вам внимательно прочитать содержимое данных тем Free Pascal, помогите сделать задачу Помогите решить три задачи в Free Pascal Пытаюсь разобраться с массивами в Free Pascal IDE Помогите с матрицами по Free Pascal Пожалуйста, помогите с программой. Free Pascal |
05.06.2012, 18:59 | #2 (permalink) |
support
Регистрация: 19.08.2007
Адрес: Зея
Сообщений: 15,794
Записей в дневнике: 71
Сказал(а) спасибо: 166
Поблагодарили 203 раз(а) в 86 сообщениях
Репутация: 75760
|
Сделайте ограничение для координат шара, в цикле координаты изменяйте не до минимальной и максимальной, а до минимальная+радиус и максимальная-радиус. Например, предположим, что у вас стенки поля - прямоугольник с координатами (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). Возможны другие вариации координат.
|
06.06.2012, 12:23 | #3 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Код:
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. |
|
06.06.2012, 17:40 | #4 (permalink) | |
С# - learn or die
Регистрация: 17.12.2011
Сообщений: 2,438
Записей в дневнике: 8
Сказал(а) спасибо: 21
Поблагодарили 49 раз(а) в 11 сообщениях
Репутация: 19701
|
Цитата:
И Алексею спасибо за совет! |
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|