Листинг для Урока 7
ActiveX Control "ButtonMenu"
'*****************************************************************
'Урок 7
'ActiveX Control - "ControlPanel"
'Листинг
'*****************************************************************
Option Explicit
'*****************************************************************
'Объявление событий
'*****************************************************************
Event ClickMenu(Index As Integer)
Event Click()
Event MouseDown(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 MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'*****************************************************************
'Свойства контрола
'*****************************************************************
Public Property Get Caption() As String
Caption = cmdButtMenu.Caption
End Property
Public Property Let Caption(ByVal New_Caption As String)
cmdButtMenu.Caption() = New_Caption
PropertyChanged "Caption"
End Property
Public Property Get Font() As Font
Set Font = cmdButtMenu.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set cmdButtMenu.Font = New_Font
PropertyChanged "Font"
End Property
Public Property Get MenuVisible(Index As Integer) As Boolean
MenuVisible = mnuMenu(Index).Visible
End Property
Public Property Let MenuVisible(Index As Integer, ByVal New_MenuVisible As Boolean)
mnuMenu(Index).Visible = New_MenuVisible
PropertyChanged "MenuVisible"
End Property
Public Property Get MenuChecked(Index As Integer) As Boolean
MenuChecked = mnuMenu(Index).Checked
End Property
Public Property Let MenuChecked(Index As Integer, ByVal New_MenuChecked As Boolean)
mnuMenu(Index).Checked = New_MenuChecked
PropertyChanged "MenuChecked"
End Property
Public Property Get MenuEnabled(Index As Integer) As Boolean
MenuEnabled = mnuMenu(Index).Enabled
End Property
Public Property Let MenuEnabled(Index As Integer, ByVal New_MenuEnabled As Boolean)
mnuMenu(Index).Enabled = New_MenuEnabled
PropertyChanged "MenuEnabled"
End Property
Public Property Get MenuCaption(Index As Integer) As String
MenuCaption = mnuMenu(Index).Caption
End Property
Public Property Let MenuCaption(Index As Integer, ByVal New_MenuCaption As String)
mnuMenu(Index).Caption = New_MenuCaption
PropertyChanged "MenuCaption"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = cmdButtMenu.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
cmdButtMenu.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property
'*****************************************************************
'Методы контрола
'*****************************************************************
Public Sub AddMenu(sCaption As String)
Dim iCount%
'проверяем количество меню
iCount = mnuMenu.Count
'загружаем данные и показываем меню
mnuMenu(iCount - 1).Caption = sCaption
mnuMenu(iCount - 1).Visible = True
'загрузка следующего меню, но невидимая
Load mnuMenu(iCount)
mnuMenu(iCount).Visible = False
End Sub
'*****************************************************************
'Обработка событий
UserControl и контрола
ButtonMenu
'*****************************************************************
Private Sub UserControl_Resize()
cmdButtMenu.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim Index As Integer
cmdButtMenu.Caption = PropBag.ReadProperty("Caption", "ButtonMenu")
mnuMenu(Index).Caption = PropBag.ReadProperty("MenuCaption" & Index, vbNullString)
mnuMenu(Index).Checked = PropBag.ReadProperty("MenuChecked" & Index, False)
mnuMenu(Index).Enabled = PropBag.ReadProperty("MenuEnabled" & Index, True)
mnuMenu(Index).Visible = PropBag.ReadProperty("MenuVisible" & Index, True)
cmdButtMenu.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
Set cmdButtMenu.Font = PropBag.ReadProperty("Font", Ambient.Font)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Dim Index As Integer
Call PropBag.WriteProperty("Caption", cmdButtMenu.Caption, "ButtonMenu")
Call PropBag.WriteProperty("MenuCaption" & Index, mnuMenu(Index).Caption, vbNullString)
Call PropBag.WriteProperty("MenuChecked" & Index, mnuMenu(Index).Checked, False)
Call PropBag.WriteProperty("MenuEnabled" & Index, mnuMenu(Index).Enabled, True)
Call PropBag.WriteProperty("MenuVisible" & Index, mnuMenu(Index).Visible, True)
Call PropBag.WriteProperty("BackColor", cmdButtMenu.BackColor, &H8000000F)
Call PropBag.WriteProperty("Font", cmdButtMenu.Font, Ambient.Font)
End Sub
Private Sub cmdButtMenu_Click()
RaiseEvent Click
If mnuMenu.Count > 1 Then
PopupMenu mnuGeneral, , 60, ScaleHeight
End If
End Sub
Private Sub cmdButtMenu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
Private Sub cmdButtMenu_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub cmdButtMenu_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub mnuMenu_Click(Index As Integer)
RaiseEvent ClickMenu(Index)
End Sub