IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Равномерное движение шарика по поверхности стола, Равномерное движение шарика по поверхности стола
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


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

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 килобайт ) Кол-во скачиваний: 320
Прикрепленное изображениеПрикрепленное изображениеПрикрепленное изображение

Сообщение отредактировано: Lapp -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


rolleyes.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


Дело в том, что он иногда летит вверх, чего быть не должно...Значит что то с формулой sad.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


10.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


эх =( Никто не знает?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


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

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

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

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

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8





Группа: Пользователи
Сообщений: 9
Пол: Женский

Репутация: -  0  +


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

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.10.2020 22:10
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name