Сам контроль VB6 UDTs

Часть 2: Перечисление информация о Типе UDT

Теперь пора продемонстрировать, как мы можем пользоваться Библиотекой объектов TypeLib для реализации PrintUDT метод.

Первый, запустите путем создания нового Стандарта проект EXE и назовите его вообще, Вам нравится. Добавьте ссылку на файл UDTLibrary.dll, который был создан в части 1. Так как я просто хочу продемонстрировать, как это работает, мы будем использовать окно Immediate для тестирования кода, который мы напишем.

Создают новый Модуль, называют его UDTUtils и добавляют следующий код к нему:

'UDTUtils.bas'
Option Explicit    

Public Sub PrintUDT(ByVal someUDT As Variant)

    ' Make sure we have a UDT and not something else... '
    If VarType(someUDT) <> vbUserDefinedType Then
        Err.Raise 5, , "Parameter passed to PrintUDT is not an instance of a user-defined type."
    End If

    ' Get the type information for the UDT '
    ' (in COM parlance, a VB6 UDT is also known as VT_RECORD, Record, or struct...) '

    Dim ri As RecordInfo
    Set ri = TLI.TypeInfoFromRecordVariant(someUDT)

    'If something went wrong, ri will be Nothing'

    If ri Is Nothing Then
        Err.Raise 5, , "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    Else

        ' Iterate through each field (member) of the UDT '
        ' and print the out the field name and value     '

        Dim member As MemberInfo
        For Each member In ri.Members

            'TLI.RecordField allows us to get/set UDT fields:                 '
            '                                                                 '
            ' * to get a fied: myVar = TLI.RecordField(someUDT, fieldName)    '
            ' * to set a field TLI.RecordField(someUDT, fieldName) = newValue ' 
            '                                                                 '
            Dim memberVal As Variant
            memberVal = TLI.RecordField(someUDT, member.Name)

            Debug.Print member.Name & " : " & memberVal

        Next

    End If

End Sub

Public Sub TestPrintUDT()

    'Create a person instance and print it out...'

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    PrintUDT p

    'Create an animal instance and print it out...'

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Familiaris"
    a.NumberOfLegs = 4

    PrintUDT a

End Sub

Список 2: пример PrintUDT метод и простой метод тестирования

Часть 3: Создание его Объектно-ориентированный

вышеупомянутые примеры обеспечивают "быструю и грязную" демонстрацию того, как пользоваться Библиотекой Информационного объекта TypeLib для перечисления полей UDT. В реальном сценарии я, вероятно, создал бы UDTMemberIterator класс, который позволит Вам более легко выполнять итерации через поля UDT, наряду со служебной функцией в модуле, который создает UDTMemberIterator для приведенного примера UDT. Это позволило бы Вам делать что-то как следующее в Вашем коде, который намного ближе к псевдокоду, который Вы отправили в своем вопросе:

Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'

For Each member In UDTMemberIteratorFor(someUDT)
   Debug.Print member.Name & " : " & member.Value
Next

Это на самом деле не слишком трудно, чтобы сделать это, и мы можем снова использовать большую часть кода от PrintUDT стандартная программа, созданная в части 2.

Сначала, создать новый проект ActiveX и назвать его UDTTypeInformation или что-то подобное.

Затем, удостоверяются, что Объект Запуска для нового проекта не установлен на" (Ни один)".

первое, что нужно сделать состоит в том, чтобы создать простой класс обертки, который скроет детали TLI.MemberInfo класс из кода вызова и поможет получить название и значение поля UDT. Я назвал этот класс UDTMember. свойство Instancing для этого класса должно быть PublicNotCreatable.

'UDTMember.cls'
Option Explicit

Private m_value As Variant
Private m_name As String

Public Property Get Value() As Variant
    Value = m_value
End Property

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Value(rhs As Variant)
    m_value = rhs
End Property

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

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Name(ByVal rhs As String)
    m_name = rhs
End Property

Список 3: UDTMember класс

обертки Теперь мы должны создать класс итератора, UDTMemberIterator, который позволит нам использовать VB's For Each...In синтаксис для итерации полей экземпляра UDT. Instancing свойство для этого класса должно быть установлено на [1 135] (мы определим служебный метод позже, который создаст экземпляры от имени кода вызова).

РЕДАКТИРОВАНИЕ: (2/15/09) я убрал код немного больше.

'UDTMemberIterator.cls'

Option Explicit

Private m_members As Collection ' Collection of UDTMember objects '


' Meant to be called only by Utils.UDTMemberIteratorFor '
'                                                       '
' Sets up the iterator by reading the type info for     '
' the passed-in UDT instance and wrapping the fields in '
' UDTMember objects                                     '

