---------модуль ulabrab-------------

unit ULABRAB;
interface
uses Graph,Crt,UVIDEO,UDIAGRAM;
type
PMyFigure1=^TMyFigure1;
  TMyFigure1=object(TCircle)
  private
    x3,y3,r1:integer;
  public
    constructor init(xfig,yfig:integer; ar:word; acolor_fig:byte);
    destructor done;                      virtual;
    procedure dx_dy(dxfig,dyfig:integer);virtual;
    procedure draw;                      virtual;
  end;
PMyFigure2=^TMyFigure2;
  TMyFigure2=object(TFigure)
  private
    Figure1:TMyFigure1; Line:TLine;
  public
    constructor init(xfig,yfig:integer; ar:word; acolor_fig:byte);
    destructor done;                      virtual;
    procedure dx_dy(dxfig,dyfig:integer);virtual;
    procedure draw;                      virtual;
  end;
PMyFigure3=^TMyFigure3;
     TMyFigure3=object(TFigure)
     private
     Figures:array[1..6] of PFigure;
     public
       constructor init(xfig,yfig:integer; ar:word; acolor_fig:byte);
       destructor done;                      virtual;
       procedure dx_dy(dxfig,dyfig:integer); virtual;
       procedure draw;                       virtual;
     end;

PMyFigure4=^TMyFigure4;
     TMyFigure4=object(TMyFigure3)
      private
       s:boolean; xf,yf:integer;
      public
       constructor init(axf,ayf:integer; ar:word; acolor_fig:byte);
       procedure moveTraject(at:integer);
       procedure dx_dy(dxfig,dyfig:integer); virtual;
     end;

implementation

constructor TMyFigure1.init(xfig,yfig:integer; ar:word; acolor_fig:byte);
    begin
      inherited init(xfig, yfig - ar div 2 - ar, ar div 2, acolor_fig);
      x3:=xfig;
      y3:=yfig;
      r1:=ar;
    end;

  destructor TMyFigure1.done;
    begin
      inherited done;
      circle(x3,y3,r1);
    end;

  procedure TMyFigure1.dx_dy(dxfig,dyfig:integer);
    begin
      inherited dx_dy(dxfig, dyfig);
      x3:=x3+dxfig;
      y3:=y3+dyfig;
    end;

  procedure TMyFigure1.draw;
    begin
      inherited draw;
      circle(x3,y3,r1);
    end;

  constructor TMyFigure2.init(xfig,yfig:integer; ar:word; acolor_fig:byte);
    begin
      Line.init(xfig-ar,yfig,xfig+ar,yfig,acolor_fig);
      Figure1.init(xfig,yfig,ar,acolor_fig);
    end;

  destructor TMyFigure2.done;
    begin
      Line.done;
      Figure1.done;
    end;

  procedure TMyFigure2.dx_dy(dxfig,dyfig:integer);
    begin
      Figure1.dx_dy(dxfig,dyfig);
      Line.dx_dy(dxfig,dyfig);
    end;

  procedure TMyFigure2.draw;
    begin
      Figure1.draw;
      Line.draw;
    end;
constructor TMyFigure3.init(xfig,yfig:integer; ar:word; acolor_fig:byte);
      begin
       Figures[1]:=new(PMyFigure1,init(xfig,yfig,ar,acolor_fig));
       Figures[2]:=new(PMyFigure2,init(xfig+2*ar,yfig+3*ar,ar*2,acolor_fig));
       Figures[3]:=new(PMyFigure1,init(xfig+4*ar,yfig,ar,acolor_fig));
       Figures[4]:=new(PLine,init(xfig+2*ar,yfig-ar,xfig+2*ar,yfig+5*ar,acolor_fig));
       Figures[5]:=new(PCircle,init(xfig-ar div 2,yfig+3*ar,ar div 2,acolor_fig));
       Figures[6]:=new(PCircle,init(xfig+5*ar-ar div 2,yfig+3*ar,ar div 2,acolor_fig));
      end;
 destructor TMyFigure3.done;
   var i:byte;
      begin
       for i:=1 to 6 do
	 Figures[i]^.done;
      end;
 procedure TMyFigure3.dx_dy(dxfig,dyfig:integer);
   var i:byte;
      begin
       for i:=1 to 6 do
	 Figures[i]^.dx_dy(dxfig,dyfig);
      end;
 procedure TMyFigure3.draw;
   var i:byte;
      begin
       for i:=1 to 6 do
	 Figures[i]^.draw;
      end;
constructor TMyFigure4.init(axf,ayf:integer; ar:word; acolor_fig:byte);
      begin
       if (axf<0) or (axf>Video.getXmax) then xf:=(Video.getXmax div 2)
					 else xf:=axf;
       if (ayf<0) or (ayf>Video.getYmax) then yf:=(Video.getYmax div 2)
					 else yf:=ayf;
       inherited init(xf,yf,ar,acolor_fig);
       s:=true
      end;

     procedure TMyFigure4.moveTraject(at:integer);
      
