ActiveX

Листинг к статье: 
Опыт создания массива пользовательского типа в ActiveX Control'е

ActiveX Control: SelTextEx

'*********************************************
'ActiveX Control: SelTextEx
'Создан: 26.07.01
'Автор: © Михаил Эскин
'*********************************************

Option Explicit

'*********************************************
'Значение свойства по умолчанию:
'*********************************************
Const m_def_Caption = "SelTextEx"

'*********************************************
'Внутренняя переменная свойства:
'*********************************************
Dim m_Caption As String

'*********************************************
'Объявляемый пользовательский тип данных:
'*********************************************
Public Type SText
    Start As Integer
    Font As StdFont
    ForeColor As OLE_COLOR
End Type

'*********************************************
'Свойство:
'*********************************************
Public Property Get Caption() As String
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
End Property

'*********************************************
'Метод:
'*********************************************
Public Sub SelectPart(CountEx() As SText)
Dim i%, txt$
    'очищаем от предыдущей графики
    Cls
    'в цикле проходим все значения для типа SText
    For i = LBound(CountEx) To UBound(CountEx)
        'для первой части старт можно не высчитывать
        If CountEx(i).Start = 0 Then CountEx(i).Start = 1
        'если это последний отрезок, то длину берем максимальную
        'в любом другом случае длину высчитывем от начала следующего отрезка
        If i = UBound(CountEx) Then
            txt = Mid(m_Caption, CountEx(i).Start, Len(m_Caption))
        Else
            txt = Mid(m_Caption, CountEx(i).Start, CountEx(i + 1).Start - CountEx(i).Start)
        End If
        'если специально не указано имя шрифта, то используются:
        If CountEx(i).Font Is Nothing Then
        'текущие значения UserControl'a
            Set CountEx(i).Font = UserControl.Font
        'текущие значения формы (контейнера), где лежит наш контрол
        'Set CountEx(i).Font = Ambient.Font
        End If
        Set Font = CountEx(i).Font
        ForeColor = CountEx(i).ForeColor
        
        'добавляем к напечатанному
        Print txt;
    Next
End Sub

'*********************************************
'Обработка событий UserControl'а:
'*********************************************
Private Sub UserControl_InitProperties()
    m_Caption = m_def_Caption
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
End Sub

Форма для тестирования: frmDemo

Option Explicit

Private Sub Command1_Click()
    Dim arrVal(2) As SText
    'Слово делится, в данном случае, на 3 части
    'Инициализируем все свойства
    arrVal(0).Start = 1
    arrVal(1).Start = 4
    arrVal(2).Start = 8
    
    Set arrVal(0).Font = New StdFont
    With arrVal(0).Font
        .Name = "Arial Cyr"
        .Bold = True
        .Italic = False
        .Underline = False
        .Size = 24
    End With
    
    Set arrVal(1).Font = New StdFont
    With arrVal(1).Font
        .Name = "Times New Roman Cyr"
        .Bold = False
        .Italic = True
        .Underline = False
        .Size = 24
    End With
    
    Set arrVal(2).Font = New StdFont
    With arrVal(2).Font
        .Name = "Courier New Cyr"
        .Bold = True
        .Italic = True
        .Underline = True
        .Size = 24
    End With
    
    arrVal(0).ForeColor = vbBlue
    arrVal(1).ForeColor = vbBlack
    arrVal(2).ForeColor = vbRed
    
    'Печатаем
    With SelTextEx1
        .Caption = "SelTextEx"
        .SelectPart arrVal
    End With
End Sub

Private Sub Command2_Click()
Dim arrVal(1) As SText 'массив из 2-х частей начало слова и окончание

    'если специально не указывать, то используются последние текущие значения
    'для начала слова старт можно не указывать
    'arrVal(0).Start = 1
    
    'здесь можно привязывать к базе данных
    SelTextEx1.Caption = "ActiveX Control"
    'высчитывается длина основной части по длине окончания
    arrVal(1).Start = 9
    arrVal(1).ForeColor = vbMagenta
    
    SelTextEx1.SelectPart arrVal
End Sub

 К статье