dou.ctl

这是一个实际的工程中所用的源程序

VERSION 5.00
Begin VB.UserControl dou 
   BackColor       =   &H00C0C000&
   ClientHeight    =   420
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   390
   ScaleHeight     =   420
   ScaleWidth      =   390
   Begin VB.Label lbDou 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "aa"
      Height          =   165
      Left            =   60
      TabIndex        =   0
      Top             =   90
      Width           =   270
   End
   Begin VB.Shape shpDou 
      BackColor       =   &H00C0C000&
      BackStyle       =   1  'Opaque
      FillColor       =   &H00C0C0C0&
      FillStyle       =   0  'Solid
      Height          =   375
      Left            =   0
      Shape           =   3  'Circle
      Top             =   0
      Width           =   375
   End
End
Attribute VB_Name = "dou"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'注意！不要删除或修改下列被注释的行！
'MappingInfo=lbDou,lbDou,-1,Caption
Public Property Get Caption() As String
Attribute Caption.VB_Description = "返回/设置对象的标题栏中或图标下面的文本。"
    Caption = lbDou.Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    lbDou.Caption() = New_Caption
    PropertyChanged "Caption"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=shpDou,shpDou,-1,FillColor
Public Property Get Sfillcolor() As OLE_COLOR
Attribute Sfillcolor.VB_Description = "返回/设置填充形状、圆环和方框所使用的颜色。"
    Sfillcolor = shpDou.FillColor
End Property

Public Property Let Sfillcolor(ByVal New_Sfillcolor As OLE_COLOR)
    shpDou.FillColor() = New_Sfillcolor
    PropertyChanged "SFillColor"
End Property

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.BackColor = UserControl.Ambient.BackColor
    lbDou.Caption = PropBag.ReadProperty("Caption", "lbDou")
    shpDou.FillColor = PropBag.ReadProperty("SFillColor", &HC0C0C0)
End Sub

'将属性值写到存储器
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("Caption", lbDou.Caption, "lbDou")
    Call PropBag.WriteProperty("SFillColor", shpDou.FillColor, &HC0C0C0)
End Sub

Private Sub UserControl_Resize()
    'Call ResizeDH
End Sub

Private Sub ResizeDH()
    On Error Resume Next
        UserControl.Height = UserControl.Width
        shpDou.Left = 0
        shpDou.Top = 0
        shpDou.Width = UserControl.Width
        shpDou.Height = UserControl.Height
        
        lbDou.Left = (UserControl.Width - lbDou.Width) / 2
        lbDou.Top = (UserControl.Height - lbDou.Height) / 2
    
End Sub