'''Builders.cls
    
    Public Sub BuilDoor()   '门

    End Sub
    Public Sub BuilWall()   '墙

    End Sub
    Public Sub BuilWindow() '窗口
    
    End Sub
    Public Sub BuilFloor()  '地板
    
    End Sub
    Public Sub BuilHouseCeiling() '屋顶
    
    End Sub

 '''ChinaHouseBuiler.cls

 
Implements Builders

Private Sub Builders_BuilDoor()
    MsgBox "中国门"
End Sub

Private Sub Builders_BuilFloor()
    MsgBox "中国地板"
End Sub

Private Sub Builders_BuilHouseCeiling()
    MsgBox "中国屋顶"
End Sub

Private Sub Builders_BuilWall()
    MsgBox "中国墙"
End Sub

Private Sub Builders_BuilWindow()
    MsgBox "中国窗"
End Sub

'''USAHouseBuiler.cls

Implements Builders

Private Sub Builders_BuilDoor()
    MsgBox "美国门"
End Sub

Private Sub Builders_BuilFloor()
    MsgBox "美国地板"
End Sub

Private Sub Builders_BuilHouseCeiling()
    MsgBox "美国屋顶"
End Sub

Private Sub Builders_BuilWall()
    MsgBox "美国墙"
End Sub

Private Sub Builders_BuilWindow()
    MsgBox "美国窗"
End Sub

'''HouseModule.cls

Dim m_GetHouseType As New Builders
Public Property Get Gethousetype() As Builders
    Set Gethousetype = m_GetHouseType
End Property
Public Property Set Gethousetype(ByVal NewType As Builders)
    Set m_GetHouseType = NewType
    Call CreateHouse
End Property
Private Sub CreateHouse()
    m_GetHouseType.BuilDoor
    m_GetHouseType.BuilFloor
    m_GetHouseType.BuilHouseCeiling
    m_GetHouseType.BuilWall
    m_GetHouseType.BuilWindow
End Sub

'''From1_Click
Private Sub Form_Click()
Dim Builder As New HouseModule

Set Builder.Gethousetype = New ChinaHouseBuiler
Set Builder.Gethousetype = New USAHouseBuiler

Set Builder = Nothing

End Sub

Builder 生成器模式源码
Builder 生成器模式示意图

[[it] 本帖最后由 ioriliao 于 2008-2-20 10:54 编辑 [/it]]