ООП в паскале., Нарисовать дождь и круги на воде Опции

[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 - 30.03.2011 3:14

[Lapp]

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

Да, забыл.. Спасибо! klik1602, исправь мою ошибку, пожалуйста.

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

Интересно, что мы оба сочли, что круги на воде нужно делать эллипсами, хотя это так или иначе требует дополнитнльных затрат. Я некоторое время пребывал в сомнениях, сделать ли один массив или все же два разных. В результате покривил душой - заменил массив a на массив кругов и добавил массив эллипсов.. Конечно, с одним массивом лучше, осоебнно для темы ООП. Так что ты бы лучше выложил свой код тоже.. Тема стала бы хорошей демонстрацией разных подходов - половинчатого и целиком-ООП.

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

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