box.ctl

来自「这是一个实际的工程中所用的源程序」· CTL 代码 · 共 131 行

VERSION 5.00
Begin VB.UserControl box 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   1200
      TabIndex        =   0
      Top             =   1080
      Width           =   630
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H80000001&
      BackStyle       =   1  'Opaque
      FillColor       =   &H00C0C0C0&
      FillStyle       =   0  'Solid
      Height          =   375
      Left            =   480
      Shape           =   4  'Rounded Rectangle
      Top             =   360
      Width           =   1335
   End
End
Attribute VB_Name = "box"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


'注意！不要删除或修改下列被注释的行！
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "返回/设置对象中文本和图形的背景色。"
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

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

Public Property Let FillColor(ByVal New_FillColor As OLE_COLOR)
    Shape1.FillColor() = New_FillColor
    PropertyChanged "FillColor"
End Property

'从存贮器中加载属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    Shape1.FillColor = PropBag.ReadProperty("FillColor", &HC0C0C0)
    Label1.Caption = PropBag.ReadProperty("Caption", "")
    Shape1.BorderColor = PropBag.ReadProperty("BorderColor", -2147483640)
End Sub

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

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("FillColor", Shape1.FillColor, &HC0C0C0)
    Call PropBag.WriteProperty("Caption", Label1.Caption, "")
    Call PropBag.WriteProperty("BorderColor", Shape1.BorderColor, -2147483640)
End Sub

Private Sub UserControl_Resize()
    Call ResizeDH
End Sub

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

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

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


'注意！不要删除或修改下列被注释的行！
'MappingInfo=Shape1,Shape1,-1,BorderColor
Public Property Get BorderColor() As Long
Attribute BorderColor.VB_Description = "返回/设置对象的边框颜色。"
    BorderColor = Shape1.BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As Long)
    Shape1.BorderColor() = New_BorderColor
    PropertyChanged "BorderColor"
End Property