续 VB制作控件之图片命令按钮➀
这一节我们实现鼠标动作事件。首先我们需要创建一个计时器Timer对象,代码如下:
➀定义一个计时器对象变量,类型为Timer ➁定义一个变量来判断鼠标是否按下或移出控件内,类型为Boolean |
Dim WithEvents Tim As Timer Dim Action As Boolean |
创建计时器对象 |
Private Sub UserControl_Initialize() Set Tim = Controls.Add("vb.Timer", "Tim") End Sub |
创建好计时器,我们还要用到两个API函数"GetCursorPos"和"WindowFromPoint",来判断鼠标是否在控件范围内,声明如下:
函数 | 说明 |
GetCursorPos | 获取鼠标指针的当前位置 |
WindowFromPoint | 返回包含了指定点的窗口的句柄。忽略屏蔽、隐藏以及透明窗口 |
声明 | |
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Type POINTAPI x As Long y As Long End Type | |
自定义函数 | |
Private Function IsMouseOver(hwnd As Long) As Boolean Dim pt As POINTAPI GetCursorPos pt IsMouseOver = (WindowFromPoint(pt.x, pt.y) = hwnd) End Function |
计时器事件:
Private Sub Tim_Timer() If IsMouseOver(UserControl.hwnd) <> True Then Call ImageSlide(0) Action = False Tim.Enabled = False End If End Sub |
计时器事件编写好之后,我们再定义四个鼠标事件函数:
鼠标单击事件 |
Public Event Click() |
鼠标按下事件 |
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) |
鼠标经过事件 |
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) |
鼠标弹起事件 |
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) |
下面实现鼠标单击、按下、经过、弹起以及背景图片和文本颜色的切换:
鼠标单击事件(内部) |
Private Sub UserControl_Click() RaiseEvent Click End Sub |
鼠标按下事件(内部) |
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub Action = True Call ImageSlide(2) RaiseEvent MouseDown(Button, Shift, x, y) End Sub |
鼠标经过事件(内部) |
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Tim.Enabled = True If Action <> True And (x > 0 And x < UserControl.ScaleWidth) And (y > 0 And y < UserControl.ScaleHeight) Then Call ImageSlide(1) End If RaiseEvent MouseMove(Button, Shift, x, y) End Sub |
鼠标弹起事件(内部) |
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Button <> 1 Then Exit Sub Call ImageSlide(0) If Action Then RaiseEvent MouseUp(Button, Shift, x, y) Action = False End Sub |
事件编写完成之后,这里编写控件的"Enabled"属性,决定对象是否响应用户生成事件:
返回 Enabled 的值 |
Public Property Get Enabled() As Boolean Enabled = UserControl.Enabled End Property |
设置 Enabled 的值 |
Public Property Let Enabled(ByVal vNewValue As Boolean) UserControl.Enabled = vNewValue PropertyChanged "Enabled" If vNewValue Then Call ImageSlide(0) Else Tim.Enabled = False Call ImageSlide(3) End If End Property |
即将属性值读写到"ReadProperties"和"WriteProperties"事件里:
写入 |
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) '存 Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True) End Sub |
读出 |
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) '读 If UserControl.Enabled Then |
到这里,一个简单的图片命令按钮就接近尾声了,最后一步编写控件的一些初始化:
初始化 |
Private Sub UserControl_Initialize() UserControl.AutoRedraw = True '持久性图位输出 UserControl.ScaleMode = vbPixels '以像素单位显示 tColor(1) = RGB(255, 255, 0) '鼠标经过时文本的颜色 tColor(2) = RGB(0, 0, 0) '鼠标按下时文本的颜色 tColor(3) = RGB(240, 240, 240) '控件无效时文本的颜色 End Sub |
改变控件大小时显示第一块图片 |
Private Sub UserControl_Resize() Call ImageSlide(0) End Sub |
获得控件名称 |
Private Sub UserControl_InitProperties() Call ImageSlide(0) '显示第一块图片 |
工程包下载地址:https://download.youkuaiyun.com/download/ty5858/85346566