Прорисовка графических объектов средствами ООП — Pascal(Паскаль)

 Uses CRT, Graph;
 
 const kv=4;
       speed=1.5;
       one=pi/180;
       step=one*speed;
       ms=2000;
 
       Const   sizeSq    =  80;           { размер квадрата }
            colorSq  =  12;           {  и его цвет  }
            colorG    =  2;            { цвет поверхности качения }
            deltaG     =  400;
 Type TFigure=Object
      x,y:Integer;
      color:Word;
      Constructor Init (ax,ay:Integer;  col:Word);
      Procedure Draw (col:Word); Virtual;
      Procedure Show;
      Procedure Hide;
      Procedure MoveTo (dx, dy:Integer);
 End;
 
 TPoint=Object(Tfigure)
        Procedure Draw (ccol:Word); Virtual;
 End;
 
 {Ellipse}
 TEllipse=Object(TPoint)
         U1,U2,xr,yr:Integer;
         Constructor Init(ax,ay,axr,ayr,aU1,aU2:Integer;  col:Word);
         Procedure Draw (col:Word); Virtual;
 End;
 {Pryamougolnik}
 TBar=object(TEllipse)
         a,b,c,d:integer;
         Constructor Initt(ea,eb,ec,ed:integer; Coll:word);
         procedure   Draww(coll:word); virtual;
 End;
 
 {Kvadrat}
 Type  TPoint1 = Object
                x,y            :Real;       { координаты точки }
                Pcolor       :Byte;       { ее цвет }
                Constructor Init   ( xx,yy   :Real; col :Byte );
                Procedure   Rotate ( xOs,yOs :Integer );    Virtual;
                Procedure   Show   ( col     :Byte );            Virtual;
                Destructor  Done;
           End;
 
          TLine  = Object ( TPoint1 )
                pn, pk      :TPoint1;            { нач. и кон. точки прямой }
                Lcolor      :Byte;               { ее цвет }
                Constructor Init   ( x1,y1,x2,y2 :Real;  col :Byte );
                Procedure   Rotate ( xOs,yOs :Integer ); Virtual;
                Procedure   Show   ( col     :Byte );         Virtual;
                Destructor  Done;
           End;
 
    TSides  = Array [ 0..kv-1 ] Of TLine;    {тип для описания сторон квадрата}
    TSquare = Object ( TLine )
               as            :Byte;                      { размер стороны квадрата }
               Sides      :TSides;                    { стороны квадрата }
               Scolor     :Byte;                      { цвет квадрата }
               Constructor Init   ( aa, colK :Byte );
 
         End;
     TScreen = Object ( TSquare )  { О-тип  - сцена  }
               Gdisp      :Integer; { эффективное Y-смещение поверхности качения}
               Gcolor     :Byte;         { цвет поверхности}
               angle      :Real;           { угол поворота квадрата}
               OsX,OsY    :Integer; { текущее значения координат оси вращения }
               Constructor Init ( aa, colK, colG :Byte;  dG :Integer );
               Procedure   GraphInit;                 Virtual;
               Function    ShiftOsXY :Boolean; Virtual;
               Procedure DrawGround; virtual;
           End;
 
 
 
 
         Constructor  TFigure.Init (ax, ay:Integer;  col:Word);
         Begin x:=ax; y:=ay; color:=col; End;
 
         Procedure TFigure.Draw(col:Word);
         Begin End;
 
         Procedure TFigure.Show;
         Begin Draw (Color); End;
 
         Procedure TFigure.Hide;
         Begin Draw (GetBkColor); End;
 
         Procedure TFigure.MoveTo (dx, dy:Integer);
         Begin Hide; x:=x+dx; y:=y+dy; Show; End;
 
         Procedure TPoint.Draw (ccol:Word);
         Begin PutPixel (x, y, ccol); End;
 
  {Ellipse}
         Constructor TEllipse.Init;
         Begin Inherited Init (ax, ay, col); xr:=axr; yr:=ayr; U1:=aU1; U2:=aU2;  End;
 
         Procedure TEllipse.Draw(col:Word);
         Begin   SetColor (col); Ellipse  (x,y,U1,U2,xr,yr);  End;
  {Pryamougolnik}
         Constructor TBar.Initt;
         Begin a:=ea; b:=eb; c:=ec; d:=ed  end;
 
         Procedure TBar.Draww(coll:word);
         Begin Setcolor(coll); setfillstyle(9,2);  Bar(a,b,c,d);  end;
 
  {Kvadrat}
   Constructor TPoint1 .Init ( xx, yy   :Real; col :Byte );
