如何在VBA中实现Factory项目模式？

Question

我想知道是否可以在VBA的限制内应用于Factory Method项目模式。如果可能的话，您能举个例子吗？

Answer 1

在默认模块中创建：

modEnumPizza

Public Enum enumTypePizza

    Pepperoni
    Cheese

End Enum

modMain

Sub Main()

    Dim objPizza As IPizza
    Dim objFactory As Factory

    Set objFactory = New Factory

    Set objPizza = objFactory.CreatingPizza(Cheese, "Cheese Pizza", "mozzarella, oregano, olive, simple sauce", 25.99)

    Debug.Print "Name: " & objPizza.getName
    Debug.Print "Ingredients: " & objPizza.getIngredients
    Debug.Print "Price: " & objPizza.getPrice

    Set objPizza = objFactory.CreatingPizza(Pepperoni, "Pepperoni Pizza",     "Calabresa, onion, olive, oregano", 30.99)

    Debug.Print "Name: " & objPizza.getName
    Debug.Print "Ingredients: " & objPizza.getIngredients
    Debug.Print "Price: " & objPizza.getPrice

End Sub    

在类模块中创建：

IPizza

Sub create(ByVal name As String, ByVal ingredients As String, ByVal price As Double): End Sub
Property Get getName() As String: End Property
Property Get getIngredients() As String: End Property
Property Get getPrice() As Long: End Property

clsCheese

Implements IPizza
Implements ICreate

Private Type TType
    name As String
    ingredients As String
    price As Double    
End Type

Private this As TType

Private Sub IPizza_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double)

    With this
        .name = name
        .ingredients = ingredients
        .price = price
    End With

End Sub

Private Property Get IPizza_getIngredients() As String
    IPizza_getIngredients = this.ingredients
End Property

Private Property Get IPizza_getName() As String
    IPizza_getName = this.name
End Property

Private Property Get IPizza_getPrice() As Long
    IPizza_getPrice = this.price
End Property

cls意大利辣味香肠

Implements IPizza

Private Type TType
    name As String
    ingredients As String
    price As Double    
End Type

Private this As TType

Private Sub IPizza_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double)

    With this
        .name = name
        .ingredients = ingredients
        .price = price
    End With

End Sub

Private Property Get IPizza_getIngredients() As String
    IPizza_getIngredients = this.ingredients
End Property

Private Property Get IPizza_getName() As String
    IPizza_getName = this.name
End Property

Private Property Get IPizza_getPrice() As Long
    IPizza_getPrice = this.price
End Property

工厂

