第16回
Collectionオブジェクトを利用して、Fieldオブジェクトを配列化する

Public Name As String
Private mvarActualSize As Long
Private mvarAttributes As Long
Private mvarDefinedSize As Long
Private mvarNumericScale As Byte
Private mvarOriginalValue As Variant
Private mvarPrecision As Byte
Private mvarDataType As Long
Private mvarUnderlyingValue As Variant

Public Property Get UnderlyingValue() As Variant
    UnderlyingValue = dsRecordset.Fields(Name).UnderlyingValue
End Property

Public Property Let DataType(ByVal vData As Long)
    dsRecordset.Fields(Name).Type = vData
End Property

Public Property Get DataType() As Long
    DataType = dsRecordset.Fields(Name).Type
End Property

Public Property Get Precision() As Byte
    Precision = dsRecordset.Fields(Name).Precision
End Property

Public Property Get OriginalValue() As Variant
    OriginalValue = dsRecordset.Fields(Name).OriginalValue
End Property

Public Property Let NumericScale(ByVal vData As Byte)
    dsRecordset.Fields(Name).NumericScale = vData
End Property

Public Property Get NumericScale() As Byte
    NumericScale = dsRecordset.Fields(Name).NumericScale
End Property

Public Property Get DefinedSize() As Long
    DefinedSize = dsRecordset.Fields(Name).DefinedSize
End Property

Public Property Let Attributes(ByVal vData As Long)
    dsRecordset.Fields(Name).Attributes = vData
End Property

Public Property Get Attributes() As Long
    Attributes = dsRecordset.Fields(Name).Attributes
End Property

Public Property Get ActualSize() As Long
    ActualSize = dsRecordset.Fields(Name).ActualSize
End Property

Public Property Let Value(ByVal vData As Variant)
    MsgBox Name & "項目の値が'" & dsRecordset.Fields(Name).OriginalValue & _
     "'から'" & vData & "'に変更されます。"
    dsRecordset.Fields(Name) = vData
End Property

Public Property Get Value() As Variant
    Value = dsRecordset.Fields(Name).Value
End Property

' コレクションを保持するローカル変数
Private mCol As Collection

Public Function Add(Name As String, Optional sKey As String) As DBCliLib.Field
    ' 新規オフジェクトを作成します
    Dim objNewMember As DBCliLib.Field
    Set objNewMember = New DBCliLib.Field

    ' メソッドに渡すプロパティを設定します
    objNewMember.Name = Name
    If Len(sKey) = 0 Then
        mCol.Add objNewMember
    Else
        mCol.Add objNewMember, sKey
    End If

    ' 作成されたオブジェクトを返します
    Set Add = objNewMember
    Set objNewMember = Nothing
End Function

Public Property Get Item(vntIndexKey As Variant) As DBCliLib.Field
    ' コレクションの要素を参照するときに使用します
    ' vntIndexKeyはインデックスまたはキーのどちらかを
    ' 保持するためにVariantで宣言されています
    ' 構文: Set foo = x.Item(xyz) または Set foo = x.Item(5)
    Set Item = mCol(vntIndexKey)
End Property

Public Property Get Count() As Long
    ' コレクションの要素数を取得するときに使用します
    ' 構文: Debug.Print x.Count
    Count = mCol.Count
End Property

Public Sub Remove(vntIndexKey As Variant)
    ' コレクションから要素を削除するときに使用します
    ' vntIndexKeyはインデックスまたはキーのどちらかを
    ' 保持するためにVariantで宣言されています
    ' 構文: x.Remove(xyz)
    mCol.Remove vntIndexKey
End Sub

Public Property Get NewEnum() As IUnknown
    ' このプロパティは、For...Each 構文を使用して
    ' コレクションを列挙できるようにします
    Set NewEnum = mCol.［_NewEnum］
End Property

Private Sub Class_Initialize()
    ' このクラスが作成されたときに、コレクションを作成します
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    ' このクラスが終了するときに、コレクションを破棄します
    Set mCol = Nothing
End Sub

Option Explicit

Private Sub cmdConn_Click()
    ' Set cn = Controls.Add("DBCliLib.Connection", "control1")
    cmdConn.Enabled = False
    cmdSend.Enabled = True
    
    cn.ServerName = "localhost"
    cn.ServerPort = 1010
    cn.cnOpen "BIBLIO"
End Sub

Private Sub cmdNext_Click()
    rs.MoveNext
End Sub

Private Sub cmdPrev_Click()
    rs.MovePrevious
End Sub

Private Sub cmdSend_Click()
    ' Set rs = Controls.Add("DBCliLib.Recordset", "control2")
    rs.rsOpen "SELECT * FROM Authors WHERE Author like 'a%'", cn
End Sub

Private Sub Command1_Click()
    rs("Au_ID") = 1000
End Sub

Private Sub rs_AfterMoveRecord()
    MsgBox "レコードセットを移動しました"
End Sub

Private Sub rs_BeforeMoveRecord()
    MsgBox "レコードセットを移動します"
End Sub

Private Sub rs_RecordsetComplete()
    Set DataGrid1.DataSource = rs
End Sub