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

> Создать град(отскакивающий от объекта), Графика в Паскале
сообщение
Сообщение #1





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

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


Вот, попросили сделать задачу на Паскале..
Я взялся, даже не посмотрев... Оказалось, там требуется знание графических приемов программирования в Паскале... А я тогда вообще ничего не шарил... Ладно, большинство задач сделал, осталась одна - последняя:

Нарисовать на Паскале град, падающий и отскакивающий от объекта.

Так как я за такие вещи раньше никогда не брался, то с непревычки оказалось трудно... Дальше последует код, а пока 2 вопроса:
1)Как сделать так, чтобы при достижении градинок определенной границы, эти градинки продолжали движение, и создавались новые(т.е как бы создавался непрерывный поток)
2) Как "уловить" кривую" линию объекта(крыши дома, например)

Вот код(c пояснениями) моей так называемой программы. Это далеко не законченный вариант, ибо у меня уже опускаются руки(может, ночь просто?):

Код

program rain;
uses graph,crt;

type grad = object    
{создается тип "град"}                                                                                  
x,y:integer;
radius:word;
dx,dy:shortint;

constructor     initgrad(x0,y0:integer; radius0: word; dx0,dy0: shortint);
{Конструктор - создатель града  }        
procedure show;
procedure hide;
procedure move;
procedure checkborder;
end;

var gd,gm,i,x,Radius,dx,y,dy:integer;
grads:array[1..50] of grad;                                                                          
{Массив градин}

procedure creategrad(k,x,y:integer);                                  
{  k - если=0, то создается "кучка" градин, если  k<>0(=i), то создается одна градина с
текущими кординатами   }
        
begin
if k=0 then
for i:=1 to 10 do
begin
Radius:=3;
dy:=1;
y:=random(100);
grads[i].initgrad(random(Getmaxx),y,radius,0,dy);
end else
grads[k].initgrad(random(getmaxx),y,radius,0,dy);
end;


procedure grad.move;
begin
x:=x+dx;
y:=y+dy;
end;

procedure grad.show;
begin
SetFillStyle(1,8);
FillEllipse(x,y,radius,radius);
end;

procedure grad.hide;
begin
setcolor(black);
FillEllipse(x,y,radius,radius);
end;

procedure grad.checkborder;        
{Это я на CheckBorder'е и запарился!!!!!!}                            
begin
if y=250 then  creategrad(i,x,random(10));
end;


constructor grad.initgrad(x0,y0:integer; radius0: word; dx0,dy0: shortint);
begin
x:=x0;
y:=y0;
Radius:=Radius0;
dx:=dx0;
dy:=dy0;
end;

begin
    initgraph(gd,gm,'');
    if graphresult<> grOk then begin
    writeln('No graphics');
    readln;
    halt;
    end;
    creategrad(0,x,y);

repeat
cleardevice;

for i:=1 to 10 do
begin
randomize;
grads[i].show;
end;

delay(500);

for i:=1 to 10 do
grads[i].hide;

for i:=1 to 10 do
begin
grads[i].move;
grads[i].checkborder;
end;

until keypressed;

readln;
closegraph;
end.





Вообщем, помогите, кто чем может - исходниками, советами.... Выручайте... unsure.gif
ЗЫ: Может, удобней будет посмотреть мою ошибку - выложил этот исходник...

Сообщение отредактировано: Shpion -


Прикрепленные файлы
Прикрепленный файл  LAB5_GRA.zip ( 701 байт ) Кол-во скачиваний: 255
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 5)
сообщение
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 160
Пол: Мужской
Реальное имя: Серый

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


Единственное, что могу - дать совет: проверяй цвет точки, в которой "градина" должна оказаться в с следующий момент. Если бы "градины" были единичного размера, было бы еще проще. Короче алгоритм такой - "градина" двигается (к примеру) по сложной траектории с учетом притяжения и, скажем, ветра. Поверхность на которую она падает - произвольная: тогда бери функцию расчета траектории и смотри куда попадет точка перед отрисовкой (т.е. проверь цвет точки, прежде чем рисовать туда "градину"). Если цвет фона (т.е. ничего нет) - тогда перемещай; если нет - изменяй траекторию (т.е., к примеру, запрещай движение по одной из осей). Насколько я понял, в твоей проге фон одноцветный, а не битмап, так что можно это использовать.

P.S. Кстати, на твоем месте я бы сделал создание новой градины по завершению движения. Т.е.: если какая-то градина остановилась, то создаем еще одну. (А создавать штук по 10). Правда, это потребует более продвинутой "физики" - надо будет учитывать возможность потери "энергии", т.е. замедления и остановки.

Сообщение отредактировано: AlienEmperor -


--------------------
Все в жизни ботва... Кроме пчел!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Профи
****

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

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


В самом начале создавай столько градин, сколько нужно. При достижении градиной границ экрана инициализируй её параметры заново (y := 0; x := random(getmaxx); и тд, короче, повторный вызов конструктора). Тут правда если с отскакиванием, может получиться, что градина будет вечно прыгать и за границы экрана не упадёт, но можно ввести для каждой градины "время жизни" и перед прорисовкой вычитать из него 1. Когда оно заканчивается делаем тоже что и при выходе за границу.

На градины по вертикали действует сила тяжести, по горизонтали - ветер. Так что движение надо делать с ускорением. Например так:
procedure grad.move;
begin
dx := dx + ddx;
dy := dy + ddy;
x := round(x + dx);
y := round(y + dy);
end;

