如何编写属性等？？

Question

您好!请问一下，编写控件时，如何编写一些属性、方法及事件
请给一些代码与解释，谢谢

Answer 1

get,let ,set 
event
 

Answer 2

'这是一个完整的例子.是一个下拉颜色选择框的.'*****************************
'*下接颜色选择框
'*CJH
'*2001/6/7
'*****************************
Option ExplicitDim MColor As Long
Dim SizeFlag As Boolean
Dim ShowButton As BooleanPublic Event ColorClick(GetColor As Long) '定义一个事件'Color 属性
Public Property Get Color() As Long
       Color = MColor
End PropertyPublic Property Let Color(ByVal NewValue As Long)       On Error Resume Next       UserControl.PropertyChanged "Color"
       ShowColor.BackColor = NewValue
       MColor = NewValue
End Property'DownButton 属性
Public Property Get DownButton() As Boolean
       DownButton = ShowButton
End PropertyPublic Property Let DownButton(ByVal NewValue As Boolean)
       UserControl.PropertyChanged "DownButton"
       CmdDown.Visible = NewValue
       ShowButton = NewValue
End Property'ENABLED 属性
Public Property Get Enabled() As Boolean
       Enabled = UserControl.Enabled
End PropertyPublic Property Let Enabled(ByVal NewValue As Boolean)
       UserControl.Enabled = NewValue
       UserControl.PropertyChanged "Enabled"
       CmdDown.Enabled = NewValue           '设置相关控件
       ShowColor.Enabled = NewValue
End Property'Appearance 属性
Public Property Get Appearance() As Long
       Appearance = UserControl.Appearance
End PropertyPublic Property Let Appearance(ByVal NewValue As Long)
       Dim OleColor As Long
       
       If NewValue <> 0 Then NewValue = 1
       OleColor = ShowColor.BackColor
       UserControl.Appearance = NewValue
       UserControl.PropertyChanged "Appearance"
       CmdDown.Appearance = NewValue           '设置相关控件
       ShowColor.Appearance = NewValue
       ShowColor.BackColor = OleColor
End PropertyPublic Function SetColor(ColorID As Long)
       ShowColor.BackColor = ColorID
End FunctionPrivate Sub LabColor_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
        Static Id As Long
        If Id <> Index Then
            LabColor(Index).ZOrder 0
            LabMove.Move -30, LabColor(Index).Top - 30, LabColor(Index).Width + 120, LabColor(Index).Height + 60
            LabMove.Visible = True
        End If
        Id = Index
End SubPrivate Sub ShowColor_Click()
    Call CmdDown_Click
End SubPrivate Sub UserControl_LostFocus()
        UserControl.Height = ShowColor.Height
        PicGroup.Visible = False
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
            PropBag.WriteProperty "Enabled", Enabled, True
            PropBag.WriteProperty "Appearance", Appearance, 1
            PropBag.WriteProperty "DownButton", DownButton, True
            PropBag.WriteProperty "Color", Color, RGB(255, 255, 255)
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
            Enabled = PropBag.ReadProperty("Enabled", True)
            Appearance = PropBag.ReadProperty("Appearance", 1)
            DownButton = PropBag.ReadProperty("DownButton", True)
            Color = PropBag.ReadProperty("Color", RGB(255, 255, 255))
End SubPrivate Sub CmdDown_Click()
        Command1.SetFocus
        SizeFlag = True
        MColor = ShowColor.BackColor
        PicGroup.Visible = Not PicGroup.Visible
        If PicGroup.Visible Then
            PicGroup.Top = ShowColor.Top + ShowColor.Height + 15
            UserControl.Height = PicGroup.Top + PicGroup.Height + 15
        Else
            UserControl.Height = ShowColor.Height
        End If
End SubPrivate Sub LabColor_Click(Index As Integer)
        ShowColor.BackColor = LabColor(Index).BackColor
        MColor = ShowColor.BackColor
        UserControl.Height = ShowColor.Height
        PicGroup.Visible = False
        RaiseEvent ColorClick(MColor) '映射事件
End SubPrivate Sub UserControl_ExitFocus()
        UserControl.Height = ShowColor.Height
        PicGroup.Visible = False
End SubPrivate Sub UserControl_Initialize()
        Dim I As Long
        
        On Error Resume Next
        
'        If Now() >= CDate("2004/9/8") Then
'           MsgBox "这是演示版,已过期,请与作者联系!" & Chr(13) & "EMAIL:[email protected]" & Chr(13) & "TEL:[phone]", vbOKOnly, "演示"
'        End If
        
        UserControl.Width = 1215
        UserControl.Height = 285
        
        SizeFlag = False
        MColor = RGB(255, 255, 255)
        ShowButton = True
        
        ShowColor.Top = 0
        ShowColor.Left = 0
        ShowColor.Width = UserControl.Width
        ShowColor.Height = UserControl.Height        CmdDown.Width = ShowColor.Height
        CmdDown.Height = ShowColor.Height
        CmdDown.Top = ShowColor.Top
        CmdDown.Left = ShowColor.Width - CmdDown.Width
        
        PicGroup.Visible = False
        PicGroup.Left = 0
        PicGroup.Top = ShowColor.Height + 15
        PicGroup.Width = ShowColor.Width
        For I = 0 To LabColor.Count - 1
            LabColor(I).Left = 30
            LabColor(I).Width = PicGroup.Width - 90
        Next
End Sub
'Private Sub UserControl_Resize()
        Dim I As Long
        
        On Error Resume Next
        
        If Not SizeFlag Then
            ShowColor.Top = 0
            ShowColor.Left = 0
            ShowColor.Width = UserControl.Width
            ShowColor.Height = UserControl.Height
  
            CmdDown.Width = ShowColor.Height
            CmdDown.Height = ShowColor.Height
            CmdDown.Top = ShowColor.Top
            CmdDown.Left = ShowColor.Width - CmdDown.Width
            
            PicGroup.Left = 0
            PicGroup.Top = ShowColor.Height + 15
            PicGroup.Width = ShowColor.Width
            
            For I = 0 To LabColor.Count - 1
                LabColor(I).Left = 30
                LabColor(I).Width = PicGroup.Width - 90
            Next
        End If
End Sub

Answer 3

Public Property Get Attribute1(arg1 as ....,arg2 as ....)
用于获取属性
Public Property Let Attribute1(arg1 As Variant,.........)
用于设置变量属性
Public Property Set Attribute1(arg1 As Object,........)
用于设置对象属性