yu-tang/IConstructor.cls

## ReadMe.md

      
    Raw
  

              ReadMe.md
            
          
    Constructor for VBA class module について

目的

VBA のクラス モジュールにおいて、引数を渡すことのできる擬似コンストラクタを提供します。
使い方


対象のプロジェクトに以下の二つのモジュールを作成します（他のモジュールはテスト用なので、不要です）。

IConstructor (クラス モジュール)
modConstructor (標準モジュール)


対象のクラスモジュールのヘッダーに、以下のステートメントを貼り付けます。
 Implements IConstructor


VBE の [オブジェクト] ボックスから「IConstructor」を選択し、挿入されるコンストラクタ用プロシージャ内に初期化用の処理を記述します。


呼び出す側は、以下のように記述します。
 Set var = Constructor(New MyClass, "Doe, John", #5/7/1989#)

第一引数に対象クラスのインスタンスを、第二引数以後には初期化用のデータを指定します。
Constructor 関数は、第二引数以後のデータで初期化した第一引数のインスタンスを返します。


背景

VBA には、クラスのインスタンス生成時に初期化用の引数を渡すことのできるコンストラクタが存在しません。
そのため、コンストラクタを代替するためにいろいろな方法が考案されてきました（もちろん本関数も、そのひとつです）。
この関数は、コンストラクタ代替関数にしばしば見られる以下のような制約を解消または軽減する目的で、設計されました。

クラスに追加されたコンストラクタ用のメンバが外部に公開されるため、
インテリセンスの候補リスト上でノイズになる。
クラスに追加されたコンストラクタ用のメンバを外部から任意のタイミングで呼べるため、
複数回の初期化が可能だったり、
あるいは複数回の初期化を抑止するための仕掛けが各クラス内に必要だったりする。
クラスに追加されたコンストラクタ用のメンバの命名に制約が無いため、
名称がバラバラで見通しが悪かったり、
あるいは規約で統一が求められる場合は人の注意力に頼るしかなかったりする。

本関数を使用することにより、以下の改善を期待できます。

初期化専用のインターフェイスを用いるため、コンストラクタ用のメンバが本来のクラスに公開されず、
インテリセンスの候補リスト上でノイズにならない。
コンストラクタ用のメンバは New の直後一回きりしか呼べないため、
複数回の初期化が不可能。
またこの制約は本関数側で面倒を見るため、各クラスには特にそのための仕掛けが不要。
インターフェイスを使用するため、コンストラクタ用のメンバは強制的に統一される。
また VBE の [オブジェクト] ボックスからインターフェイスを選択するだけでコンストラクタ用のメンバが挿入されるため、
人の注意力は不要。

一方、本関数を使用しても実現できないことは、以下のとおりです。

各クラスに応じて、初期化用引数の個数やデータ型を制限することはできません。
本関数を経由しないで独自にインスタンスを生成することは、抑止できません。

仕組みは、単純にコンストラクタ用のメンバを専用のインターフェイスに分離して、二重初期化防止のチェックを入れただけです。
実行時エラー

Constructor 関数は、変数にセット済みのインスタンスを渡された場合、実行時エラーを発生させます。
Set var = New MyClass
Set var = Constructor(var, "Doe, John", #5/7/1989#)  ' ここでエラーが発生します。

注意点

Constructor 関数は、IConstructor インターフェイスを実装していないクラスのインスタンスも第一引数に許容します。その場合は、第二引数以後は無視され、単純に第一引数がそのまま返ります。エラーは発生しません。
これは意図的な実装です。
ひとつには、インスタンス化に Constructor 関数を使うケースと使わないケースが混在すると、
その使い分け自体が負担になるという事態を避けることが目的です。
現在の実装では、何も考えずに一律 Constructor 関数を呼ぶというルーズな使い方をすることができます。
もうひとつは、途中で引数が不要になってクラスの設計が変更になっても、呼び出し部を変えずに使用を継続できるようにするためです。
たとえば、当初は引数を渡していたものが、バージョンアップ時に環境変数から取得できるようにしたので引数は不要になりました、という変更が発生することは珍しくありません（特に引数の引き渡しが原因でバグが発生した後の改修時に多く見られる）。その際に、クラスから IConstructor インターフェイスを外したいけれど、呼び出している箇所まで片っ端から直して回るのは嫌だ、という場合は、そのままでも動くようにしています（でも、直せたら直したほうが良いとは思いますが…）。

  
## IConstructor.cls
Option Explicit

Public Sub Initialize(args() As Variant)
'
End Sub

## modConstructor.bas
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (dest As Any, src As Any, ByVal nbytes _
    As Long)

'---------------------------------------------------------------------------------------
' Procedure : Constructor
' Author    : Yu-Tang
' Date      : 2012/03/09
' Purpose   : Constructor for class module.
' Usage     : Step 1. Add "Implements IConstructor" statement to class header.
'             Step 2. Add IConstructor_Initialize event procedure to class body.
'             Step 3. Instantiate like this;
'                     Set c = Constructor(New MyClass, "Doe, John", #5/7/1989#)
' Dependency: IConstructor
'---------------------------------------------------------------------------------------
'
Public Function Constructor(o As Object, ParamArray args() As Variant)
' エラーチェック
If GetRefCount(o) > 0 Then
    Err.Raise 5, "Constructor", _
              TypeName(o) & " 型のオブジェクトは、すでに参照されています。" & _
              vbCrLf & vbCrLf & _
              "Constructor は New の直後のみ使用可能です。"
End If
If TypeOf o Is IConstructor Then
    ' ParamArray を直接 別関数の引数に渡すことはできないので、
    ' いったんローカル変数を経由する。
    Dim v() As Variant: v = args
    ConstructorFrom(o).Initialize v
End If
Set Constructor = o
End Function

Private Function ConstructorFrom(o As Object) As IConstructor
Set ConstructorFrom = o
End Function

' VB Helper: HowTo: Get an object's reference count in Visual Basic 6
' http://www.vb-helper.com/howto_get_reference_count.html
'
' Return the number of references to the object.
' We subtract 3 to adjust for references made by parameters.
Private Function GetRefCount(ByRef obj As IUnknown) As Long
    If obj Is Nothing Then Exit Function
    CopyMemory GetRefCount, ByVal (ObjPtr(obj)) + 4, 4
    GetRefCount = GetRefCount - 3
End Function

## modTest.bas
Option Explicit

Sub TestForConstructor()
On Error Resume Next

    Dim c  As MyClass
    Dim c2 As MyClass2

    Debug.Print "-- MyClass を Constructor で初期化"
    Set c = Constructor(New MyClass, "Parker, Peter", #9/1/1962#)
    If Err.Number Then
        Debug.Print "実行時エラー"; Err.Number, Err.Description
    End If
    Debug.Print "Name:", c.Name
    Debug.Print "BirthDate:", c.BirthDate
    Debug.Print

    Err.Clear
    Debug.Print "-- MyClass を Constructor で初期化(変数にセットした後、二回目)"
    Set c = Constructor(c, "Parker, Peter", #9/1/1962#)
    If Err.Number Then
        Debug.Print "実行時エラー"; Err.Number, Err.Description
    End If
    Debug.Print

    Err.Clear
    Debug.Print "-- MyClass2 (IConstructor を Implement していない) を Constructor で初期化"
    Set c2 = Constructor(New MyClass2, "Parker, Peter", #9/1/1962#)
    If Err.Number Then
        Debug.Print "実行時エラー"; Err.Number, Err.Description
    End If
    Debug.Print "Name:", c2.Name
    Debug.Print "BirthDate:", c2.BirthDate
    Debug.Print

End Sub

## MyClass.cls
Option Explicit

Implements IConstructor

Private mName      As String
Private mBirthDate As Date

Private Sub Class_Initialize()
Debug.Print TypeName(Me) & ".Class_Initialize()"
mName = "Doe, John"
mBirthDate = Date
End Sub

Private Sub IConstructor_Initialize(args() As Variant)
Debug.Print TypeName(Me) & ".IConstructor_Initialize()", UBound(args), LBound(args)
' 引数なしの場合は、UBound(args) = -1, LBound(args) = 0 の空配列になります。
If UBound(args) <> 1 Then Err.Raise 5
mName = args(0)
mBirthDate = args(1)
End Sub

Public Property Get Name() As String
Name = mName
End Property

Public Property Get BirthDate() As Date
BirthDate = mBirthDate
End Property

## MyClass2.cls
Option Explicit

Private mName      As String
Private mBirthDate As Date

Private Sub Class_Initialize()
Debug.Print TypeName(Me) & ".Class_Initialize()"
mName = "Doe, John"
mBirthDate = Date
End Sub

Public Property Get Name() As String
Name = mName
End Property

Public Property Get BirthDate() As Date
BirthDate = mBirthDate
End Property
	Option Explicit

	Public Sub Initialize(args() As Variant)
	'
	End Sub
	Option Explicit

	Private Declare Sub CopyMemory Lib "kernel32" Alias _
	"RtlMoveMemory" (dest As Any, src As Any, ByVal nbytes _
	As Long)

	'---------------------------------------------------------------------------------------
	' Procedure : Constructor
	' Author : Yu-Tang
	' Date : 2012/03/09
	' Purpose : Constructor for class module.
	' Usage : Step 1. Add "Implements IConstructor" statement to class header.
	' Step 2. Add IConstructor_Initialize event procedure to class body.
	' Step 3. Instantiate like this;
	' Set c = Constructor(New MyClass, "Doe, John", #5/7/1989#)
	' Dependency: IConstructor
	'---------------------------------------------------------------------------------------
	'
	Public Function Constructor(o As Object, ParamArray args() As Variant)
	' エラーチェック
	If GetRefCount(o) > 0 Then
	Err.Raise 5, "Constructor", _
	TypeName(o) & " 型のオブジェクトは、すでに参照されています。" & _
	vbCrLf & vbCrLf & _
	"Constructor は New の直後のみ使用可能です。"
	End If
	If TypeOf o Is IConstructor Then
	' ParamArray を直接別関数の引数に渡すことはできないので、
	' いったんローカル変数を経由する。
	Dim v() As Variant: v = args
	ConstructorFrom(o).Initialize v
	End If
	Set Constructor = o
	End Function

	Private Function ConstructorFrom(o As Object) As IConstructor
	Set ConstructorFrom = o
	End Function

	' VB Helper: HowTo: Get an object's reference count in Visual Basic 6
	' http://www.vb-helper.com/howto_get_reference_count.html
	'
	' Return the number of references to the object.
	' We subtract 3 to adjust for references made by parameters.
	Private Function GetRefCount(ByRef obj As IUnknown) As Long
	If obj Is Nothing Then Exit Function
	CopyMemory GetRefCount, ByVal (ObjPtr(obj)) + 4, 4
	GetRefCount = GetRefCount - 3
	End Function
	Option Explicit

	Sub TestForConstructor()
	On Error Resume Next

	Dim c As MyClass
	Dim c2 As MyClass2

	Debug.Print "-- MyClass を Constructor で初期化"
	Set c = Constructor(New MyClass, "Parker, Peter", #9/1/1962#)
	If Err.Number Then
	Debug.Print "実行時エラー"; Err.Number, Err.Description
	End If
	Debug.Print "Name:", c.Name
	Debug.Print "BirthDate:", c.BirthDate
	Debug.Print

	Err.Clear
	Debug.Print "-- MyClass を Constructor で初期化(変数にセットした後、二回目)"
	Set c = Constructor(c, "Parker, Peter", #9/1/1962#)
	If Err.Number Then
	Debug.Print "実行時エラー"; Err.Number, Err.Description
	End If
	Debug.Print

	Err.Clear
	Debug.Print "-- MyClass2 (IConstructor を Implement していない) を Constructor で初期化"
	Set c2 = Constructor(New MyClass2, "Parker, Peter", #9/1/1962#)
	If Err.Number Then
	Debug.Print "実行時エラー"; Err.Number, Err.Description
	End If
	Debug.Print "Name:", c2.Name
	Debug.Print "BirthDate:", c2.BirthDate
	Debug.Print

	End Sub
	Option Explicit

	Implements IConstructor

	Private mName As String
	Private mBirthDate As Date

	Private Sub Class_Initialize()
	Debug.Print TypeName(Me) & ".Class_Initialize()"
	mName = "Doe, John"
	mBirthDate = Date
	End Sub

	Private Sub IConstructor_Initialize(args() As Variant)
	Debug.Print TypeName(Me) & ".IConstructor_Initialize()", UBound(args), LBound(args)
	' 引数なしの場合は、UBound(args) = -1, LBound(args) = 0 の空配列になります。
	If UBound(args) <> 1 Then Err.Raise 5
	mName = args(0)
	mBirthDate = args(1)
	End Sub

	Public Property Get Name() As String
	Name = mName
	End Property

	Public Property Get BirthDate() As Date
	BirthDate = mBirthDate
	End Property