Visual Basic

Contributed by Chris Rathman

File: Polymorph.bas

Public Sub Main()
   Dim i As Integer
   Dim aRectangle As CMRRectangle
   Dim aCircle As CMRCircle
   Dim scribble(1 To 2) As CMRShape

   ' set up the respective instances
   Set aRectangle = New CMRRectangle
   Set aCircle = New CMRCircle
   Call aRectangle.init(10, 20, 5, 6)
   Call aCircle.init(15, 25, 8)

   ' throw the objects into a collection
   Set scribble(1) = aRectangle
   Set scribble(2) = aCircle

   ' use the shapes polymorphically
   For i = 1 To UBound(scribble)
      Call scribble(i).Draw
      Call scribble(i).rMoveTo(100, 100)
      Call scribble(i).Draw
   Next i

   ' call a rectangle specific function
   Set aRectangle = New CMRRectangle
   Call aRectangle.init(0, 0, 15, 15)
   Call aRectangle.setWidth(30)
   Call aRectangle.CMRShape_Draw
End Sub

File: CMRShape.cls

Public Function getX()
End Function

Public Function getY()
End Function

Public Sub setX(aNumber)
End Sub

Public Sub setY(aNumber)
End Sub

Public Sub moveTo(newX, newY)
End Sub

Public Sub rMoveTo(deltaX, deltaY)
End Sub

Public Sub Draw()
End Sub

File: CMRRectangle.cls

Implements CMRShape

Private x
Private y
Private width
Private height

' initialize a rectangle
Public Sub init(newX, newY, aWidth, aHeight)
   Call CMRShape_setX(newX)
   Call CMRShape_setY(newY)
   Call setWidth(aWidth)
   Call setHeight(aHeight)
End Sub

' get the origin x value
Public Function CMRShape_getX()
   CMRShape_getX = x
End Function

' get the origin y value
Public Function CMRShape_getY()
   CMRShape_getY = y
End Function

' set the origin x value
Public Sub CMRShape_setX(aNumber)
   x = aNumber
End Sub

' set the origin y value
Public Sub CMRShape_setY(aNumber)
   y = aNumber
End Sub

'shift the origin based on the (x,y) point
Public Sub CMRShape_moveTo(newX, newY)
   Call CMRShape_setX(newX)
   Call CMRShape_setY(newY)
End Sub

' shift the origin based on the delta (x,y) point
Public Sub CMRShape_rMoveTo(deltaX, deltaY)
   Call CMRShape_setX(CMRShape_getX() + deltaX)
   Call CMRShape_setY(CMRShape_getY() + deltaY)
End Sub

' draw the rectangle
Public Sub CMRShape_Draw()
   Debug.Print "Drawing a rectangle:(" & _
      CMRShape_getX() & "," & CMRShape_getY() & _
      "), width " & getWidth() & ", height " & getHeight()
End Sub

' get the width of the rectangle
Public Function getWidth()
   getWidth = width
End Function

' get the height of the rectangle
Public Function getHeight()
   getHeight = height
End Function

' set the width of the rectangle
Public Sub setWidth(aNumber)
   width = aNumber
End Sub

' set the height of the rectangle
Public Sub setHeight(aNumber)
   height = aNumber
End Sub

File: CMRCircle.cls

Implements CMRShape

Private x
Private y
Private radius

' initialize a circle
Public Sub init(newX, newY, aRadius)
   Call CMRShape_setX(newX)
   Call CMRShape_setY(newY)
   Call setRadius(aRadius)
End Sub

' get the origin x value
Public Function CMRShape_getX()
   CMRShape_getX = x
End Function

' get the origin y value
Public Function CMRShape_getY()
   CMRShape_getY = y
End Function

' set the origin x value
Public Sub CMRShape_setX(aNumber)
   x = aNumber
End Sub

' set the origin y value
Public Sub CMRShape_setY(aNumber)
   y = aNumber
End Sub

'shift the origin based on the (x,y) point
Public Sub CMRShape_moveTo(newX, newY)
   Call CMRShape_setX(newX)
   Call CMRShape_setY(newY)
End Sub

' shift the origin based on the delta (x,y) point
Public Sub CMRShape_rMoveTo(deltaX, deltaY)
   Call CMRShape_setX(CMRShape_getX() + deltaX)
   Call CMRShape_setY(CMRShape_getY() + deltaY)
End Sub

' draw the circle
Public Sub CMRShape_Draw()
   Debug.Print "Drawing a circle:(" & _
      CMRShape_getX() & "," & CMRShape_getY() & _
      "), radius " & getRadius()
End Sub

' get the radius of the circle
Public Function getRadius()
   getRadius = radius
End Function

' set the radius of the circle
Public Sub setRadius(aNumber)
   radius = aNumber
End Sub

Output

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

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