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

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

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

 
 Ответить  Открыть новую тему 
> ООП в паскале., Нарисовать дождь и круги на воде
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Женский
Реальное имя: Натали

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


Добрый вечер, при написании программы возникла проблема с написанием кругов на воде, да и нарисовать воду никак не выходит(( ток дождь, не подскажите, как это сделать?

вот код:
program ll;
{napishite programmu, demonstriruyuchuyu na ekrane padenie dogdevih kapil'i krugi na vode}
Uses
Crt, Graph;
Type
PGraphObject=^TGraphObject;
TGraphObject=object {базовый объект}
Active : Boolean; {признак видимости объекта}
x,y: Integer; {координаты объекта}
Color : Integer; {цвет объекта}

constructor Init; {конструктор объекта}
destructor Done;virtual; {деструктор}

procedure Locate (Nx,Ny:Integer); {задание координат}
procedure Step (Dx,Dy:Integer); {сдвиг объекта}
procedure Move; {хаотичное движение}

procedure Show; {отобразить объект на экране}

procedure Hide; {скрыть объект}

procedure Paint;virtual; {процедура рисования объекта}
procedure Clear;virtual; {процедура стирания объекта}
end;

PRectangle=^TRectangle;
TRectangle=object(TGraphObject) {прямоугольник}
ddx,ddy:Integer; {ширина и высота прямоугольника}
constructor InitData(Nx,Ny,zx,zy,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;

PCirc=^TCirc;
TCirc=object(TGraphObject) {круг}
Rad: Integer;
constructor InitData(Nx,Ny,R,c:integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;

constructor TGraphObject.Init;
begin
Active:=False; {изначально объект невидим}
end;

destructor TGraphObject.Done;
begin
Hide; {перед уничтожением сотрем объект с экрана}
end;

procedure TGraphObject.Locate;
begin
Hide; {скроем объект}
x:=Nx; {зададим новые координаты}
y:=Ny;
Show; {отобразим на новом месте}
end;

procedure TGraphObject.Step;
begin
Hide; {скроем объект}
x:=x+Dx; {переместим объект}
y:=y+Dy;
Show; {отобразим на новом месте}
end;

procedure TGraphObject.Move;
begin
delay(30);
Step(0,3); {шагнем случайным образом}
end;

procedure TGraphObject.Show;
begin
if not Active then {если объект невидим, то...}
begin
Active:=True; {установим флажок видимости}
Paint; {нарисуем объект}
end;
end;

procedure TGraphObject.Hide;
begin
if Active then {если объект видим, то...}
begin
Active:=False; {сбросим флажок видимости}
Clear; {сотрем объект}
end;
end;

procedure TGraphObject.Paint;
begin
end;

procedure TGraphObject.Clear;
begin
end;

procedure InitVideo;
var
grDriver,grMode:Integer;
begin
grDriver:=Detect;
InitGraph(grDriver,grMode,'');
if GraphResult<>grOk then
begin
Writeln('Error!!!!');
Halt(1);
end;
end;

{Возврат в текстовый режим}
procedure DoneVideo;
begin
CloseGraph;
end;

constructor TRectangle.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
ddx:=zx;
ddy:=zy;
Color:=c;
end;

procedure TRectangle.Paint;
begin
SetColor(color);
Rectangle(x,y,x+ddx,y+ddy);
end;

procedure TRectangle.Clear;
begin
SetColor(1);
Rectangle(x,y,x+ddx,y+ddy);
SetFillStyle(1,1);
end;

constructor TCirc.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
Rad:=R;
Color:=c;
end;

procedure TCirc.Paint;
begin
SetColor(color);
Circle(x,y,Rad);
end;

procedure TCirc.Clear;
begin
SetColor(1);
Circle(x,y,Rad);
end;



Var
a,b:array[1..200] of PGraphObject; {массив произвольных объектов}
i,j:Integer;
pryam:PGraphObject;

begin

ClrScr;
InitVideo;
SetBkColor(1);
pryam:=New (PRectangle, InitData (0,0,100,100,0));

Randomize;
for i:=1 to 200 do
a[i]:=New(PCirc, InitData(0+Random(getmaxx),0+Random(getmaxy), 1,9));

while not KeyPressed do
for i:=1 to 200 do
a[i]^.Move;
a[i]^.Done;
ReadKey;

for i:=1 to 200 do
Dispose (a[i],Done);
{Возвращаемся в текстовый режим}
DoneVideo;
End.


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


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

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

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


Цитата(klik1602 @ 29.03.2011 22:19) *
возникла проблема с написанием кругов на воде, да и нарисовать воду никак не выходит(( ток дождь, не подскажите, как это сделать?

вот код:

М
Пожалуйста, используй теги кода, а не цитаты (выпадающее меню CODE над окном ввода).



Как я понял, прога не твоя, и ты пыталась ее адаптировать под свою задачу.. Очень много лишнего, я полно выкинул. Например - какой глубокий смысл в использовании Show/Hide И Paint/Clear? Почему мы не добавить еще несколько уровней? smile.gif
Добавил объект Эллипс (поскольку круги на воде всегда видны сбоку).
Разбирайся. Что неясно - спрашивай.
Писалось под FPC, на TP не проверял (Показать/Скрыть)


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


Гость






Андрей, у тебя память, выделенная под Эллипсы, не освобождается.

Я тут тоже кое-что наваял, но раз уж есть - то выкладывать не буду. Правда, я сделал чуть по-другому: как только капля достигает "уровня земли" - я удаляю из массива объект "капля", и инициализирую этот же элемент объектом "эллипс", то есть, все действие происходит в одном массиве, и фактически вызовом одного метода (виртуального, разумеется), нет засилья if-ов, все решает полиморфизм... Ну, да и фиг с ним... Пусть остается у меня в коллекции, может еще кому понадобится...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Женский
Реальное имя: Натали

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


большое спасибо за помощь, исходный текст программы действительно не мой, и я действительно) пыталась его адаптировать под себя)

for i:=1 to m do begin
with a[i]^ do
if y>GetMaxY-h+Random(h) then begin
b[i]^.Locate(x,y);
Locate(Random(GetMaxX+1),1);
Show
end
else Locate(x+DropVx,y+DropVy);
with b[i]^ do if Active then
if a<=MaxCircR then Size(a+CircVx,b+CircVy) else begin
Hide;
Size(CircVx,CircVy)
end
end

не могли бы вы для этой части написать комментарии, а то я как-то не понимаю, что к чему..
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


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

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

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


Цитата(volvo @ 30.03.2011 13:06) *
Андрей, у тебя память, выделенная под Эллипсы, не освобождается.
Да, забыл.. Спасибо! smile.gif klik1602, исправь мою ошибку, пожалуйста.

Цитата
Я тут тоже кое-что наваял, но раз уж есть - то выкладывать не буду. Правда, я сделал чуть по-другому: как только капля достигает "уровня земли" - я удаляю из массива объект "капля", и инициализирую этот же элемент объектом "эллипс", то есть, все действие происходит в одном массиве, и фактически вызовом одного метода (виртуального, разумеется), нет засилья if-ов, все решает полиморфизм... Ну, да и фиг с ним... Пусть остается у меня в коллекции, может еще кому понадобится...
Интересно, что мы оба сочли, что круги на воде нужно делать эллипсами, хотя это так или иначе требует дополнитнльных затрат. Я некоторое время пребывал в сомнениях, сделать ли один массив или все же два разных. В результате покривил душой - заменил массив a на массив кругов и добавил массив эллипсов.. sad.gif Конечно, с одним массивом лучше, осоебнно для темы ООП. Так что ты бы лучше выложил свой код тоже.. Тема стала бы хорошей демонстрацией разных подходов - половинчатого и целиком-ООП.

Цитата(klik1602 @ 30.03.2011 21:33) *
не могли бы вы для этой части написать комментарии, а то я как-то не понимаю, что к чему..


const
m=50; // общее кол-во капель (можно легко менять)
DropVx= 1; // скорость капли по горизонтали (ветер))
DropVy= 4; // скорость падения капли
CircVx= 5; // скорость расхождения кругов по Х
CircVy= 2; // скорость расхождения кругов по Y
// чем больше отношение CircVx/CircVy, тем более сплюснутый эллипс
..........

h:= GetMaxY div 5; // высота полосы поверхности (земли или воды - главное, что не воздух)
MaxCircR:= GetMaxX div 10; // макс радиус кругов

..........

for i:=1 to m do begin // цикл по всем объектам (обоих видов)
with a[i]^ do // обработка капель
if y>GetMaxY-h+Random(h) then begin // если капля достигла земли ...
// (случайный разбаланс по высоте симулирует расстояние от смотрящего)
b[i]^.Locate(x,y); // задаем центр будущего круга текущими координатами капли
Locate(Random(GetMaxX+1),1); // запускаем каплю заново сверху
Show // лишнее, убери
end
else Locate(x+DropVx,y+DropVy); // если капля еще в воздухе, продожаем ее падение
// (увеличиваем координаты)

with b[i]^ do if Active then // обрабатываем круги
if a<=MaxCircR then Size(a+CircVx,b+CircVy) // если круг еще не очень большой, увеличиваем его
else begin // если больше макс радиуса ...
Hide; // .. прячем ..
Size(CircVx,CircVy) // .. и подготавливаем размер для будущей жизни ))
end
end



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


Гость






Цитата
Так что ты бы лучше выложил свой код тоже..
Ну, тогда выкладываю:
Прикрепленный файл  rain_02.pas ( 4.31 килобайт ) Кол-во скачиваний: 339


Комментариев в коде нет совсем, если есть вопросы - задавайте, попробую ответить. Программа тестировалась под FPC, в Турбо-Паскале компилироваться не будет однозначно, абстрактных методов там еще нет.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


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

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

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


Я балдею, насколько ход мысли у нас был одинаковый (по оформлению)! Глубина (deep | h), скорости, максимальный радиус.. smile.gif) кул! smile.gif
Цитата(volvo @ 31.03.2011 0:29) *
в Турбо-Паскале компилироваться не будет однозначно, абстрактных методов там еще нет.
А когда ожидаются? lol.gif


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


Гость






Цитата
А когда ожидаются?
unsure.gif Я ж написал "еще", а не "пока"... В Турбо еще нет, в Object уже есть...
 К началу страницы 
+ Ответить 

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

 





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