VB技巧:利用VB自制OCX控件

日期：09-02 来源：中国设计秀作者：cnwebshow.com

当鼠标移到控件上的时候控件上的圆便会在鼠标不离开控件的前提下跟随鼠标移动。

　　新建一OCX控件，将控件的BorderStyle属性改为1，再加入一SHAPE控件将其形状改为Circle(如图二(map2.gif)) 添加以下代码：

Public Event Click() '定义该控件要产生的事件
Dim CircleX As Integer, CircleY As Integer

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

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

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

Private Sub UserControl_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 > UserControl.ScaleWidth) Or _
　　　　(MoveY < 0) Or (MoveY + Shape1.Height > UserControl.ScaleHeight) Then Exit Sub
　　Shape1.Move MoveX, MoveY
End Sub

Private Sub UserControl_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 > UserControl.ScaleWidth - Shape1.Width / 2) Then
　　　　MsgBox ("圆的X值超出界限了")
　　Else
　　　　CircleX = New_X
　　　　Call UserControl_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 > UserControl.ScaleHeight - Shape1.Height / 2) Then
　　　　MsgBox ("圆的Y值超出界限了")
　　Else
　　　　CircleY = New_Y
　　　　Call UserControl_Resize
　　End If
End Property

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

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

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

　　麻雀虽小，五脏俱全。这个OCX控件完成的任务虽然简单,但是OCX控件的基本操作全都有喔! 有兴趣的朋友不妨一试。