Добрый вечер, при написании программы возникла проблема с написанием кругов на воде, да и нарисовать воду никак не выходит(( ток дождь, не подскажите, как это сделать?
вот код:
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 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;
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 30.03.2011 15:38
Цитата(klik1602 @ 29.03.2011 22:19)
возникла проблема с написанием кругов на воде, да и нарисовать воду никак не выходит(( ток дождь, не подскажите, как это сделать?
вот код:
М
Пожалуйста, используй теги кода, а не цитаты (выпадающее меню CODE над окном ввода).
Как я понял, прога не твоя, и ты пыталась ее адаптировать под свою задачу.. Очень много лишнего, я полно выкинул. Например - какой глубокий смысл в использовании Show/Hide И Paint/Clear? Почему мы не добавить еще несколько уровней? Добавил объект Эллипс (поскольку круги на воде всегда видны сбоку). Разбирайся. Что неясно - спрашивай.
Писалось под FPC, на TP не проверял(Показать/Скрыть)
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 Show; virtual; {отобразить объект на экране} procedure Hide; virtual; {скрыть объект} procedure Move(dx,dy: integer); {передвинуть} end;
PRectangle=^TRectangle; TRectangle=object(TGraphObject) {прямоугольник} ddx,ddy:Integer; {ширина и высота прямоугольника} constructor InitData(Nx,Ny,zx,zy,c:Integer); procedure Show; virtual; procedure Hide; virtual; end;
procedure TEllipse.Show; begin if not Active then begin Active:= true; SetColor(color); Ellipse(x,y,0,360,a,b) end end;
procedure TEllipse.Hide; begin if Active then begin Active:= false; SetColor(GetBkColor); Ellipse(x,y,0,360,a,b) end end;
procedure TEllipse.Size; var f: boolean; begin f:= Active; Hide; a:= a_; b:= b_; if f then Show end;
{ ============ procedures and functions }
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;
Var a: array[1..m] of PCirc; b: array[1..m] of PEllipse; i,j,h,MaxCircR:Integer; pryam:PGraphObject;
begin InitVideo; h:= GetMaxY div 5; MaxCircR:= GetMaxX div 10;
for i:=1 to m do begin a[i]:=New(PCirc, InitData(Random(GetMaxX+1),Random(GetMaxY-h), 2, LightCyan)); a[i]^.Show; b[i]:=New(PEllipse, InitData(0, 0, CircVx, CircVy, LightBlue)); end;
while not KeyPressed do begin delay(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 end; ReadKey; for i:=1 to m do Dispose (a[i],Done); {Возвращаемся в текстовый режим} DoneVideo; End.
Автор: volvo 30.03.2011 17:06
Андрей, у тебя память, выделенная под Эллипсы, не освобождается.
Я тут тоже кое-что наваял, но раз уж есть - то выкладывать не буду. Правда, я сделал чуть по-другому: как только капля достигает "уровня земли" - я удаляю из массива объект "капля", и инициализирую этот же элемент объектом "эллипс", то есть, все действие происходит в одном массиве, и фактически вызовом одного метода (виртуального, разумеется), нет засилья if-ов, все решает полиморфизм... Ну, да и фиг с ним... Пусть остается у меня в коллекции, может еще кому понадобится...
Автор: klik1602 31.03.2011 1:33
большое спасибо за помощь, исходный текст программы действительно не мой, и я действительно) пыталась его адаптировать под себя)
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 31.03.2011 3:20
Цитата(volvo @ 30.03.2011 13:06)
Андрей, у тебя память, выделенная под Эллипсы, не освобождается.
Да, забыл.. Спасибо! klik1602, исправь мою ошибку, пожалуйста.
Цитата
Я тут тоже кое-что наваял, но раз уж есть - то выкладывать не буду. Правда, я сделал чуть по-другому: как только капля достигает "уровня земли" - я удаляю из массива объект "капля", и инициализирую этот же элемент объектом "эллипс", то есть, все действие происходит в одном массиве, и фактически вызовом одного метода (виртуального, разумеется), нет засилья if-ов, все решает полиморфизм... Ну, да и фиг с ним... Пусть остается у меня в коллекции, может еще кому понадобится...
Интересно, что мы оба сочли, что круги на воде нужно делать эллипсами, хотя это так или иначе требует дополнитнльных затрат. Я некоторое время пребывал в сомнениях, сделать ли один массив или все же два разных. В результате покривил душой - заменил массив a на массив кругов и добавил массив эллипсов.. Конечно, с одним массивом лучше, осоебнно для темы ООП. Так что ты бы лучше выложил свой код тоже.. Тема стала бы хорошей демонстрацией разных подходов - половинчатого и целиком-ООП.
Цитата(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
Комментариев в коде нет совсем, если есть вопросы - задавайте, попробую ответить. Программа тестировалась под FPC, в Турбо-Паскале компилироваться не будет однозначно, абстрактных методов там еще нет.
Автор: Lapp 31.03.2011 10:05
Я балдею, насколько ход мысли у нас был одинаковый (по оформлению)! Глубина (deep | h), скорости, максимальный радиус.. ) кул!
Цитата(volvo @ 31.03.2011 0:29)
в Турбо-Паскале компилироваться не будет однозначно, абстрактных методов там еще нет.
А когда ожидаются?
Автор: volvo 31.03.2011 13:01
Цитата
А когда ожидаются?
Я ж написал "еще", а не "пока"... В Турбо еще нет, в Object уже есть...