VBA と Java のオブジェクト指向プログラミング

Top > Excel VBA でデザインパターン > FactoryMethodパターン

FactoryMethodパターン


FactoryMethodパターンのサンプルプログラムをExcelVBAで記述すると以下の
ようになります。モジュールごとにプログラムを示します。
標準モジュール:modIObject
Option Explicit

'コンストラクタ
Public Function init2(pobjConcrete As clsIObject) As clsIObject
    Dim obj As Object
    Set obj = New clsIObject
    '抽象メソッドの実際の処理が記述されているサブクラスのインスタンスを引数で渡す
    obj.init2 pobjConcrete
    Set init2 = obj
End Function
クラスモジュール:clsIObject
Option Explicit
'抽象メソッドの実際の処理が記述されているサブクラスのインスタンス
Private mobjConcrete As clsIObject

'コンストラクタ
Public Sub init2(pobjConcrete As clsIObject)
    Set mobjConcrete = pobjConcrete
End Sub

Public Property Get concrete() As clsIObject
    Set concrete = mobjConcrete
End Property

標準モジュール:modIFactory
Option Explicit

'コンストラクタ
Public Function init2(pobjConcrete As clsIObject) As clsIFactory
    Dim obj As clsIFactory
    Set obj = New clsIFactory
    obj.init2 pobjConcrete
    Set init2 = obj
End Function
クラスモジュール:clsIFactory
Option Explicit
'スーパークラスの情報
Implements clsIObject
Private mobjSuper As clsIObject

'コンストラクタ
Public Sub init2(pobjConcrete As clsIObject)
    Set mobjSuper = modIObject.init2(pobjConcrete)
End Sub

Public Property Get concrete() As clsIObject
    Set concrete = mobjSuper.concrete
End Property

Public Function create(pstrOwner As String) As clsIProduct
    Dim objConcrete As clsIFactory
    Dim objRtn As clsIProduct
    Set objConcrete = Me.concrete
    Set objRtn = objConcrete.createProduct(pstrOwner)
    objConcrete.registerProduct objRtn
    Set create = objRtn
End Function

Public Function createProduct(pstrOwner As String) As clsIProduct
'
End Function

Public Sub registerProduct(pobjProduct As clsIProduct)
'
End Sub

'----------------------------------------
' clsIObject のインターフェイス
'----------------------------------------
Private Sub clsIObject_init2(pobjConcrete As clsIObject)
'
End Sub

Private Property Get clsIObject_concrete() As clsIObject
    Set clsIObject_concrete = Me.concrete
End Property

クラスモジュール:clsIProduct
Option Explicit

Public Sub use()
'
End Sub

標準モジュール:modCIDCardFactory
Option Explicit

'コンストラクタ
Public Function init1() As clsCIDCardFactory
    Dim obj As clsCIDCardFactory
    Set obj = New clsCIDCardFactory
    obj.init1
    Set init1 = obj
End Function
クラスモジュール:clsCIDCardFactory
Option Explicit
'スーパークラスの情報
Implements clsIObject
Implements clsIFactory
Private mobjSuper As clsIFactory
'プロパティ情報
'ArrayList を Collection で代用
Private mcolOwners As Collection

'コンストラクタ
Public Sub init1()
'    'スーパークラスのコンストラクタの呼び出し
    Set mobjSuper = modIFactory.init2(Me)
    Set mcolOwners = New Collection
End Sub

Public Property Get concrete() As clsIObject
    Set concrete = mobjSuper.concrete
End Property

Public Function create(owner As String) As clsIProduct
    mobjSuper.create owner
End Function

Public Property Get owners() As Collection
    Set owners = mcolOwners
End Property

'----------------------------------------
' clsIFactory のインターフェイス
'----------------------------------------
Private Sub clsIFactory_init2(pobjConcrete As clsIObject)
On Error GoTo error_proc
    Err.Raise 1, , "スーパークラスのコンストラクタは実行できません。"
    Exit Sub
error_proc:
    Debug.Print "clsCIDCardFactory.clsIFactory_init2:" & Err.Number & ":" & Err.Description
    Err.Raise Err.Number, , Err.Description
End Sub

Private Property Get clsIFactory_concrete() As clsIObject
    Set clsIFactory_concrete = Me.concrete
End Property

