FreeBASIC Extends

Type SchoolMember 'すべての学校のメンバーを表わします'
    Declare Constructor ()
    Declare Sub Init (ByRef _name As String, ByVal _age As Integer)
    As String Name
    As Integer age
End Type

Constructor SchoolMember ()
    Print "Initialized SchoolMember"
End Constructor

Sub SchoolMember.Init (ByRef _name As String, ByVal _age As Integer)
    This.name = _name
    This.age = _age
    Print "Name: "; This.name; "   Age:"; This.age
End Sub


Type Teacher Extends SchoolMember '先生は、SchoolMember に由来することを表します'
    Declare Constructor (ByRef _name As String, ByVal _age As Integer, ByVal _salary As Integer)
    As Integer salary
    Declare Sub Tell ()
End Type

Constructor Teacher (ByRef _name As String, ByVal _age As Integer, ByVal _salary As Integer)
    Print "Initialized Teacher"
    This.Init(_name, _age) '基板メンバー手続きへの暗黙のアクセス'
    This.salary = _salary
End Constructor

Sub Teacher.Tell ()
    Print "Salary:"; This.salary
End Sub


Type Student Extends SchoolMember '学生は、SchoolMember に由来することを表します'
    Declare Constructor (ByRef _name As String, ByVal _age As Integer, ByVal _marks As Integer)
    As Integer marks
    Declare Sub Tell ()
End Type

Constructor Student (ByRef _name As String, ByVal _age As Integer, ByVal _marks As Integer)
    Print "Initialized Student"
    This.Init(_name, _age) '基板メンバー手続きへの暗黙のアクセス'
    This.marks = _marks
End Constructor
   
Sub Student.Tell ()
    Print "Marks:"; This.marks
End Sub


Dim As Teacher t = Teacher("Mrs. Shrividya", 40, 30000)
t.Tell()
Print
Dim As Student s = Student("Swaroop", 22, 75)
s.Tell()
Sleep

' 継承の8つのキーワードをすべて使う例:
'   'Extends', 'Base.', 'Base()', 'Object', 'Is' operator, 'Virtual', 'Abstract', 'Override'

Type root Extends Object ' あらかじめ定義された Object型の遺産によって、RTTI を起動させるために Extend(拡張)
  Declare Function ObjectHierarchy () As String
  Declare Abstract Function ObjectRealType () As String ' 'Abstract' は、overriden でなければならない
                                                        '    局地本体のない関数を宣言します。
  Declare Virtual Destructor () ' 'Virtual' は、本体を備えた解体子を宣言する。('Abstract' 禁止)
Protected:
  Declare Constructor () ' ルートからのユーザ構築を回避
  Declare Constructor (ByRef rhs As root) '' ルートからユーザーのコピー構築を回避
End Type ' 派生型は空のメンバー・データかもしれません

Constructor root ()
End Constructor

Function root.ObjectHierarchy () As String
  Return "Object(forRTTI) <- root"
End Function

Virtual Destructor root ()
  Print "root destructor"
End Destructor


Type animal Extends root ' ルートの継承のための'Extends'
  Declare Constructor (ByRef _name As String = "")
  Declare Function ObjectHierarchy () As String
  Declare Virtual Function ObjectRealType () As String Override ' 'Virtual' は、overriden されうる
                                                                '    局所本体と関数を宣言
                                                                ' 関数が、よく無効化であるかどうか
                                                                '    調べるために、'Override'
  Dim Name As String
  Declare virtual Destructor () Override ' 'Virtual' は、局所本体と解体子を宣言
                                         ' 解体子がよく無効化であるかどうか調べるために、'Override'
End Type

Constructor animal (ByRef _name As String = "")
  This.name = _name
End Constructor

Function animal.ObjectHierarchy () As String
  Return Base.ObjectHierarchy & " <- animal" ' 'Base.' は、親メンバー関数へのアクセスを認める
End Function

Virtual Function animal.ObjectRealType () As String
  Return "animal"
End Function

Virtual Destructor animal ()
  Print "  animal destructor: " & This.name
End Destructor


Type dog Extends animal ' 動物の継承のための 'Extends'
  Declare Constructor (ByRef _name As String = "")
  Declare Function ObjectHierarchy () As String
  Declare Function ObjectRealType () As String Override ' 関数がよく無効化であるかどうか
                                                        '    調べるために、'Override'
  Declare Destructor () Override ' 解体子がよく無効化であるかどうか調べるために、'Override'
End Type ' 派生型は空のメンバー・データかもしれません

Constructor dog (ByRef _name As String = "")
  Base(_name) ' 'Base()' は、親構築子を呼べるように
End Constructor

Function dog.ObjectHierarchy () As String
  Return Base.ObjectHierarchy & " <- dog" ' 'Base.' は、親メンバー関数にアクセスすることを可能にします
End Function

Function dog.ObjectRealType () As String
  Return "dog"
End Function

Destructor dog ()
  Print "    dog destructor: " & This.name
End Destructor


Type cat Extends animal ' 動物の継承のための 'Extends'
  Declare Constructor (ByRef _name As String = "")
  Declare Function ObjectHierarchy () As String
  Declare Function ObjectRealType () As String Override ' 関数がよく無効化であるかどうか
                                                        '    調べるために、'Override'
  Declare Destructor () Override ' 解体子がよく無効化であるかどうか調べるために、'Override'
End Type ' 派生型は空のメンバー・データかもしれません

Constructor cat (ByRef _name As String = "")
  Base(_name) ' 'Base()' は、親構築子を呼べるように
End Constructor

Function cat.ObjectHierarchy () As String
  Return Base.ObjectHierarchy & " <- cat" ' 'Base.' は、親メンバー関数にアクセスすることを可能にします
End Function

Function cat.ObjectRealType () As String
  Return "cat"
End Function

Destructor cat ()
  Print "    cat destructor: " & This.name
End Destructor


Sub PrintInfo (ByVal p As root Ptr) ' 動物型、犬型および猫型定義の後に置かなければなりません
  Print "  " & p->name, "  " & p->ObjectRealType, "           ";
  If *p Is dog Then ' 'Is' は、型シンボルとの互換性をチェックすることを可能に
    Print  Cast(dog Ptr, p)->ObjectHierarchy
  ElseIf *p Is cat Then ' 'Is' は、型シンボルとの互換性をチェックすることを可能に
    Print Cast(cat Ptr, p)->ObjectHierarchy
  ElseIf *p Is animal Then ' 'Is' は、型シンボルとの互換性をチェックすることを可能に
    Print Cast(animal Ptr, p)->ObjectHierarchy
  End If
End Sub


Print "名前:", "オブジェクト (real):         階層:"
Dim a As root Ptr = New animal("Mouse")
PrintInfo(a)
Dim d As root Ptr = New dog("Buddy")
PrintInfo(d)
Dim c As root Ptr = New cat("Tiger")
Printinfo(c)
Print
Sleep

Delete a
Delete d
Delete c