Иерархия классов

Класс-Квадрат
|Класс-Угол
||Класс-Сторона
|end
end

program Project1;

{$APPTYPE CONSOLE}

type
  //класс свободный-прямоугольник - содержит в себе информацию о положении
  //и размере черырехугольника
  TCustomRect = class(Tobject)
  private
    //Положение прямоугольника
    FTop: Integer;
    FLeft: Integer;
    //Размеры
    FWidth: Integer;
    FHeight: Integer;
    //Процедуры установки положенмия
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
    //Процедуры изменения размера
    procedure SetHeight(const Value: Integer); virtual;
    procedure SetWidth(const Value: Integer); virtual;
  public
    Property Left : Integer read FLeft write SetLeft;
    Property Top : Integer read FTop write SetTop;
    Property Width : Integer read FWidth write SetWidth;
    Property Height : Integer read FHeight write SetHeight;
    function Assign(obj : TCustomRect) : Boolean; virtual;
  end;
  //Квадрат является частным случаем прямоугольника
  //поэтому мы можем использовать класс TCustomRect
  //Немного его модифицировав
  TQuad = Class(TCustomRect)
  private
    //Перезаписываем методы установки ширины и высоты
    //Так что бы  при изменении ширины менялась высота
    //и наоборот
    procedure SetHeight(const Value: Integer); override;
    procedure SetWidth(const Value: Integer); override;
  public
    //Процедура копирования объекта так же переписывается
    //Значения можно присовить только если у TCustomRect
    //Width = Height
    function Assign(obj : TCustomRect) : Boolean; override;
  end;

{ TCustomRect }


function TCustomRect.Assign(obj: TCustomRect): Boolean;
begin
  Result := False;
  if not Assigned(obj) then exit;
  fLeft := obj.FLeft;
  FTop := obj.FTop;
  FWidth := obj.FWidth;
  FHeight := obj.FHeight;
  result := true;
end;

procedure TCustomRect.SetHeight(const Value: Integer);
begin
  FHeight := Value;
end;

procedure TCustomRect.SetLeft(const Value: Integer);
begin
  FLeft := Value;
end;

procedure TCustomRect.SetTop(const Value: Integer);
begin
  FTop := Value;
end;

procedure TCustomRect.SetWidth(const Value: Integer);
begin
  FWidth := Value;
end;


{ TQuad }

function TQuad.Assign(obj: TCustomRect): Boolean;
begin
  Result := False;
  if not Assigned(obj) then exit;
  if (obj.FWidth <> obj.FHeight) then exit;
  //тут мы вызываем метод родителя TCustomRect.Assign()
  //а не TQuad.Assign()
  result := TCustomRect(self).Assign(obj)
end;

procedure TQuad.SetHeight(const Value: Integer);
begin
  FHeight := Value;
  FWidth :=  Value;
end;

procedure TQuad.SetWidth(const Value: Integer);
begin
  FHeight := Value;
  FWidth :=  Value;
end;

begin

end.