VBA Class 继承

VBA Class Inheritance

我正在编写一个脚本来帮助我根据用户输入在 3D 软件中创建几何体,我想用 classes 来解决这个问题。我有 3 层结构、点、曲线和曲面,所以我想为每个创建一个 class,其中下一层结构继承较低的结构。 因此,例如 class cPoint 有 4 个属性:x、y、z、id。此外,class cCurve 只有 2 个属性:id 和 points,对于曲面也是如此。 现在我的问题是:我实现了 class cPoint 如下:

Private x_ As Double
Private y_ As Double
Private z_ As Double
Private id_ As Long

Public Property Let X(ByVal value As Double)
    x_ = value
End Property
Public Property Let Y(ByVal value As Double)
    y_ = value
End Property
Public Property Let Z(ByVal value As Double)
    z_ = value
End Property
Public Property Let ID(ByVal value As Long)
    id_ = value
End Property
Public Property Get X() As Double
    X = x_
End Property
Public Property Get Y() As Double
    Y = y_
End Property
Public Property Get Z() As Double
    Z = z_
End Property
Public Property Get ID() As Long
    ID = id_
End Property

这里一切都很好。在这里我实现了 class cCurve:

Implements cPoint

Private id_ As Long
Private point_ As Collection

Public Property Let ID(ByVal value As Long)
    id_ = value
End Property
Public Property Set point(ByVal value As Collection)
    Set point_ = value
End Property
Public Property Get ID() As Long
    ID = id_
End Property
Public Property Get point() As Collection
    Set point = point_
End Property

但是在这里,当我尝试 运行 代码时,出现以下错误提示: Object module needs to implement 'X' for interface 'cPoint' 我想我知道这意味着什么,但我不知道如何实现它。我的方法是否正确? 如果能以这种方式提供任何指导,我将不胜感激。

VBA不支持继承。模仿继承的唯一方法是实现您的 Point class,同时在您的曲线 class 中拥有 Point class 的私有实例。这就是您的“Point”class 的样子(我使用“GeometryPoint”作为 class 的名称,因为 Excel 已经创建了一个“Point”class) :

Option Explicit

Private Type TState
    ID  As Long
    X   As Double
    Y   As Double
    Z   As Double
End Type

Private This As TState

Public Property Let ID(ByVal Value As Long)
    This.ID = Value
End Property
Public Property Get ID() As Long
    ID = This.ID
End Property

Public Property Let X(ByVal Value As Double)
    This.X = Value
End Property
Public Property Get X() As Double
    X = This.X
End Property

Public Property Let Y(ByVal Value As Double)
    This.Y = Value
End Property
Public Property Get Y() As Double
    Y = This.Y
End Property

Public Property Let Z(ByVal Value As Double)
    This.Z = Value
End Property
Public Property Get Z() As Double
    Z = This.Z
End Property

这就是您的“曲线”class 的样子:

Option Explicit
Implements GeometryPoint

Private Type TState
    Base        As GeometryPoint
    ID          As Long
    Points      As Collection
    X           As Double
    Y           As Double
    Z           As Double
End Type

Private This As TState

Public Property Let GeometryPoint_ID(ByVal Value As Long)
    This.Base.ID = Value
End Property
Public Property Get GeometryPoint_ID() As Long
    GeometryPoint_ID = This.Base.ID
End Property

Public Property Let GeometryPoint_X(ByVal Value As Double)
    This.Base.X = Value
End Property
Public Property Get GeometryPoint_X() As Double
    GeometryPoint_X = This.Base.X
End Property

Public Property Let GeometryPoint_Y(ByVal Value As Double)
    This.Base.Y = Value
End Property
Public Property Get GeometryPoint_Y() As Double
    GeometryPoint_Y = This.Base.Y
End Property

Public Property Let GeometryPoint_Z(ByVal Value As Double)
    This.Base.Z = Value
End Property
Public Property Get GeometryPoint_Z() As Double
    GeometryPoint_Z = This.Base.Z
End Property

Public Property Set Points(ByVal Value As Collection)
    Set This.Points = Value
End Property
Public Property Get Points() As Collection
    Set Points = This.Points
End Property

Private Sub Class_Initialize()
    Set This.Base = New GeometryPoint
End Sub

Private Sub Class_Terminate()
    Set This.Base = Nothing
End Sub

在 VBA 中,当您“实现”一个 class 时,您需要列出该 class 的所有成员(属性、方法)。在您的情况下,您收到了一个错误,因为您没有列出您正在实施的 cPoint class 的 X、Y、Z 属性。 “曲线”class 是否也应该具有 X、Y、Z 属性?如果不是,那么您不应该实施 Point class。如果曲线 class 只是存储点集合的 class,那么您的曲线 class 应该如下所示:

**注意:此代码经过编辑以包含“Class_Initialize”方法,该方法在实例化曲线 class 后将“Points”成员设置为新集合。

Option Explicit

Private Type TState
    ID          As Long
    Points      As Collection
End Type

Private This As TState

Public Property Let ID(ByVal Value As Long)
    This.ID = Value
End Property
Public Property Get ID() As Long
    ID = This.ID
End Property

Public Property Set Points(ByVal Value As Collection)
    Set This.Points = Value
End Property
Public Property Get Points() As Collection
    Set Points = This.Points
End Property

Private Sub Class_Initialize()
    Set This.Points = New Collection
End Sub

Private Sub Class_Terminate()
    Set This.Points = Nothing
End Sub

最后,向曲线 class 中的“Points”成员添加一个新的 Point 对象将如下所示:

Dim NewPoint As GeometryPoint
Dim NewCurve As Curve

Set NewPoint = New GeometryPoint
With NewPoint
    .X = 1
    .Y = 2
    .Z = 3
End With

Set NewCurve = New Curve
With NewCurve.Points
    .Add NewPoint
End With