При этом dx, dy, ddx, ddy : real. И пусть ddx и ddy немного отличаются у разных градинок. Это чтобы падали они с разной скоростью и углы падения немного отличались. Лучше будет смотреться.

Для отскакивания следует определиться, как задавать объекты (вроде крыши). Вариант с GetPixel мне не нравится тк сложно направление отскока определить. Shpion, а тебе обязательно нужно отскакивание от кривых поверхностей, может просто наклонных?

Для отскакивания от плоской горизонтальной крыши сделать можно так:

if y >= yroof then
begin
dy := -dy * k;
dx := dx * k;
end;

где yroof - уровень крыши, а k < 1 - коэфициент "потерь", для того чтобы градины до потолка не отскакивали smile.gif.

Да и градины лучше точечные - проще будет.


--------------------
Close the World...txeN eht nepO
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


ВСЕМ СПАСИБО! good.gif На днях обязательно опробую...

2 Archon:
Это задачка для 1-го курса Пед-института, так, что, я думаю, заморачиваться особо не нужно... Отскок, естественно не от кривых, а от наклонных/прямых поверхностей(домика, например)...

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





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

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


Опять возникли проблемы:
Код

program rain;
uses graph,crt;

type grad = object
x,y:integer;
radius:word;
dx,dy,ddx,ddy:real;

constructor     initgrad(x0,y0:integer; radius0: word; dx0,dy0,ddx0,ddy0: real);
procedure show;
procedure hide;
procedure move;
procedure checkborder;
end;

const maxgrads=30;


var gd,gm,i,x,y,Radius:integer;
dx,dy,ddx0,ddy0:real;
grads:array[1..50] of grad;

procedure dom;
begin
Setcolor($eeee);
Rectangle(getmaxx-400,getmaxy,getmaxx-200,getmaxy-100);
line(getmaxX-400,getmaxy-100,getmaxx-300,getmaxy-200);
line(getmaxx-300,getmaxy-200,getmaxx-200,getmaxy-100);
end;

procedure creategrad(k,x,y:integer);
begin

dx:=random(6)/3;
if k=0 then
for i:=1 to maxGrads  do
begin
Radius:=3;
dy:=1;
dx:=random(2);
y:=random(GetMaxY);
grads[i].initgrad(random(getmaxx),random(getmaxy),radius,dx,dy,0,0);
end else
grads[k].initgrad(x,y,radius,dx,1,0,0);
end;


procedure grad.move;
begin
dx:=dx+ddx;
dy:=dy+ddy;
x:=round(x+dx);
y:=round(y+dy);

end;

procedure grad.show;
begin
setfillstyle(1,9);
FillEllipse(x,y,radius,radius);
end;

procedure grad.hide;
begin
setcolor(black);
FillEllipse(x,y,radius,radius);
end;

procedure grad.checkborder;
begin
if y=GetMaxY then  creategrad(i,Random(GetMaxX),0)
else
if (getpixel(x,y)=$eeee) then begin
dy:=-dy*0.6;
dx:=dx*0.6;
end;
end;


constructor grad.initgrad(x0,y0:integer; radius0: word; dx0,dy0,ddx0,ddy0: real);
...

begin

...

creategrad(0,x,y);

repeat

cleardevice;

dom;
setcolor(black);

for i:=1 to maxgrads do
begin
grads[i].show;
end;

delay(60);

for i:=1 to maxgrads do
begin
grads[i].hide;
end;

for i:=1 to maxgrads do
begin
grads[i].checkborder;
grads[i].move;
end;

until keypressed;

closegraph;
end.


1)При повышении скорости dy больше 1, градины начинают постепенно пропадать
2)Так и не смог разобраться с:
2.1)Как "уловить" наклонную поверхность? Я пытался создавать массив точек.. ну, короче, делал чепуху.. mega_chok.gif
2.2)С GetPixel не получается... Цвета не сравнивает
2.3)Если установить на градину таймер, то она будет просто исчезать?
2.4) Отскакивает резко вверх, вообщем некрасиво...

Выкладываю исходник:
2.2)


Прикрепленные файлы
Прикрепленный файл  LAB5_GRA.zip ( 891 байт ) Кол-во скачиваний: 238
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Профи
****

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

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


Рассмотрим этот участок кода:
procedure grad.checkborder;
begin
if y=GetMaxY then creategrad(i,Random(GetMaxX),0)
else
if (getpixel(x,y)=$eeee) then begin
dy:=-dy*0.6;
dx:=dx*0.6;
end;
end;

1) надо писать ... if y >= GetMaxY then ... (больше или равно)
2.1) Позже напишу, а для начала сделай отскакивание от плоской горизонтальной крыши шириной во весь экран
2.2) GetPixel в этой задаче не очень рулит. Сделай проверку по координатам. Для горизонтальной крыши я уже писал.
2.3)
Цитата
Когда оно заканчивается делаем тоже что и при выходе за границу.
То есть добавь в сравнение с GetMaxY проверку на истекание жизненного срока:
if (y>=GetMaxY) or (life_time <= 0) then creategrad(i,Random(GetMaxX),0)

2.4) У тебя коэффициенты слишком большие (0.6) поставь 0.1 или даже 0.05.

Я твой код поподробней потом посмотрю и тогда скажу больше.

Сообщение отредактировано: volvo -


--------------------
Close the World...txeN eht nepO
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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