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