VB.Net Tutorial/Class Module/Polymorphism

Demonstrate polymorphism in Point-Circle-Cylinder hierarchy.

Class CTest2
   Shared Sub Main()
      Dim point As New Point(7, 11)
      Dim circle As New Circle(22, 8, 3.5)
      Dim cylinder As New Cylinder(10, 10, 3.3, 10)
      Dim arrayOfShapes As Shape() = New Shape(2) {}
      arrayOfShapes(0) = point
      arrayOfShapes(1) = circle
      arrayOfShapes(2) = cylinder
      Console.WriteLine(point.Name & ": " & _
         point.ToString() & vbCrLf & circle.Name & ": " & _
         circle.ToString() & vbCrLf & cylinder.Name & _
         ": " & cylinder.ToString())
      Dim shape As Shape
      For Each shape In arrayOfShapes
         Console.WriteLine(shape.Name & ": " & _
            shape.ToString() & vbCrLf & "Area = " & _
            String.Format("{0:F}", shape.Area) & vbCrLf & _
            "Volume = " & String.Format("{0:F}", shape.Volume))
      Next
   End Sub " Main
End Class
Public MustInherit Class Shape
   Public Overridable Function Area() As Double
      Return 0
   End Function
   Public Overridable Function Volume() As Double
      Return 0
   End Function
   Public MustOverride ReadOnly Property Name() As String
End Class

Public Class Point
   Inherits Shape 
   Private mX, mY As Integer
   Public Sub New()
   End Sub " New
   Public Sub New(ByVal xValue As Integer, _
      ByVal yValue As Integer)
   End Sub " New
   Public Overrides Function ToString() As String
      Return "[" & mX & ", " & mY & "]"
   End Function " ToString
   Public Overrides ReadOnly Property Name() As String
      Get
         Return "Point"
      End Get
   End Property " Name
End Class
Public Class Circle
   Inherits Point 
   Private mRadius As Double
   Public Sub New()
   End Sub " New
   Public Sub New(ByVal xValue As Integer, _
      ByVal yValue As Integer, ByVal radiusValue As Double)
      MyBase.New(xValue, yValue)
   End Sub " New
   Public Overrides Function ToString() As String
      Return "Center= " & MyBase.ToString() & _
         "; Radius = " & mRadius
   End Function " ToString
   Public Overrides ReadOnly Property Name() As String
      Get
         Return "Circle"
      End Get
   End Property " Name
End Class
Public Class Cylinder
   Inherits Circle
   Protected mHeight As Double
   Public Sub New()
   End Sub " New
   Public Sub New(ByVal xValue As Integer, _
      ByVal yValue As Integer, ByVal radiusValue As Double, _
      ByVal heightValue As Double)
      MyBase.New(xValue, yValue, radiusValue)
   End Sub " New
   Public Overrides ReadOnly Property Name() As String
      Get
         Return "Cylinder"
      End Get
   End Property " Name
End Class

Point: [0, 0]
Circle: Center= [0, 0]; Radius = 0
Cylinder: Center= [0, 0]; Radius = 0
Point: [0, 0]
Area = 0.00
Volume = 0.00
Circle: Center= [0, 0]; Radius = 0
Area = 0.00
Volume = 0.00
Cylinder: Center= [0, 0]; Radius = 0
Area = 0.00
Volume = 0.00

Inheritance and polymorphism

Class Tester
   
   Shared Sub Main()
      Dim point1, point2 As Point
      Dim circle1, circle2 As Circle
      point1 = New Point(30, 50)
      circle1 = New Circle(120, 89, 2.7)
      Console.WriteLine("Point point1: " & point1.ToString() & _
         vbCrLf & "Circle circle1: " & circle1.ToString())
      point2 = circle1
      Console.WriteLine("Circle circle1 (via point2): " & point2.ToString())
      circle2 = CType(point2, Circle) " allowed only via cast
      Console.WriteLine("Circle circle1 (via circle2): " & circle2.ToString())
      If (TypeOf point1 Is Circle) Then
         circle2 = CType(point1, Circle)
         Console.WriteLine("cast successful")
      Else
         Console.WriteLine("point1 does not refer to a Circle")
      End If
   End Sub
End Class 
Public Class Point
   Private mX, mY As Integer
   Public Sub New()
   End Sub " New
   Public Sub New(ByVal xValue As Integer, _
      ByVal yValue As Integer)
   End Sub " New
   Public Overrides Function ToString() As String
      Return "[" & mX & ", " & mY & "]"
   End Function " ToString
End Class
Public Class Circle
   Inherits Point 
   Private mRadius As Double
   Public Sub New()
   End Sub " New
   Public Sub New(ByVal xValue As Integer, _
      ByVal yValue As Integer, ByVal radiusValue As Double)
      MyBase.New(xValue, yValue)
   End Sub " New
   Public Overrides Function ToString() As String
      Return "Center= " & MyBase.ToString() & _
         "; Radius = " & mRadius
   End Function " ToString
End Class

Point point1: [0, 0]
Circle circle1: Center= [0, 0]; Radius = 0
Circle circle1 (via point2): Center= [0, 0]; Radius = 0
Circle circle1 (via circle2): Center= [0, 0]; Radius = 0
point1 does not refer to a Circle

Late binding

Public Class Tester
    Public Shared Sub Main
        Dim objHorse As Object
        Dim objPuma As Object
        objHorse = New Horse
        objPuma = New Puma
        Try
            objHorse.Walk()
        Catch
            Console.WriteLine("Sorry, no Walk method available in objHorse.")
        End Try
        Try
            objPuma.Walk()
        Catch
            Console.WriteLine("Sorry, no Walk method available in objPuma.")
        End Try
    End Sub
End Class
Public Class Horse
    Public Sub Walk()
        Console.WriteLine("Walking...")
    End Sub
End Class
Public Class Puma
    Public Sub Run()
        Console.WriteLine("Running...")
    End Sub
End Class

Walking...
Sorry, no Walk method available in objPuma.

Polymorphic Behaviour

Class ID
    Public Number As String
    Public Sub New(ByVal Number As String)
        Me.Number = Number
    End Sub
    Public Overridable Sub Dial()
        Console.WriteLine("Dialing: " & Number)
    End Sub
End Class
Class Phone
    Inherits ID
    Public Sub New(ByVal Number As String)
        MyBase.New(Number)
    End Sub
    Public Overrides Sub Dial()
        Console.WriteLine("Beep, touch-tone phone calling: " & Number)
    End Sub
End Class
Class CreditCardID
    Inherits ID
    Public Sub New(ByVal Number As String)
        MyBase.New(Number)
    End Sub
    Public Overrides Sub Dial()
        Console.WriteLine("Rotary dialing: " & Number)
    End Sub
End Class

Module Module1
    Sub Main()
        Dim card As New CreditCardID("555-1212")
        Dim phone As New Phone("800-555-1212")
        Dim PolyID As ID
        Console.WriteLine("Using standard objects")
        card.Dial()
        phone.Dial()
        Console.WriteLine("Using polymorphic phone")
        PolyID = card
        PolyID.Dial()
        PolyID = phone
        PolyID.Dial()
    End Sub
End Module

Using standard objects
Rotary dialing: 555-1212
Beep, touch-tone phone calling: 800-555-1212
Using polymorphic phone
Rotary dialing: 555-1212
Beep, touch-tone phone calling: 800-555-1212