用户登录  |  用户注册
首 页商业源码原创产品编程论坛
当前位置:PB创新网文章中心编程技巧VisualBasic

自制IE风格按纽控件

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2009-03-16 19:49:52
网上的IE风格按纽控件不可谓少,然而天下的免费午餐总不会让你轻轻松松到吃下去,其中个味众人自知。其实,在VB6.0中,IE风格按纽很容易制作,真正的核心代码只需调用两个API函数。
---- 按常规,IE风格按纽的制作原理是,放置四条边线在Image和Label控件四周,在 Image和Label控件的MouseMove事件中,改变左,上,右,下线的Visible 和 BorderColor属性,按纽呈现浮起效果,同时改变Image控件的Picture 属性,调入盘旋(Hover)图片;在Image和Label的MouseDown事件中通过改变Image和Label控件的位置(右下移)按纽呈现按下效果;鼠标离开按纽,按纽恢复平坦(Flat)状态。

---- 如果你正在这样做,将会发现一个致命的问题。那就是,MouseMove事件只能检测到鼠标在Image和Label两个控件本身范围内的移动,你没有办法检测鼠标的离开。 “计算机世界”曾经登载过一个解决的办法,利用SetCapture和ReleaseCapture API函数。经SetCapture设定的控件可以强制性地捕捉鼠标在整个屏幕上的移动。这样,不管鼠标是不是在控件界面范围内移动,控件都可以捕捉得到。经过实践发现这个解决方案仍然存在一个问题,那就是,SetCapture所设定控件在 ReleaseCapture前,自动提示(ToolTipText)功能被抑制。这意味着这样编制的按纽没有自动提示功能,对很多人来说,这难以忍受。

---- WIN32 API函数集是个不折不扣的庞大宝藏,你总能从里面找到你需要的工具。 GetCursorPos和WindowFromPoint两个函数可以完美地解决这个问题。 GetCursorPos可以返回鼠标指针相对整个屏幕的坐标,WindowFromPoint 则根据鼠标指针的坐标,返回指针所处的控件的句柄。在这里,还需要引入一个定时器 (Timer)控件。

---- 整个编程原理是,在UserControl_Show事件中,先将定时器置为无效。在Image和Label的MouseMove事件中,执行使按纽浮起的代码,然后将定时器置为有效,这时定时器开始倒计时,在计时器的Timer事件中,用上述API函数检测鼠标指针是否已经离开了按纽,如果离开,则使按纽恢复平坦状态并立即使计时器无效,否则继续检测。我们看到,计时器的真正用途是用来触发事件,以检测鼠标的离开。将计时器置为无效是为了在不必要的时间,降低计时器对CPU的占用。

---- 以下是函数和所需数据类型声明。

Private Type POINTAPI
X As Long
Y As Long
End Type
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


---- 在VB6.0中新建一个ActiveX Control项目。添加LineLeft,LineTop,LineRight, LineBottom四条边线,一个Image控件Image1,一个Label标签控件Label1,一个定时器控件Timer1。关于用VB创建ActiveX控件的步骤这里不作描述(可以参考本文所附完整源代码)。与按纽制作有关的主要代码如下:

Private Sub UserControl_Show()
Timer1.Interval = 1 ''1/1000 秒
Timer1.Enabled=False ''关闭定时器
''将UserControl的提示信息引入Image1,Label1控件,
If UserControl.Ambient.UserMode = True Then
''在RunTime
Image1.ToolTipText = UserControl.Extender.ToolTipText
Label1.ToolTipText = UserControl.Extender.ToolTipText
End If

......''此处添加其它代码
End Sub

Private Sub Image1_MouseMove
(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
....... ''此处添加使按纽呈现浮起效果的代码
Timer1.Enabled = True ''打开定时器
End Sub

Private Sub Timer1_Timer() ''定时器触发
Dim MousePosition As POINTAPI
Dim ReturnValue As Long
Dim HwndHoverWindow As Long

ReturnValue = GetCursorPos(MousePosition)
''返回鼠标指针坐标
''返回指针所指位置的控件句柄
HwndHoverWindow = WindowFromPoint
(MousePosition.X, MousePosition.Y)
If HwndHoverWindow < > UserControl.hWnd Then
''如果鼠标离开了按纽区域
...... ''此处添加使按纽恢复平坦状态的代码
Timer1.Enabled = False ''将定时器关闭,
以释放资源
End If
End Sub

Private Sub Image1_MouseDown
(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Button = 1 Then
....... ''此处添加使按纽呈现按下状态的代码
End If
End Sub

Tags:

作者:佚名

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论

相关文章

PB创新网ourmis.com】Copyright © 2000-2009 . All Rights Reserved .
页面执行时间:24,625.00000 毫秒
Email:ourmis@126.com QQ:2322888 蜀ICP备05006790号