VB制作控件之图片命令按钮➁

该博客介绍了如何使用VB创建一个带有鼠标事件的图片命令按钮控件。通过定义计时器对象、API函数以及鼠标事件,实现了鼠标单击、按下、经过和弹起时的不同状态效果,同时提供了控件的Enabled属性控制。文章还包含了控件初始化、属性读写以及工程包下载链接。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

续 VB制作控件之图片命令按钮➀

这一节我们实现鼠标动作事件。首先我们需要创建一个计时器Timer对象,代码如下:

➀定义一个计时器对象变量,类型为Timer

➁定义一个变量来判断鼠标是否按下或移出控件内,类型为Boolean

Dim WithEvents Tim As Timer

Dim Action As Boolean

创建计时器对象

Private Sub UserControl_Initialize()

Set Tim = Controls.Add("vb.Timer", "Tim")
Tim.Enabled = False: Tim.Interval = 100

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) '读
UserControl.Enabled = PropBag.ReadProperty("Enabled", True)

If UserControl.Enabled Then
Call ImageSlide(0)
Else
Call ImageSlide(3)
End If
End Sub

 

  

到这里,一个简单的图片命令按钮就接近尾声了,最后一步编写控件的一些初始化:

初始化
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()
Text = Extender.Name                         '获得对象名称到文本变量

Call ImageSlide(0)                               '显示第一块图片
End Sub

工程包下载地址:https://download.youkuaiyun.com/download/ty5858/85346566

原tab控件,仿360开关控件版权归原作者! VB控件背景透明代码来自:新浪 “玄雨清风”的博客 感谢以上两位源代码作者 链接:http://pan.baidu.com/s/1hrAEXqG 密码:nfhc '-----------------------以下是转自博客的控件透明源代码(可透明至父窗体或桌面)------------- '添加一个用户控件UserControl,代如下: Option Explicit '实现用户控件UserControl的"伪透明" Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const WM_ERASEBKGND = &H14 Private Const WM_PAINT = &HF Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Public Event MouseDown(Button As Integer, Shift As Integer, X A
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

键盘上的舞指

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值