{.$mode tp}
uses
  Crt, Graph;

const
  maxPoints = 100;

type
  myPointType = record
    X, Y: Double;
  end;

  PPointArray = ^PointArray;
  PointArray = Array[1 .. maxPoints] of myPointType;

  myPolarType = record
    R, Phi: Double;
  end;
  PPolarArray = ^PolarArray;
  PolarArray = Array[1 .. maxPoints] of myPolarType;

  PGraphObject=^TGraphObject;
  TGraphObject=object {базовый объект}
    Points: integer;
    pts: PPointArray;

    polars: PPolarArray;
    Rotated: Boolean;
    CenterX, CenterY: Integer;

    Active: Boolean; {признак видимости объекта}
    Color: Integer;  {цвет объекта}
    constructor Init(APoints: Integer); {конструктор объекта}
    destructor Done; virtual; {деструктор}

    procedure Step (Dx,Dy:Integer); {сдвиг объекта}
    procedure Move; {хаотичное движение}

    procedure Show; {отобразить объект на экране}
    procedure Hide; {скрыть объект}

    procedure Paint;virtual; abstract; {процедура рисования объекта}
    procedure Clear;virtual; abstract; {процедура стирания объекта}

    procedure BeforeRotation(Px, Py: integer); virtual;
    procedure AfterRotation;

    procedure Rotate(Px, Py: Integer; Angle: Double);
  private
    procedure PolarToDecart(const p: myPolarType;
                            var Decart: MyPointType);
  end;


  PPoint = ^TPoint;
  TPoint = object(TGraphObject) {точка}
    {Задание координат и цвета точки}
    constructor InitData(Px,Py, c:Integer);
    procedure Paint; virtual;
    procedure Clear; virtual;

  private
    procedure Draw(AColor: Integer);
  end;

  PRectangle = ^TRectangle;
  TRectangle = object(TGraphObject) {прямоугольник}
    {Задание координат, размеров и цвета прямоугольника}
    constructor InitData(Px,Py,W,H,c:Integer);
    procedure Paint; virtual;
    procedure Clear; virtual;

  private
    procedure Draw;
  end;


constructor TGraphObject.Init(APoints: Integer);
begin
  Points := APoints;
  GetMem(pts, Points * SizeOf(myPointType));
  Active := False; {изначально объект невидим}
end;

destructor TGraphObject.Done;
begin
  Hide; {перед уничтожением сотрем объект с эк-рана}
  FreeMem(pts, Points * SizeOf(myPointType))
end;


procedure TGraphObject.Step(dx, dy: integer);
var
  i: Integer;
begin
  Hide; {скроем объект}

  for i := 1 to Points do
  begin
    pts^[i].X := pts^[i].X + Dx;
    pts^[i].Y := pts^[i].Y + Dy;
  end;

  Show; {отобразим на новом месте}
end;

procedure TGraphObject.Move;
begin
  Step(Random(5) - 2, Random(5) - 2); {шагнем случайным образом}
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;

function myArcTan(Dy, Dx: Double): Double;
var value: Double;
begin
  if Dx = 0 then
    if Dy > 0 then myArcTan := Pi / 2
    else myArcTan := 3*Pi / 2

  else begin
    Value := ArcTan(Dy / Dx);

    if Dx > 0 then begin
      if Dy < 0 then Value := 2 * Pi + Value
    end
    else Value := Pi + Value;

    myArcTan := Value;
  end;
end;

procedure TGraphObject.BeforeRotation(Px, Py: integer);
var
  i: integer;
begin
  GetMem(polars, Points * SizeOf(MyPolarType));
  for i := 1 to Points do
  begin
    polars^[i].Phi := myArcTan((Py - pts^[i].Y), (pts^[i].X - Px));
    polars^[i].R := Sqrt(Sqr(pts^[i].X - Px) + Sqr(pts^[i].Y - Py));
  end;
  Rotated := True;
  CenterX := Px; CenterY := Py;
end;

procedure TGraphObject.PolarToDecart(const p: myPolarType;
          var Decart: MyPointType);
begin
  Decart.X := CenterX + Trunc(p.R * cos(p.Phi));
  Decart.Y := CenterY - Trunc(p.R * sin(p.Phi));
end;

procedure TGraphObject.AfterRotation;
var
  i: integer;
begin
  for i := 1 to Points do
    PolarToDecart(polars^[i], pts^[i]);

  freemem(polars, points*sizeof(mypolartype));
  Rotated := False;
end;

procedure TGraphObject.Rotate(Px, Py: Integer; Angle: Double);
var
  i: integer;
begin
  Hide;

    for i := 1 to Points do
    begin
      polars^[i].Phi := Polars^[i].Phi + Angle;
      if polars^[i].Phi > 2 * Pi then
        polars^[i].Phi := polars^[i].Phi - 2 * Pi;
    end;

  Show;
