ActiveX

Листинг для Урока 3

ActiveX Control "NewText"

Option Explicit

'*****************************************************************
'Объявление нумерованных констант
'*****************************************************************
Public Enum constBorderStyle
None = 0
FixedSingle = 1
End Enum

Public Enum constFormat
Нет = 0
Заглавные = 1
Прописные = 2
Числа = 3
End Enum

'*****************************************************************
'Объявление констант для вновь созданных свойств
'*****************************************************************
Const m_def_Format = 0
Const m_def_SelectedText = False

'*****************************************************************
'Объявление внутренних переменных для этих свойств
'*****************************************************************
Dim m_Format As constFormat
Dim m_SelectedText As Boolean

'*****************************************************************
'Объявление событий
'*****************************************************************
Event Change()
Event Click()
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Event MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)

'*****************************************************************
'Свойства
'*****************************************************************
Public Property Get Text() As String
Text = Text1.Text
End Property

Public Property Let Text(ByVal New_Text As String)
Text1.Text() = New_Text
PropertyChanged "Text"
End Property

Public Property Get BackColor() As OLE_COLOR
BackColor = Text1.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
Text1.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property

Public Property Get BorderStyle() As constBorderStyle
BorderStyle = Text1.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As constBorderStyle)
Text1.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"
End Property

Public Property Get Font() As Font
Set Font = Text1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set Text1.Font = New_Font
PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
ForeColor = Text1.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
Text1.ForeColor() = New_ForeColor
PropertyChanged "ForeColor"
End Property

Public Property Get MaxLength() As Long
MaxLength = Text1.MaxLength
End Property

Public Property Let MaxLength(ByVal New_MaxLength As Long)
Text1.MaxLength() = New_MaxLength
PropertyChanged "MaxLength"
End Property

Public Property Get SelectedText() As Boolean
SelectedText = m_SelectedText
End Property

Public Property Let SelectedText(ByVal New_SelectedText As Boolean)
m_SelectedText = New_SelectedText
PropertyChanged "SelectedText"
End Property

Public Property Get Format() As constFormat
Format = m_Format
End Property

Public Property Let Format(ByVal New_Format As constFormat)
m_Format = New_Format
PropertyChanged "Format"
End Property

'*****************************************************************
'События UserControl и контрола NewText
'*****************************************************************
Private Sub Text1_Change()
RaiseEvent Change
End Sub

Private Sub Text1_Click()
RaiseEvent Click
End Sub

Private Sub Text1_GotFocus()
If Len(Text1) > 0 And m_SelectedText = True Then
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End If
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case m_Format
Case Заглавные
KeyAscii = Asc(UCase(Chr(KeyAscii)))
Case Прописные
KeyAscii = Asc(LCase(Chr(KeyAscii)))
Case Числа
Select Case KeyAscii
Case 0, 8, 48 To 57
Case Else
KeyAscii = 0
Beep
End Select
End Select
RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub UserControl_InitProperties()
m_SelectedText = m_def_SelectedText
m_Format = m_def_Format
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
Text1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font)
Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
Text1.MaxLength = PropBag.ReadProperty("MaxLength", 0)
Text1.Text = PropBag.ReadProperty("Text", "NewText")
m_SelectedText = PropBag.ReadProperty("SelectedText", m_def_SelectedText)
m_Format = PropBag.ReadProperty("Format", m_def_Format)
End Sub

Private Sub UserControl_Resize()
Text1.Move 0, 0, Width, Height
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005)
Call PropBag.WriteProperty("BorderStyle", Text1.BorderStyle, 1)
Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font)
Call PropBag.WriteProperty("ForeColor", Text1.ForeColor, &H80000008)
Call PropBag.WriteProperty("MaxLength", Text1.MaxLength, 0)
Call PropBag.WriteProperty("SelectedText", m_SelectedText, m_def_SelectedText)
Call PropBag.WriteProperty("Text", Text1.Text, "NewText")
Call PropBag.WriteProperty("Format", m_Format, m_def_Format)
End Sub

К статье