Function CreatingPizza(ByVal enumPizza As enumTypePizza, ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    Dim objPizza As IPizza

    If enumPizza = Cheese Then

        Set objPizza = New clsCheese

    ElseIf enumPizza = Pepperoni Then

        Set objPizza = New clsPepperoni

    End If

    objPizza.create name, ingredients, price

    Set CreatingPizza = objPizza

End Function

有关出厂默认设置的详细信息，请参阅“使用头-设计模式”一书。

从modMain模块运行Main，然后查看“验证”窗口（CTRL + G）。

请注意，在“工厂”类中，我们具有“ CreatingPizza”功能，该功能通过Enum类型（enumPizza）选择要创建的比萨的类型。如果我们要创建数十种不同的披萨，那么我们将有数十种IF。如果必须从模块modEnumPizza中获取风味，则必须更改“ CreatingPizza”。

此外，“创建”方法在IntelliSense中可见。如果这个事实以及我们有很多IF的事实不能使您满意，我将使用的一种解决方案是：

创建一个负责“创建”方法的接口：

ICreateCheese

Function create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza: End Function

ICreatePepperoni

Function create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza: End Function

现在从IPizza中删除“ crete”方法：

IPizza

Property Get getName() As String: End Property
Property Get getIngredients() As String: End Property
Property Get getPrice() As Long: End Property

现在，clsChesse和clsPepperoni分别实现ICreateChesse和ICreatePepperoni。

clsCheese

Implements IPizza
Implements ICreateChesse

Private Type TType
    name As String
    ingredients As String
    price As Double

End Type

Private this As TType

Private Function ICreateChesse_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    With this
        .name = name
        .ingredients = ingredients
        .price = price
    End With

    Set ICreateChesse_create = Me

End Function

Private Property Get IPizza_getIngredients() As String
    IPizza_getIngredients = this.ingredients
End Property

Private Property Get IPizza_getName() As String
    IPizza_getName = this.name
End Property

Private Property Get IPizza_getPrice() As Long
    IPizza_getPrice = this.price
End Property

cls意大利辣香肠

Implements IPizza
Implements ICreatePepperoni

Private Type TType
    name As String
    ingredients As String
    price As Double

End Type

Private this As TType

Private Function ICreatePepperoni_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    With this
        .name = name
        .ingredients = ingredients
        .price = price
    End With

    Set ICreatePepperoni_create = Me

End Function

Private Property Get IPizza_getIngredients() As String
    IPizza_getIngredients = this.ingredients
End Property

Private Property Get IPizza_getName() As String
    IPizza_getName = this.name
End Property

Private Property Get IPizza_getPrice() As Long
    IPizza_getPrice = this.price
End Property

工厂

Implements ICreateChesse
Implements ICreatePepperoni

Private Type TType
    'Could be a Dictionary References => Microsoft Scripting Runtime
    objCollection As Collection
    objPizza As IPizza

End Type

Private this As TType

Private Sub Class_Initialize()

    Dim objInterfaceChesse As ICreateChesse
    Dim objInterfacePepperoni As ICreatePepperoni

    Set objInterfaceChesse = Me
    Set objInterfacePepperoni = Me

    Set this.objCollection = New Collection


    'We now have a collection of instance variables pointing to ICreateChesse_create and
    'ICreatePepperoni_create
    With this.objCollection

        .Add objInterfaceChesse, CStr(enumTypePizza.Cheese)
        .Add objInterfacePepperoni, CStr(enumTypePizza.Pepperoni)

    End With


End Sub


Function CreatingPizza(ByVal enumPizza As enumTypePizza, ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    Dim objInterface As Object

                       'we return the corresponding instance variable
    Set objInterface = this.objCollection(CStr(enumPizza))

                        'method call by late binding
    Set CreatingPizza = objInterface.create(name, ingredients, price)

End Function


Private Function ICreateChesse_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    Dim objPizza As clsCheese
    Dim objInterfaceChesse As ICreateChesse

    'We create an instance of clsPizza
    Set objPizza = New clsCheese

    'We point to the interface address in clsChesse
    Set objInterfaceChesse = objPizza

    'I call the 'create' method of the instance of clsPizza, which returns the interface I`Pizza
    Set ICreateChesse_create = objInterfaceChesse.create(name, ingredients, price)

    Set objPizza = Nothing
    Set objInterfaceChesse = Nothing

End Function

Private Function ICreatePepperoni_create(ByVal name As String, ByVal ingredients As String, ByVal price As Double) As IPizza

    Dim objPizza As clsPepperoni
    Dim objInterfacePepperoni As ICreatePepperoni

    Set objPizza = New clsPepperoni

    Set objInterfacePepperoni = objPizza

    Set ICreatePepperoni_create = objInterfacePepperoni.create(name, ingredients, price)

    Set objPizza = Nothing
    Set objInterfacePepperoni = Nothing

End Function

ModMain不变。

项目看起来像这样：

另一个避免使用Factory类数据结构的替代方法是： 创建一个名为ISelectCreator的接口，我们可以通过intelliSense返回使用的接口：ICreateChesse或ICreatePepperoni。

有了这个，我们可以排除模块modEnumPizza。另外，随着Factory类的更改，modMain模块也将被修改。

这是Factory类中的新重构以及ISelectCreator接口的创建：

ISelectCreator

Property Get getCreateChesse() As ICreateChesse: End Property
Property Get getCreatePepperoni() As ICreatePepperoni: End Property

工厂

Implements ISelectCreator

Function CreatingPizza() As ISelectCreator

    'with this intelliSense will show: getCreateChesse and getCreatePepperoni
    Set CreatingPizza = Me

End Function

Private Property Get ISelectCreator_getCreateChesse() As ICreateChesse

    Dim objPizza As clsCheese

    Set objPizza = New clsCheese

    Set ISelectCreator_getCreateChesse = objPizza

End Property

Private Property Get ISelectCreator_getCreatePepperoni() As ICreatePepperoni

    Dim objPizza As clsPepperoni

    Set objPizza = New clsPepperoni

    Set ISelectCreator_getCreatePepperoni = objPizza

End Property

Factory类要简单得多。

modMain：主要

Sub Main()

    Dim objPizza As IPizza
    Dim objFactory As Factory

    Set objFactory = New Factory

    Set objPizza = objFactory.CreatingPizza.getCreateChesse.create("Cheese Pizza", "mozzarella, oregano, olive, simple sauce", 25.99)

    Debug.Print "Name: " & objPizza.getName
    Debug.Print "Ingredients: " & objPizza.getIngredients
    Debug.Print "Price: " & objPizza.getPrice

    Set objPizza = objFactory.CreatingPizza.getCreatePepperoni.create("Pepperoni     Pizza", "Calabresa, onion, olive, oregano", 30.99)

    Debug.Print "Name: " & objPizza.getName
    Debug.Print "Ingredients: " & objPizza.getIngredients
    Debug.Print "Price: " & objPizza.getPrice

End Sub

输出：

实际上这是我目前使用它的方式。就是这样，工厂方法是可能的。