Friend Sub Initialize(ByVal someUDT As Variant)

    Set m_members = GetWrappedMembersForUDT(someUDT)

End Sub

Public Function Count() As Long

    Count = m_members.Count

End Function

' This is the default method for this class [See Tools->Procedure Attributes]   '
'                                                                               '
Public Function Item(Index As Variant) As UDTMember

    Set Item = GetWrappedUDTMember(m_members.Item(Index))

End Function

' This function returns the enumerator for this                                     '
' collection in order to support For...Each syntax.                                 '
' Its procedure ID is (-4) and marked "Hidden" [See Tools->Procedure Attributes]    '
'                                                                                   '
Public Function NewEnum() As stdole.IUnknown

    Set NewEnum = m_members.[_NewEnum]

End Function

' Returns a collection of UDTMember objects, where each element                 '
' holds the name and current value of one field from the passed-in UDT          '
'                                                                               '
Private Function GetWrappedMembersForUDT(ByVal someUDT As Variant) As Collection

    Dim collWrappedMembers As New Collection
    Dim ri As RecordInfo
    Dim member As MemberInfo
    Dim memberVal As Variant
    Dim wrappedMember As UDTMember

    ' Try to get type information for the UDT... '

    If VarType(someUDT) <> vbUserDefinedType Then
        Fail "Parameter passed to GetWrappedMembersForUDT is not an instance of a user-defined type."
    End If

    Set ri = tli.TypeInfoFromRecordVariant(someUDT)

    If ri Is Nothing Then
        Fail "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    End If

    ' Wrap each UDT member in a UDTMember object... '

    For Each member In ri.Members

        Set wrappedMember = CreateWrappedUDTMember(someUDT, member)
        collWrappedMembers.Add wrappedMember, member.Name

    Next

    Set GetWrappedMembersForUDT = collWrappedMembers

End Function

' Creates a UDTMember instance from a UDT instance and a MemberInfo object  '
'                                                                           '
Private Function CreateWrappedUDTMember(ByVal someUDT As Variant, ByVal member As MemberInfo) As UDTMember

    Dim wrappedMember As UDTMember
    Set wrappedMember = New UDTMember

    With wrappedMember
        .Name = member.Name
        .Value = tli.RecordField(someUDT, member.Name)
    End With

    Set CreateWrappedUDTMember = wrappedMember

End Function

' Just a convenience method
'
Private Function Fail(ByVal message As String)

    Err.Raise 5, TypeName(Me), message

End Function

Список 4: UDTMemberIterator класс.

Примечание, что для создания этого класса повторяемым так, чтобы For Each мог использоваться с ним, необходимо будет установить определенные Атрибуты Процедуры на Item и _NewEnum методы (как отмечено в комментариях к коду). Можно изменить Атрибуты Процедуры из Меню Инструментов (Инструменты-> Атрибуты Процедуры).

Наконец, нам нужна служебная функция (UDTMemberIteratorFor в самом первом примере кода в этом разделе), который создаст UDTMemberIterator для экземпляра UDT, которого мы можем затем выполнить итерации с [1 142]. Создайте новый модуль, названный Utils, и добавьте следующий код:

'Utils.bas'

Option Explicit

' Returns a UDTMemberIterator for the given UDT    '
'                                                  '
' Example Usage:                                   '
'                                                  '
' Dim member As UDTMember                          '
'                                                  '        
' For Each member In UDTMemberIteratorFor(someUDT) '
'    Debug.Print member.Name & ":" & member.Value  '
' Next                                             '
Public Function UDTMemberIteratorFor(ByVal udt As Variant) As UDTMemberIterator

    Dim iterator As New UDTMemberIterator
    iterator.Initialize udt

    Set UDTMemberIteratorFor = iterator

End Function

Список 5: UDTMemberIteratorFor служебная функция.

Наконец, скомпилируйте проект и создайте новый проект проверить его.

В Вашем тестовом проекте, добавьте ссылку на недавно созданный UDTTypeInformation.dll и эти UDTLibrary.dll созданный в части 1 и испытайте следующий код в новом модуле:

'Module1.bas'

Option Explicit

Public Sub TestUDTMemberIterator()

    Dim member As UDTMember

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    For Each member In UDTMemberIteratorFor(p)
        Debug.Print member.Name & " : " & member.Value
    Next

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Canine"
    a.NumberOfLegs = 4

    For Each member In UDTMemberIteratorFor(a)
        Debug.Print member.Name & " : " & member.Value
    Next

End Sub

Список 6: Проверение UDTMemberIterator класс.