|
Листинг 7
Option Explicit 'Объявление событий: Event ClickMenu(Index As Integer) Event Click() 'MappingInfo=cmdButtMenu,cmdButtMenu,-1,Click Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdButtMenu,cmdButtMenu,- 1,MouseDown Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdButtMenu,cmdButtMenu,- 1,MouseMove Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=cmdButtMenu,cmdButtMenu,- 1,MouseUp '**********Property********** 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 '***************Method**************** 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 '****************Property UserControl*********************** 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 '*******************Event*********************************** 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
|
