# Delphi

Contributed by Chris Rathman

## File: Polymorph.dpr

 ```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. ```

## File: ShapeUnit.pas

 ```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. ```

## File: RectangleUnit.pas

 ```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. ```

## File: CircleUnit.pas

 ```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. ```

## Output

 ```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 ```

Chris Rathman / Chris.Rathman@tx.rr.com