Private Function clsIFactory_create(owner As String) As clsIProduct
    Set clsIFactory_create = mobjSuper.create(owner)
End Function

Private Function clsIFactory_createProduct(owner As String) As clsIProduct
    Set clsIFactory_createProduct = modCIDCard.init2(owner)
End Function

Private Sub clsIFactory_registerProduct(product As clsIProduct)
    Dim obj As clsCIDCard
    Set obj = product
    mcolOwners.Add obj.owner
End Sub

'----------------------------------------
' clsIObject のインターフェイス
'----------------------------------------
Private Sub clsIObject_init2(pobjConcrete As clsIObject)
On Error GoTo error_proc
    Err.Raise 1, , "スーパークラスのコンストラクタは実行できません。"
    Exit Sub
error_proc:
    Debug.Print "clsCIDCardFactory.clsIObject_init2:" & Err.Number & ":" & Err.Description
    Err.Raise Err.Number, , Err.Description
End Sub

Private Property Get clsIObject_concrete() As clsIObject
    Set clsIObject_concrete = Me.concrete
End Property

標準モジュール:modCIDCard
Option Explicit

'コンストラクタ
Public Function init2(pstrOwner As String) As clsCIDCard
    Dim obj As clsCIDCard
    Set obj = New clsCIDCard
    obj.init2 pstrOwner
    Set init2 = obj
End Function
クラスモジュール:clsCIDCard
Option Explicit
'スーパークラスの情報
Implements clsIProduct
'プロパティ情報
Private mstrOwner As String

'コンストラクタ
Public Sub init2(pstrOwner As String)
    Debug.Print pstrOwner & "のカードを作ります。"
    mstrOwner = pstrOwner
End Sub

Public Property Get owner() As String
    owner = mstrOwner
End Property

'----------------------------------------
' clsIProduct のインターフェイス
'----------------------------------------
Private Sub clsIProduct_use()
    Debug.Print mstrOwner & "のカードを使います。"
End Sub

標準モジュール:modCMain
Option Explicit

'メイン処理1
Sub main1()
    Dim factory As clsIFactory
    Dim card1 As clsIProduct
    Dim card2 As clsIProduct
    Dim card3 As clsIProduct

    Set factory = modCIDCardFactory.init1
    Set card1 = factory.create("結城浩")
    Set card2 = factory.create("とむら")
    Set card3 = factory.create("佐藤花子")

    card1.use
    card2.use
    card3.use

    Dim obj As clsCIDCardFactory
    Dim var As Variant
    Set obj = factory
    Debug.Print
    For Each var In obj.owners
        Debug.Print var
    Next
End Sub

Top > Excel VBA でデザインパターン > FactoryMethodパターン

このページへのコメント

6vk4xm Thanks for sharing, this is a fantastic blog.Much thanks again. Great.

0
Posted by tips about seo 2013年12月20日(金) 00:08:53 返信

VBADP04 - VBA 鐃緒申 Java 鐃塾ワ申鐃瞬ワ申鐃緒申鐃緒申鐃夙指醐申鐃竣ワ申鐃緒申鐃淳ワ申 - Seesaa Wiki鐃淑ワ申鐃緒申鐃緒申鐃緒申 for 鐃緒申鐃殉¥申鐃夙フワ申鐃緒申 ≪潟若 祉若 http://www.pslcbi.com/moncler2014.html

0
Posted by ≪潟若 祉若 2013年12月09日(月) 22:32:59 返信

rTcykS <a href="http://mbmpyqeympjx.com/">mbmpyqeympjx</a>, [url=http://uraliejpsqqf.com/]uraliejpsqqf[/url], [link=http://sujejtbpfped.com/]sujejtbpfped[/link], http://hulxahncsefq.com/

0
Posted by iodfsvsdky 2013年11月19日(火) 18:35:50 返信

Fr2AWZ <a href="http://yyyazgyzswtd.com/">yyyazgyzswtd</a>, [url=http://jhgviwziumyv.com/]jhgviwziumyv[/url], [link=http://beykpzowntuy.com/]beykpzowntuy[/link], http://qirkymdqcyjj.com/

0
Posted by aouqujqqfww 2013年11月15日(金) 09:05:49 返信

コメントをかく


「http://」を含む投稿は禁止されています。

利用規約をご確認のうえご記入下さい

×

この広告は60日間更新がないwikiに表示されております。

編集にはIDが必要です