end;


constructor TPoint.InitData;
begin
  inherited Init(1); {инициализация унаследованных полей}
  pts^[1].X := Px;
  pts^[1].Y := Py;
  Color := c; {зададим цвет}
end;

procedure TPoint.Draw(AColor: Integer);

  procedure MyPutPixel(P: MyPointType);
  begin
    PutPixel(Trunc(P.X), Trunc(P.Y), AColor);
  end;

var P: MyPointType;
begin
  if not Rotated then MyPutPixel(pts^[1])
  else begin
    PolarToDecart(polars^[1], P);
    MyPutPixel(P);
  end;
end;

procedure TPoint.Paint;
begin
  Draw(Color);
end;

procedure TPoint.Clear;
begin
  Draw(GetBkColor);
end;


constructor TRectangle.InitData;
begin
  inherited Init(5);
  pts^[1].X := Px;     pts^[1].Y := Py;
  pts^[2].X := Px + W; pts^[2].Y := Py;
  pts^[3].X := Px + W; pts^[3].Y := Py + H;
  pts^[4].X := Px;     pts^[4].Y := Py + H;
  pts^[5] := pts^[1];

  Color := c;
end;

procedure TRectangle.Draw;

  procedure MyLine(St, Fn: MyPointType);
  begin
    Line(Trunc(St.X), Trunc(St.Y), Trunc(Fn.X), Trunc(Fn.Y));
  end;

var
  i: integer;
  St, Fn: MyPointType;
begin
  if not Rotated then begin

    for i := 1 to 4 do
    begin
      MyLine(pts^[i], pts^[i + 1]);
    end;

  end
  else begin

    for i := 1 to 4 do
    begin
      PolarToDecart(polars^[i], St);
      PolarToDecart(polars^[i + 1], Fn);
      MyLine(St, Fn);
    end;
  end
end;

procedure TRectangle.Paint;
begin
  SetColor(Color);
  Draw;
end;

procedure TRectangle.Clear;
begin
  SetColor(GetBkColor);
  Draw;
end;

{Переход в графический режим}
procedure InitVideo;
var
  grDriver, grMode: Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, '');
  if GraphResult<>grOk then
  begin
    Writeln('Ошибка при инициализации графики !');
    Halt(1);
  end;
end;

{Возврат в текстовый режим}
procedure DoneVideo;
begin
  CloseGraph;
end;

const
  maxObjInScene = 50;
type
  TRotateScene = object

    objCount: Integer;
    Objs: array[1 .. maxObjInScene] of PGraphObject;
    CenterX, CenterY: Integer;

    constructor Create(Cx, Cy: Integer);
    destructor Done;

    procedure Insert(P: PGraphObject);
    procedure Run;
  end;


constructor TRotateScene.Create(Cx, Cy: Integer);
begin
  objCount := 0;
  CenterX := Cx; CenterY := Cy;
end;

destructor TRotateScene.Done;
var i: integer;
begin
  for i := 1 to objCount do
  begin
    Objs[i]^.AfterRotation;
    Objs[i] := nil;
  end;
  objCount := 0;
end;

procedure TRotateScene.Insert(P: PGraphObject);
begin
  inc(objCount);
  Objs[objCount] := P;
  P^.BeforeRotation(CenterX, CenterY);
end;

procedure TRotateScene.Run;
var
  i: integer;
begin
  while not KeyPressed do
  begin
    for i := 1 to objCount do
      objs[i]^.Rotate(CenterX, CenterY, 5 * (Pi / 180));
    delay(10);
  end;

  while KeyPressed do ReadKey;
end;

{ ***** }
const
  n = 4;
var
  a: array[1 .. n] of PGraphObject; {массив произвольных объектов}
  i: Integer;

  Cx, Cy: Integer;
  Scene: TRotateScene;

begin
  InitVideo;
  cx := getmaxx div 2;
  cy := getmaxy div 2;

  a[1] := new(PRectangle, InitData(cx -  20, cy - 100, 40, 75, white));
  a[2] := new(PRectangle, InitData(cx -  20, cy +  25, 40, 75, white));
  a[3] := new(PRectangle, InitData(cx - 100, cy -  20, 75, 40, white));
  a[4] := new(PRectangle, InitData(cx +  25, cy -  20, 75, 40, white));

  Scene.Create(Cx, Cy);
  for i := 1 to n do
    Scene.Insert(a[i]);

  Scene.Run;
  Scene.Done;


  while not KeyPressed do
  begin
    for i := 1 to n do a[i]^.Move;
    delay(75);
  end;
  while KeyPressed do ReadKey;

  for i := 1 to n do
  begin
    dispose(a[i], Done);
  end;

  DoneVideo;
end.