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

[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]

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

вот код:

М

Пожалуйста, используй теги кода, а не цитаты (выпадающее меню 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;

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

  PEllipse= ^TEllipse;
  TEllipse= object(TGraphObject)  {эллипс}
    a,b: Integer;
    constructor InitData(Nx,Ny,a_,b_,c:integer);
    procedure Size(a_,b_: integer);
    procedure Show; virtual;
    procedure Hide; virtual;
  end;


{ ===== TGraphObject }

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

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

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

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

procedure TGraphObject.Show;
begin
  Active:=True;     {сбросим флажок видимости}
end;

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

{ ============ TRectangle }

procedure TRectangle.Show;
begin
  if not Active then begin
    Active:= true;
    SetColor(color);
    Rectangle(x,y,x+ddx,y+ddy)
  end
end;

procedure TRectangle.Hide;
begin
  if Active then begin
    Active:= false;
    SetColor(GetBkColor);
    Rectangle(x,y,x+ddx,y+ddy);
    SetFillStyle(1,1)
  end
end;

{ ============ TCirc }

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

procedure TCirc.Show;
begin
  if not Active then begin
    inherited Show;
    SetColor(color);
    Circle(x,y,Rad)
  end
end;

procedure TCirc.Hide;
begin
  if Active then begin
    inherited Hide;
    SetColor(GetBkColor);
    Circle(x,y,Rad)
  end
end;

{ ============ TEllipse }

constructor TEllipse.InitData;
begin
  inherited Init;
  x:=Nx;
  y:=Ny;
  a:= a_;
  b:= b_;
  Color:=c;
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;

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

const
  m=50;
  DropVx= 1;
  DropVy= 4;
  CircVx= 5;
  CircVy= 2;

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.