{здесь расчет передвижения}

     procedure TMyFigure4.dx_dy(dxfig,dyfig:integer);
      begin
       inherited dx_dy(dxfig,dyfig);
      end;
end.

---------модуль laba_4----------

program LABRAB;
uses ULABRAB,Crt,UVIDEO;

var MyFigure4: PMyFigure4;
begin
 Video.init('4');
 new(MyFigure4,init(0,0,20,Green));
 MyFigure4^.moveTraject(2);
 dispose(MyFigure4,done);
 Video.done;
end.

---------модуль uVIDEO-----------

unit UVIDEO;
interface

type
  TVideo=object
    private
     n:char;
    public
      procedure init(an:char);
      function getXmax: integer;
      function getYmax: integer;
      procedure done;
  end;

var Video: TVideo;

implementation

uses Graph;
  procedure TVideo.init(an:char);
    var
      dr, md: integer;
    begin
      n:=an;
      dr:=detect;
      Initgraph(dr,md, '..\bgi');
      if GraphResult <> GrOk then begin
	writeln('error graph init');
	halt(1);
      end;
      OutTextXY(200,30, 'Lab.  , exit - any key');
      OutTextXY(240,30,n);
    end;

  function TVideo.getXmax: integer;
    begin
      getXmax:=getMaxX;
    end;
  function TVideo.getYmax: integer;
    begin
      getYmax:=getMaxY;
    end;

  Procedure TVideo.done;
   begin
    CloseGraph;
   end;
end.

--------------модуль udiagram---------

unit UDIAGRAM;
interface
type
PFigure=^TFigure;
  TFigure=object
  private
    color:byte;
  public
    constructor init(acolor:byte);
    procedure move(dx,dy:integer);
    destructor done;                   virtual;
    procedure dx_dy(dxf,dyf:integer); virtual;
    procedure draw;                   virtual;
  end;
  TPoint=object(TFigure)
  private
    x,y:integer;
  public
    constructor init(ax,ay:integer; acolor_p:byte);
    destructor done;                   virtual;
    procedure dx_dy(dx,dy:integer);   virtual;
    procedure draw;                   virtual;
  end;
PCircle=^TCircle;
  TCircle=object(TPoint)
  private
    r:word;
  public
    constructor init(axc,ayc:integer; ar:word; acolor_c:byte);
    destructor done;                   virtual;
    procedure draw;                   virtual;
  end;
PLine=^TLine;
  TLine=object(TFigure)
  private
    x1,y1,x2,y2:integer;
  public
    constructor init(ax1,ay1,ax2,ay2:integer; acolor_l:byte);
    destructor done;                    virtual;
    procedure dx_dy(dxln,dyln:integer);virtual;
    procedure draw;                    virtual;
  end;

implementation

uses Graph,Crt;

  constructor TFigure.init(acolor:byte);
    begin
      color:=acolor;
    end;
  procedure TFigure.move(dx,dy:integer);
    begin
      while not keypressed do
        begin
	  done;
	  dx_dy(dx,dy);
	  draw;
	end;
    end;
  destructor TFigure.done;
    begin
    end;
  procedure TFigure.dx_dy(dxf,dyf:integer);
    begin
    end;
  procedure TFigure.draw;
    begin
    end;
  constructor TPoint.init(ax,ay:integer; acolor_p:byte);
    begin
      inherited init(acolor_p);
      x:=ax;
      y:=ay;
    end;
  destructor TPoint.done;
    begin
      PutPixel(x,y,GetBkColor);
    end;
  procedure TPoint.dx_dy(dx,dy:integer);
    begin
      x:=x+dx;
      y:=y+dy;
    end;
  procedure TPoint.draw;
    begin
      PutPixel(x,y,color);
    end;
  constructor TCircle.init(axc,ayc:integer; ar:word; acolor_c:byte);
    begin
      inherited init(axc,ayc,acolor_c);
      r:=ar;
    end;
  destructor TCircle.done;
    begin
      SetColor(GetBkColor);
      Circle(x,y,r);
    end;
  procedure TCircle.draw;
    begin
      SetColor(color);
      Circle(x,y,r);
    end;
  constructor TLine.init(ax1,ay1,ax2,ay2:integer; acolor_l:byte);
    begin
      inherited init(acolor_l);
      x1:=ax1;
      y1:=ay1;
      x2:=ax2;
      y2:=ay2;
    end;
  destructor TLine.done;
    begin
      SetColor(GetBkColor);
      Line(x1,y1,x2,y2);
    end;
  procedure TLine.dx_dy(dxln,dyln:integer);
    begin
      x1:=x1+dxln;
      y1:=y1+dyln;
      x2:=x2+dxln;
      y2:=y2+dyln;
	end;
  procedure TLine.draw;
    begin
      SetColor(color);
      Line(x1,y1,x2,y2);
    end;
end.