VBA: is there something like Abstract Class?

后端 未结 3 669
眼角桃花
眼角桃花 2020-12-29 10:51

I\'m using an interface to ensure some similar classes implements some mandatory methods (subs/functions).

Example:

  • interface I1 declares M1 and M2 me
相关标签:
3条回答
  • 2020-12-29 11:15

    You could implement semi-decorator :-) pattern in VBA. Lets say we have a base class and two child classes. If you use Implements keyword in child classes you will garatee that child classes has the same interface as the base class and at the same time declare a private instance of base class in each child class and redirect calls from children to base class.

    Note: base class here is normal class, you can still create instances of it (so it is not real abstract class).

    Example:

    ' Standard module
    
    Sub main()
        Dim a As New ChildA
        Dim b As New ChildB
    
        a.State = 2
        b.State = 5
    
        Debug.Print TypeOf a Is Base
        Debug.Print TypeOf b Is Base
    
        TestPolymorphic a
        TestPolymorphic b
    End Sub
    
    Private Sub TestPolymorphic(ByRef obj As Base)
        obj.Polymorphic
    End Sub
    
    ' -----------------------------------------------
    
    ' Base class module
    
    Private m_state As Byte
    
    Public Event StateChanged(oldState As Byte, newState As Byte)
    
    Public Property Get State() As Byte
        State = m_state
    End Property
    
    Public Property Let State(ByVal newState As Byte)
        Dim oldState As Byte
        oldState = m_state
        m_state = newState
        RaiseEvent StateChanged(oldState, newState)
    End Property
    
    Sub Polymorphic()
        Err.Raise 123, , "Implement in child class"
    End Sub
    
    Private Sub Class_Initialize()
        m_state = 1
    End Sub
    
    ' -----------------------------------------------
    
    ' ChildA class module
    
    Implements Base
    Private WithEvents m_base As Base
    
    Private Sub Class_Initialize()
        Set m_base = New Base
    End Sub
    
    Public Property Get State() As Byte
        State = Base_State
    End Property
    
    Public Property Let State(ByVal newState As Byte)
        Base_State = newState
    End Property
    
    Public Sub Polymorphic()
        Base_Polymorphic
    End Sub
    
    Private Property Get Base_State() As Byte
        Base_State = m_base.State
    End Property
    
    Private Property Let Base_State(ByVal newState As Byte)
        m_base.State = newState
    End Property
    
    Private Sub Base_Polymorphic()
        Debug.Print "In Child A ..."
    End Sub
    
    Private Sub m_base_StateChanged(oldState As Byte, newState As Byte)
        Debug.Print "State of 'Child A' instance has changed from " & oldState & " to " & newState
    End Sub
    
    Output:
    ' State of 'Child A' instance has changed from 1 to 2
    ' State of 'Child B' instance has changed from 1 to 5
    ' True
    ' True
    ' In Child A ...
    ' In Child B ...
    

    enter image description here

    0 讨论(0)
  • 2020-12-29 11:21

    There is no inheritance in VBA.

    You can define an interface and you can implement it in a class by using the Implements keyword. But if you want shared functionality pre-implemented by a base class, you have to use the copy-paste approach.

    Related reading:
    How to use the Implements in Excel VBA
    How to use comparison methods between class object modules in VBA in a similar manner as VB.NET?

    0 讨论(0)
  • 2020-12-29 11:24

    My solution for abstract class in vba: View

    '------------------------- 
    ' Standard module
    
    Sub Main()
    
        Dim objC1 As C1
        Dim objC2 As C2
        Dim objCollection As New Collection
    
        Set objC1 = New C1
        Set objC2 = New C2
    
        With objC1
            .getInterface.M1 "Hello C1!"
            temp1 = .getInterface.M2(objCollection)
    
            .getSuperClass.SM1 "Hi C1!!!"
            temp3 = .getSuperClass.SM2(objCollection)
    
        End With
    
        Debug.Print vbCrLf
    
        With objC2
            .getInterface.M1 "Hello C2!"
            temp1 = .getInterface.M2(objCollection)
    
            .getSuperClass.SM1 "Hi C2!!!"
            temp3 = .getSuperClass.SM2(objCollection)
    
        End With
    
    End Sub
    
    
    ' -----------------------------------------------
    
    ' IAbstracat class module
    
    Sub SM1(strString As String): End Sub
    Function SM2(varItem As Variant) As String: End Function
    
    
    ' -----------------------------------------------
    
    ' Abstracat class module
    
    Implements IAbstract
    
    'Each class must implement these methods, in a particular way
    Sub M1(strString As String): End Sub
    Function M2(varItem As Variant) As String: End Function
    
    
    'The sub classes will extend SM1 and SM2
    Private Sub IAbstract_SM1(strString As String)
        Debug.Print "Sub IAbstract_SM1: " & strString
    End Sub
    
    
    'The sub classes will extend SM1 and SM2
     Private Function IAbstract_SM2(varItem As Variant) As String
    
        Dim strMyString As String
    
        strMyString = "Function IAbstract_SM2 => ObjPtr(varItem): " & ObjPtr(varItem)
        Debug.Print strMyString
    
        IAbstract_SM2 = strMyString
    
    End Function
    
    
    ' -----------------------------------------------
    
    ' C1 class module
    
    Implements Abstract
    
    Private Type TC1
        objConcretSuperClass As Abstract
        objInterfaceSuperClass As IAbstract
        objInterfaceSubClass As Abstract
    End Type
    
    Private this As TC1
    
    
    'if you do not need to initialize anything, then this is it:
    Private Sub Class_Initialize()
    
        With this
    
            'creating an instance of class' Abstract'
            Set .objConcretSuperClass = New Abstract
    
    
            'Referencing the' Abstract 'interface, where are the extended methods
            Set .objInterfaceSuperClass = .objConcretSuperClass
    
    
            'Creating a refence for the C1 interface, which is the class' Abstract'
            'Here we have the particular implementations of M1 and M2
            Set .objInterfaceSubClass = Me
    
        End With
    
    End Sub
    
    
    
    'With this we can do:
    '   set objC1 = New C1
    '   objC1.getInterface.Abstract_M1
    '   objC1.getInterface.Abstract_M2
    Property Get getInterface() As Abstract
        Set getInterface = this.objInterfaceSubClass
    End Property
    
    
    
    'With this we can call the methods defined in' Abstract ': SM1 and SM2
    '   set objC1 = New C1
    '   objC1.getSuperClass.SM1 "hello!"
    '   temp = objC1.getSuperClass.SM2 (New Collection)
    Property Get getSuperClass() As IAbstract
        Set getSuperClass = this.objInterfaceSuperClass
    End Property
    
    'Here we have the particular implementations of M1 and M2
    Private Sub Abstract_M1(strString As String)
        Debug.Print "Class C1 => Sub Abstract_M1: " & strString
    End Sub
    
    Private Function Abstract_M2(varItem As Variant) As String
        Debug.Print "Class C1 => Function Abstract_M2: " & ObjPtr(varItem)
    End Function
    
    
    ' -----------------------------------------------
    
    ' C2 class module
    
    Implements Abstract
    
    Private Type TC2
        objConcretSuperClass As Abstract
        objInterfaceSuperClass As IAbstract
        objInterfaceSubClass As Abstract
    End Type
    
    Private this As TC2
    
    'if you do not need to initialize anything, then this is it:
    Private Sub Class_Initialize()
    
        With this
    
            'creating an instance of class' Abstract'
            Set .objConcretSuperClass = New Abstract
    
            'Referencing the' Abstract 'interface, where are the extended methods
            Set .objInterfaceSuperClass = .objConcretSuperClass
    
            'Creating a refence for the C1 interface, which is the class' Abstract'
            'Here we have the particular implementations of M1 and M2
            Set .objInterfaceSubClass = Me
    
        End With
    
    End Sub
    
    
    
    'With this we can do:
    '   set objC2 = New C2
    '   objC2.getInterface.Abstract_M1
    '   objC2.getInterface.Abstract_M2
    Property Get getInterface() As Abstract
        Set getInterface = this.objInterfaceSubClass
    End Property
    
    'With this we can call the methods defined in' Abstract ': SM1 and SM2
    '   set objC1 = New C1
    '   objC1.getSuperClass.SM1 "hello!"
    '   temp = objC1.getSuperClass.SM2 (New Collection)
    Property Get getSuperClass() As IAbstract
        Set getSuperClass = this.objInterfaceSuperClass
    End Property
    
    'Here we have the particular implementations of M1 and M2
    Private Sub Abstract_M1(strString As String)
        Debug.Print "Class C2 => Sub Abstract_M1: " & strString
    End Sub
    
    Private Function Abstract_M2(varItem As Variant) As String
        Debug.Print "Class C2 => Function Abstract_M2: " & ObjPtr(varItem)
    End Function
    

    Immediate Check Window (CTRL + G):

    Class C1 => Sub Abstract_M1: Hello C1!
    Class C1 => Function Abstract_M2: 550324728
    Sub IAbstract_SM1: Hi C1!!!
    Function IAbstract_SM2 => ObjPtr(varItem): 550324728
    
    Class C2 => Sub Abstract_M1: Hello C2!
    Class C2 => Function Abstract_M2: 550324728
    Sub IAbstract_SM1: Hi C2!!!
    Function IAbstract_SM2 => ObjPtr(varItem): 550324728
    
    0 讨论(0)
提交回复
热议问题