Begin    x:=xx;   y:=yy;   Pcolor := col;      End;
{---------------------------------------------------------------}
Procedure   TPoint1 .Rotate ( xOs,yOs :Integer );
Var xx, yy :Real;
Begin  xx := (x - xOs)*Cos(step) - (y - yOs)*Sin(step)  + xOs;
           yy := (x - xOs)*Sin (step) + (y - yOs)*Cos(step) + yOs;
           x :=xx;     y:=yy;
End;
{---------------------------------------------------------------}
Procedure   TPoint1 .Show   ( col :Byte );
Begin  PutPixel ( Round(x), Round(y), Pcolor ); End;
{---------------------------------------------------------------}
Destructor  TPoint1 .Done;
Begin End;
 
 (********  Методы TLine  ********************)
Constructor TLine .Init ( x1,y1,x2,y2 :Real; col :Byte );
Begin pn.Init(x1,y1,col);   pk.Init(x2,y2,col);   Lcolor:=col;  End;
{---------------------------------------------------------------}
Procedure   TLine .Rotate ( xOs,yOs :Integer );
Begin pn.Rotate( xOs,yOs );   pk.Rotate( xOs,yOs ); End;
{---------------------------------------------------------------}
Procedure   TLine .Show ( col :Byte );
Begin  If col=0 Then SetColor ( col ) Else SetColor ( Lcolor ) ;
       Line(Round(pn.x),Round(pn.y),Round(pk.x),Round(pk.y));
End;
{---------------------------------------------------------------}
Destructor  TLine .Done;
Begin End;
 
 (*****************  Методы TSquare  ****************************)
Constructor TSquare .Init ( aa, colK :Byte );
Begin
  as := aa;                                             { установка размера стороны квадрата}
  Sides[0]. Init ( as, as,  0, as, colK );   { инициализация сторон квадрата }
  Sides[1]. Init (  0, as,  0,  0, colK );
  Sides[2]. Init (  0,  0, as,  0, colK );
  Sides[3]. Init ( as,  0, as, as, colK );
  Scolor := colK;
End;
 
Constructor TScreen .Init ( aa, colK, colG :Byte;   dG :Integer );
Var  i :Byte;
Begin
   GraphInit;                             { инициализация графического режима VGAHi }
   Inherited Init ( aa, colK );    { инициализация родителя }
   Gdisp := dG;                         { задание Y-смещения поверхности качения }
   For i := 0 To kv-1 Do  With Sides[i] Do Begin {перенос квадрата на
     pn.y := pn.y + Gdisp - as;                                 { поверхность качения}
     pk.y := pk.y + Gdisp - as;
   End;
   Gcolor := colG;                     { задание цвета поверхности качения }
   OsX := as;    OsY := Gdisp;  { задание начальных координат оси вращения }
   angle := 0;                             { задание начального значения угла поворота }
   DrawGround;                        { рисование  поверхности качения }
End;
{---------------------------------------------------------------}
 
 
Procedure TScreen .GraphInit;{ инициализация графич. режима VGAHi }
Var gd, gm, ErrorCode :Integer;
Begin  
   If  GetGraphMode = 2  Then  Exit;{ если графич. режим включен, то выход }
   gd := Detect;
  InitGraph ( gd, gm, '');
  ErrorCode := GraphResult;
  If ErrorCode <> grOk Then Begin
     Writeln('Ошибка графики:', GraphErrorMsg ( ErrorCode ) );
     Halt(1);
  End;
End;
{---------------------------------------------------------------}
Procedure  TScreen .DrawGround;  { рисование  поверхности качения }
Begin SetColor ( Gcolor );
      Line ( 0, Round( Gdisp + 1 ), GetMaxX, Round( Gdisp + 1 ) );
End;
{---------------------------------------------------------------}
Function  TScreen .ShiftOsXY :Boolean; 
{опред-т момент и реализует смещение оси вращения квадрата по оси X} 
Begin  If angle > pi/2     { если наступил момент  переноса оси поворота,  }
         Then Begin OsX := OsX + as;                  { то сместить ось по X на as}
                             ShiftOsXY := True; End  
         Else ShiftOsXY := False;
End;
 
 
 Var driver,mode:integer;
     VEllipse:TEllipse;
     VBar:TBar;
 Begin
   Driver:=detect;
   initGraph(Driver,Mode,'C\:Pascal');
   VEllipse.Init (100,300,70,120,11,10,17);
   VEllipse.Show;
   VBar.initt(650,479,-10,427,2);
   VBar.Draww(6);
  
   ReadKey;
   CloseGraph;
 End.