usercontrol1.ctl

一个可以改变窗体上所有按钮样式的vb控件

VERSION 5.00
Begin VB.UserControl UserControl1 
   BackStyle       =   0  '透明
   ClientHeight    =   1290
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1980
   ScaleHeight     =   1290
   ScaleWidth      =   1980
   Begin VB.Shape Shape1 
      Height          =   1215
      Left            =   0
      Shape           =   3  'Circle
      Top             =   0
      Width           =   1935
   End
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public Event Click() '定义该控件要产生的事件
Dim CircleX As Integer, CircleY As Integer

Private Sub UserControl1_Click()
    RaiseEvent Click '触发Click事件
End Sub

Private Sub UserControl1_Initialize()
    CircleX = Shape1.Width / 2
    CircleY = Shape1.Height / 2
End Sub

Private Sub UserControl1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Shape1.BackColor = RGB(0, 0, 255)
End Sub

Private Sub UserControl1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MoveX As Integer, MoveY As Integer
    MoveX = X - Shape1.Width / 2
    MoveY = Y - Shape1.Height / 2
    If (MoveX < 0) Or (MoveX + Shape1.Width > UserControl1.ScaleWidth) Or _
        (MoveY < 0) Or (MoveY + Shape1.Height > UserControl1.ScaleHeight) Then Exit Sub
    Shape1.Move MoveX, MoveY
End Sub

Private Sub UserControl1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Shape1.BackColor = RGB(255, 0, 0)
End Sub

Property Get PosX() As Integer '取得CircleX的值显示给用户
    PosX = CircleX
End Property

Property Let PosX(ByVal New_X As Integer) '把用户写入的值设置到OCX控件内部
    If (New_X < Shape1.Width / 2) Or _
        (New_X > UserControl1.ScaleWidth - Shape1.Width / 2) Then
        MsgBox ("圆的X值超出界限了")
    Else
        CircleX = New_X
        Call UserControl1_Resize
    End If
End Property

Property Get PosY() As Integer
    PosY = CircleY
End Property

Property Let PosY(ByVal New_Y As Integer)
    If (New_Y < Shape1.Height / 2) Or _
        (New_Y > UserControl1.ScaleHeight - Shape1.Height / 2) Then
        MsgBox ("圆的Y值超出界限了")
    Else
        CircleY = New_Y
        Call UserControl1_Resize
    End If
End Property

Private Sub UserControl1_ReadProperties(PropBag As PropertyBag)
    CircleX = PropBag.ReadProperty("CircleX", Shape1.Width / 2) '将用户设置的值读出来
    CircleY = PropBag.ReadProperty("CircleY", Shape1.Height / 2) '同上
    Call UserControl1_Resize
End Sub

Private Sub UserControl1_Resize()
    Shape1.Move CircleX, CircleY
End Sub

Private Sub UserControl1_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("CircleX", CircleX, Shape1.Width / 2) '将用户设置的值保存
    Call PropBag.WriteProperty("CircleY", CircleY, Shape1.Height / 2) '同上
End Sub