Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Равномерное движение шарика по поверхности стола

Автор: Milla 2.12.2007 18:43

Здравствуйте люди добрые, не могли бы помочь переделать немного код программы.

Uses
	Crt,Graph; {Stroka, soobschayuschaya, chto nuzhno vklyuchit' moduli Crt i Graph v programmu}
Const
	a1:string='L A B O R A T O R N A Y A   R A B O T A';
	a2:string='O P R E D E L E N I E   S K O R O S T I   T E L A';
	a3:string='Dlya prodolzheniya nazhmite lyubuyu klavishu';
	a4:string='Vvedite vremya (.1<DT<.5 s) mezhdu vspyshkami.';
	a5:string='Dlya otvoda otvedeno ne bolee 4 znakomest, DT= ';

Var {Opisanie peremennyh}
	fg:string[3];
	af,bf:integer;
	i,gd,gm:integer;
	dt:real;
	x,y:integer;
	cx,cy:integer;
	cxx,cyy:integer;
	ch:char;
	hs,h,g,m:integer;


Procedure start;
  begin
	OutTextXY(200,200,a1);
	OuttextXY(150,250,a2);
	OutTextXY(200,400,a3);
	repeat until keypressed;   {Ozhidanie nazhatiya klavishi}
	SetFillStyle(1,0);	{Stil' i tsvet fona}
	Bar(0,0,640,480);	 {Razmer fona}
  end;


Function table:real;
  Var
	oo:string[4];
	vu,vx,v:integer;
	vy:real;
  begin
	randomize;				 {Vysota stola zadaetsya sluchainym obrazom}
	hs:=random(200)+150;
	h:=470-hs;
	m:=1;
	g:=random(5)+982;
	g:=g div 2;
	SetFillStyle(1,6);	{Stil' i tsvet stola}
	Bar(10,h+7,206,479);
	Line(0,479,640,479);
	SetFillStyle(1,0);
	Bar(30,h+40,186,479);
  end;


Function move:real;
  Var
	oo:string[4];
	vu,vx,v:integer;
	vy:real;
  begin
	SetColor(15);		 {Tsvet kruzhkov}
	v:=random(300)+200;
	for i:=1 to 340 do	{Operator tsikla s parametrom}
		begin
			vx:=i;
			if (vx <= 206) then
				vy:=h
			else
				vy:=h+982/2*(vx-206)*(vx-206)/(v*v);
			vu:=round(vy);
			if (i mod 12=0)then circle(vx,vu,6);
			OutTextXY(510,190,'v =');
			str(v,oo);
			OutTextXY(540,190,oo);
		end; {end otnositsya k operatoru tsikla s parametrom}
  end;


Procedure menu;
  Var
	st,sc:string[3];
  begin
	OutTextXY(af,bf,a4);		{Vyvod teksta v zadannyh koordinatah}
	OutTextXY(af,bf+10,a5);
	OutTextXY(445,130,'probel -prodolzhenie');
	OutTextXY(500,140,chr(24));
	OutTextXY(510,140,'-vverx');
	OutTextXY(500,150,chr(25));
	OutTextXY(510,150,'-vniz');
	OutTextXY(500,160,chr(26));
	OutTextXY(510,160,'-vpravo');
	OutTextXY(500,170,chr(27));
	OutTextXY(510,170,'-vlevo');
	OutTextXY(493,180,' - kursor');
	OutTextXY(500,200,'VIHOD-ESC');

	SetColor(15);
	OutTextXY(500,30,'x=');
	OutTextXY(500,40,'y=');

	SetColor(15);
	str(cx,st);

	Rectangle(550,30,570,40);
	SetFillStyle(6,0);   {Protsedura ispol'zuetsya dlya togo, chtoby tsifry...}
	FloodFill(550,30,0); {...pri dvizhenii kursora ne nakladyvalis' drug na druga}

	OutTextXY(550,30,st);
	str(cy,st);
	OutTextXY(550,40,st);
	SetColor(4);		 {Tsvet ramki, v kotoruyu zaklyucheny znacheniya x i y}
	rectangle(af+450,bf-6,600,bf+70);
  end;


Procedure kursor;
  begin
	cx:=483;					  {Koordinaty mestopolozheniya kursora}
	cy:=183;

	begin
		menu					  {Perehod k protsedure}
	end;

	begin
		table					 {Perehod k funktsii}
	end;


	SetColor(15);				 {Risovanie kursora}
	Line(cx-5,cy,cx+5,cy);
	Line(cx,cy-5,cx,cy+5);
	Circle(cx,cy,5);

	SetColor(4);				  {Tsvet ramki}
	rectangle(af-6,bf-6,400,bf+70);
	read(dt);

	begin
		move					  {Perehod k funktsii}
	end;

	if ((dt > 0.5) or (dt <= 0)) then
		dt:=0;
  end;


Procedure movekursor;
  Var
	st:string[3];
  begin
	ch:=readkey;				  {Schityvanie nazhatoi klavishi}

	SetColor(0);				  {Zakrashivaem sled ot dvizheniya kursora}
	Line(cx-5,cy,cx+5,cy);
	Line(cx,cy-5,cx,cy+5);
	Circle(cx,cy,5);

	if (ord(ch)=72) then cy:=cy-1;{Schityvaem ScanCode s klaviatury i proveryaem sootvetstvuet li on nazhatiyu klavishi}
								  {vverh}
	if (ord(ch)=80) then cy:=cy+1;{Schityvaem ScanCode s klaviatury i proveryaem sootvetstvuet li on nazhatiyu klavishi}
								  {vniz}
	if (ord(ch)=75) then cx:=cx-1;{Schityvaem ScanCode s klaviatury i proveryaem sootvetstvuet li on nazhatiyu klavishi}
								  {vlevo}
	if (ord(ch)=77) then cx:=cx+1;{Schityvaem ScanCode s klaviatury i proveryaem sootvetstvuet li on nazhatiyu klavishi}
								  {vpravo}
	if (cx<6) then cx:=6;		 {Ogranichenie polozheniya kursora pri dvizhenii vlevo}
	if (cx>622) then cx:=622;	 {Ogranichenie polozheniya kursora pri dvizhenii vpravo}
	if (cy<6) then cy:=6;		 {Ogranichenie polozheniya kursora pri dvizhenii vverh}
	if (cy>464) then cy:=464;	 {Ogranichenie polozheniya kursora pri dvizhenii vniz}

	SetColor(15);
	Line(cx-5,cy,cx+5,cy);
	Line(cx,cy-5,cx,cy+5);
	Circle(cx,cy,5);

	cxx:=cx;
	cyy:=cy;

	begin
		menu;					 {Perehod k protsedure}
	end;

	SetColor(15);
	Circle(cx,cy,5);
	Line(cx-5,cy,cx+5,cy);
	Line(cx,cy-5,cx,cy+5);

	if ord(ch)=32 then   {Schityvaem ScanCode s klaviatury, esli nazhata dannaya klavisha, to...}
	  begin
		SetFillStyle(1,0);
		Bar(0,0,640,480);		 {Zakrashivaem ekran}
		kursor;				   {Perehod k protsedure}
	  end;
  end;

  begin
	gd:=detect;				   {Avtomaticheskoe raspoznavanie videoadaptera}
	af:=6;
	bf:=6;

	InitGraph(gd,gm,'d:\tp\bgi'); {Pereklyuchenie v graficheskii rezhim}
	start;						{Perehod k protsedure}
	kursor;					   {Perehod k protsedure}

	repeat
	  movekursor;				 {Perehod k protsedure}
	until
	  ord(ch)=27;   {Schityvaem ScanCode s klaviatury, esli nazhata dannaya klavisha, to...}
  end.							{Okonchanie razdela operatorov}



Собственно вот сам код, программа почти нормально работает, только вот нужно передеалть немного формулу в процедуре move, и возможно в функции table...
Сама программа переделывалась с QBasic'a.

Задание(но с кодом для бэйсика) расположено в Image0046-48.jpg..


Если что-то не так то сильно не ругайте wacko.gif
Буду очень благодарна, заранее спасибо..


Прикрепленный файл  1155.PAS ( 5.99 килобайт ) Кол-во скачиваний: 553
Прикрепленное изображениеПрикрепленное изображениеПрикрепленное изображение

Автор: Milla 3.12.2007 3:01

rolleyes.gif

Автор: Lapp 3.12.2007 13:00

Цитата(Milla @ 2.12.2007 14:43) *

вот нужно передеалть немного формулу в процедуре move, и возможно в функции table...
Что значит переделать? Как переделать? С какой целью?.. blink.gif
Я запустил прогу - действительно, работает.. И шарик летает. Что еще?

Автор: Milla 3.12.2007 21:38

Дело в том, что он иногда летит вверх, чего быть не должно...Значит что то с формулой sad.gif

Автор: Milla 4.12.2007 2:04

10.gif

Автор: Milla 4.12.2007 20:16

эх =( Никто не знает?

Автор: Lapp 5.12.2007 7:34

Цитата(Milla @ 3.12.2007 17:38) *

иногда летит вверх,

У меня он вверх никогда не летел (попробовал раз пять).
Ты можешь выражаться чуть конкретнее? В твоей программе разбираться нелегко, особенно не зная, что зачем. Зачем там курсор? Что он делает? Я могу запустить шарик, а потом двигать курсор. Вопрос: зачем?

Формула, конечно, странная. Достаточно сказать, что ты сначала делишь, а потом сразу же умножаешь на одну и ту жк скобку (это, конечно, не ошибка в алгоритме).

И последнее.. Извини, но разбиратсья в программе, переделанной с бейсика - это хуже не бывает.. Зачем нужно было вообще переделывать? Не проще ли написать новую? Мне кажется, для обучения это полезнее..

Автор: Milla 5.12.2007 23:42

Ну если больше раз попробуешь запустить то полетит %) Задание у меня такое...сделать на паскале ...уже разобралась..там перебор просто шел, longint все это вылечил =) Спасиб, можно закрывать...

Автор: generic zithromax over the count 19.12.2021 2:24

Propecia Generico Marca