Visual Foxpro

Contributed by Chris Rathman

Polymorphism in Visual FoxPro (polymorph.prg)

clear

polymorph()

proc polymorph
  && toss the different shapes into a collection
  scribble = createobject("Container")
  scribble.addobject("shape1", "CMRRectangle", 10, 20, 5, 6)
  scribble.addobject("shape2", "CMRCircle", 15, 25, 8)

  && use the shapes polymorphically
  for i = 1 to scribble.controlcount
     scribble.objects(i).draw
     scribble.objects(i).rmoveto(100, 100)
     scribble.objects(i).draw
  endfor

  && call a rectangle specific function
  aRectangle = createobject("CMRRectangle", 0, 0, 15, 15)
  aRectangle.setWidth(30)
  aRectangle.draw
endproc

define class CMRShape as custom
  protected x
  protected y

  && get the origin x value
  function getX
    return(this.x)
  endproc

  && get the origin y value
  function getY
    return(this.y)
  endproc

  && set the origin x value
  proc setX
  parameters newX
    this.X = newX
  endproc

  && set the origin y value
  proc setY
  parameters newY
    this.y = newY
  endproc

  && shift the origin based on the (x,y) point
  proc moveto
  parameters newX, newY
    this.setX(newX)
    this.setY(newY)
  endproc

  && shift the origin based on the delta (x,y) point
  proc rmoveto
  parameters newX, newY
    this.setX(this.getX() + newX)
    this.setY(this.getY() + newY)
  endproc

  && pseudo abstract function implemented by subclasses
  proc draw
  endproc
enddefine

define class CMRRectangle as CMRShape
  protected rwidth
  protected rheight

  && initialize a rectangle
  proc init
  parameters newX, newY, newWidth, newHeight
     this.moveto(newX, newY)
     this.setWidth(newWidth)
     this.setHeight(newHeight)
  endproc

  && get the width of the rectangle
  function getWidth
    return(this.rwidth)
  endproc

  && get the height of the rectangle
  function getHeight
    return(this.rheight)
  endproc

  && set the width of the rectangle
  proc setWidth
  parameters newWidth
    this.rwidth = newWidth
  endproc

  && set the height of the rectangle
  proc setHeight
  parameters newheight
    this.rheight = newHeight
  endproc

  && draw a rectangle
  proc draw
     ?? "Drawing a rectangle:("
     ?? LTrim(str(this.getX()))
     ?? ","
     ?? LTrim(str(this.getY()))
     ?? "), width "
     ?? LTrim(str(this.getWidth()))
     ?? ", height "
     ?? LTrim(str(this.getHeight()))
     ?
  endproc
enddefine

define class CMRCircle as CMRShape
  protected radius

  && initialize a circle
  proc init
  parameters newX, newY, newRadius
    this.moveto(newX, newY)
    this.setRadius(newRadius)
  endproc

  && get the radius of the circle
  function getRadius
    return(this.radius)
  endproc

  && set the radius of the circle
  proc setRadius
  parameters newRadius
    this.radius = newRadius
  endproc

  && draw a circle
  proc draw
     ?? "Drawing a circle:("
     ?? LTrim(str(this.getX()))
     ?? ","
     ?? LTrim(str(this.getY()))
     ?? "), radius "
     ?? LTrim(str(this.getRadius()))
     ?
  endproc
enddefine

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