Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
End Sub在写与读属性时,会发生上面的事件如果我定义了好向个属性
在上面两个事件,怎么才能知道我正在读哪个或写哪个属性
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
End Sub在写与读属性时,会发生上面的事件如果我定义了好向个属性
在上面两个事件,怎么才能知道我正在读哪个或写哪个属性
'你看一下怎么读写属性的.
'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
End Sub'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
End Sub
整个事件下的语句都会运行了
Option Explicit
'第一步: 声明事件。
Public Event Click()
Public Event DblClick()
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'第二步:改变控件外观
Private Sub UserControl_Resize()
Shape1.Move 0, 0, ScaleWidth, ScaleHeight
If lblCaption.Width < 1 Or lblCaption.Height < 1 Then Exit Sub
On Error GoTo Line
lblCaption.Width = Shape1.Width - 20
lblCaption.Height = Shape1.Height - 10
lblCaption.Move (ScaleWidth - lblCaption.Width) / 2, (ScaleHeight _
- lblCaption.Height) / 2
Line:
End Sub
'第三步:给控件添加属性
'**********************************************
'Caption属性
Public Property Get Caption() As String
Caption = lblCaption.Caption
End PropertyPublic Property Let Caption( _
ByVal NewCaption As String)
lblCaption.Caption = NewCaption
PropertyChanged "Caption"
End Property
'forecolor属性
Public Property Get forecolor() As OLE_COLOR
forecolor = lblCaption.forecolorEnd PropertyPublic Property Let forecolor( _
ByVal Newforecolor As OLE_COLOR)
lblCaption.forecolor = Newforecolor
PropertyChanged "forecolor"
End Property
'backcolor属性
Public Property Get backcolor() As OLE_COLOR
Shape1.FillColor = lblCaption.backcolor
backcolor = Shape1.FillColorEnd PropertyPublic Property Let backcolor( _
ByVal Newbackcolor As OLE_COLOR)
lblCaption.backcolor = Newbackcolor
Shape1.FillColor = lblCaption.backcolor
PropertyChanged "backcolor"
End Property'第四步:给属性赋初值
'******************************************************
Private Sub UserControl_InitProperties()
'将 ShapeLabel 实例的名字
'赋给 Caption 属性
'作为它的初始值。
lblCaption.Caption = "用户控件"
lblCaption.forecolor = RGB(0, 0, 255)
lblCaption.backcolor = RGB(255, 0, 0)End Sub
'第五步:保存属性
'******************************************************
Private Sub UserControl_WriteProperties(PropBag As _
PropertyBag)
Debug.Print "WriteProperties"
PropBag.WriteProperty "Caption", Caption, _
Extender.Name
PropBag.WriteProperty "forecolor", forecolor, RGB(0, 0, 255)
PropBag.WriteProperty "backcolor", backcolor, RGB(255, 0, 0)End Sub
Private Sub UserControl_ReadProperties(PropBag As _
PropertyBag)
Debug.Print "ReadProperties"
Caption = PropBag.ReadProperty("Caption", _
Extender.Name)
forecolor = PropBag.ReadProperty("forecolor", RGB(0, 0, 255))
End Sub
'第六步:给控件添加事件
'******************************************************
'1.click事件
Private Sub lblCaption_Click()
' 单击均 引发 Click 事件。
RaiseEvent Click
'End Sub
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
'2.Dblclick事件
Private Sub lblCaption_DblClick()
RaiseEvent DblClick
'End Sub
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
'3.MouseMove事件
Private Sub UserControl_MouseMove(Button As Integer, _
Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
仅供参考