Помощь - Поиск - Пользователи - Календарь
Полная версия: ООП в паскале.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
klik1602
Добрый вечер, при написании программы возникла проблема с написанием кругов на воде, да и нарисовать воду никак не выходит(( ток дождь, не подскажите, как это сделать?

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

вот код:

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



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

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

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

не могли бы вы для этой части написать комментарии, а то я как-то не понимаю, что к чему..
Lapp
Цитата(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

volvo
Цитата
Так что ты бы лучше выложил свой код тоже..
Ну, тогда выкладываю:
Нажмите для просмотра прикрепленного файла

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