Delphi

program Polymorph;

uses
   CircleUnit in 'CircleUnit.pas',
   RectangleUnit in 'RectangleUnit.pas',
   ShapeUnit in 'ShapeUnit.pas';

{$R *.RES}

var
   i: Integer;
   scribble: array[0..1] of Shape;
   aRectangle : Rectangle;

begin
   { toss the different shapes into an array }
   scribble[0] := Rectangle.init(10, 20, 5, 6);
   scribble[1] := Circle.init(15, 25, 8);

   { use the shapes polymorphically }
   for i := 0 to 1 do
      begin
         scribble[i].draw();
         scribble[i].rMoveTo(100, 100);
         scribble[i].draw();
      end;

   { call a rectangle specific function }
   aRectangle := Rectangle.init(0, 0, 15, 15);
   aRectangle.setWidth(30);
   aRectangle.draw();
end.

unit ShapeUnit;

interface
   type
      Shape = class
         public
            function getX: Integer;
            function getY: Integer;
            procedure setX(newX: Integer);
            procedure setY(newY: Integer);
            procedure moveTo(newX: Integer; newY: Integer);
            procedure rMoveTo(deltaX:Integer; deltaY: Integer);
            procedure draw; virtual; abstract;
         protected
            x: Integer;
            y: Integer;
      end;

implementation
   { get the origin x value }
   function Shape.getX: Integer;
   begin
      getX := x;
   end;

   { get the origin y value }
   function Shape.getY: Integer;
   begin
      getY := y;
   end;

   { set the origin x value }
   procedure Shape.setX(newX: Integer);
   begin
      x := newX;
   end;

   { set the origin y value }
   procedure Shape.setY(newY: Integer);
   begin
      y := newY;
   end;

   { move the origin to a new (x,y) location }
   procedure Shape.moveTo(newX: Integer; newY: Integer);
   begin
      setX(newX);
      setY(newY);
   end;

   { relative move origin to a new (x+deltax,y+deltay) location }
   procedure Shape.rMoveTo(deltaX: Integer; deltaY: Integer);
   begin
      setX(getX() + deltaX);
      setY(getY() + deltaY);
   end;
end.

unit RectangleUnit;

interface
   uses
    ShapeUnit;
    type
      Rectangle = class(Shape)
         public
            constructor init(xValue:Integer; yValue: Integer;
               aWidth: Integer; aHeight:Integer);
            procedure setWidth(newWidth:Integer);
            procedure setHeight(newHeight:Integer);
            function getWidth: Integer;
            function getHeight: Integer;
            procedure draw; override;
         private
            height: Integer;
            width: Integer;
      end;

implementation

   { construct a rectangle }
   constructor Rectangle.init(xValue:Integer; yValue: Integer;
      aWidth: Integer; aHeight: Integer);
   begin
      setX(xValue);
      setY(yValue);
      setWidth(aWidth);
      setHeight(aHeight);
   end;

   { get the width of the rectangle }
   function Rectangle.getWidth : Integer;
   begin
      getWidth := width;
   end;

   { get the height of the rectangle }
   function Rectangle.getHeight : Integer;
   begin
      getHeight := height;
   end;

   { set the width of the rectangle }
   procedure Rectangle.setWidth(newWidth:Integer);
   begin
      width := newWidth;
   end;

   { set the height of the rectangle }
   procedure Rectangle.setHeight(newHeight:Integer);
   begin
      height := newHeight;
   end;

   { draw the rectangle }
   procedure Rectangle.draw;
   begin
      writeln('Drawing a rectangle at:(', getX(), ',', getY(),
         '), width ', getWidth(), ', height ', getHeight());
   end;
end.

unit CircleUnit;

interface
   uses
    ShapeUnit;

   type
      Circle = class(Shape)
         public
            constructor init(xValue:Integer; yValue:Integer;
               aRadius: Integer);
            function getRadius: Integer;
            procedure setRadius(newRadius: Integer);
            procedure draw; override;
         private
            radius: Integer;
      end;

implementation

   { construct a circle }
   constructor Circle.init(xValue: Integer; yValue: Integer;
      aRadius: Integer);
   begin
      setX(xValue);
      setY(yValue);
      setRadius(aRadius);
   end;

   { get the radius value }
   function Circle.getRadius: Integer;
   begin
      getRadius := radius;
   end;

   { set the radius of the circle }
   procedure Circle.setRadius(newRadius: Integer);
   begin
      radius := newRadius;
   end;

   { draw the circle }
   procedure Circle.draw;
   begin
      writeln('Drawing a circle at:(', getX(), ',', getY(),
         '), radius ', getRadius());
   end;
end.

Drawing a Rectangle at: (10,20), width 5, height 6
Drawing a Rectangle at: (110,120), width 5, height 6
Drawing a Circle at: (15,25), radius 8
Drawing a Circle at: (115,125), radius 8
Drawing a Rectangle at: (0,0), width 30, height 15