绝对的历史第一人,真正完美解决托盘图标的MouseExit,MouseOut, MouseHover需求,类似于QQ托盘弹窗,移开鼠标则消失,原创代码,心得分享

BD6500K 2010-10-03 11:28:48
加精
首发于本论坛是因为在这里实质性的帮助最多,当然我现在说的这个代码,不是在本论坛得到启发的,因为至今,都还没有人能如此完美,而又简单的用代码,实现托盘区域,图标上的鼠标停留,移开精确判断需求。本代码支持新特性,Windows 7托盘状态栏,三角隐藏窗口也能实现MouseHover,MouseExit事件,并且完美兼容XP,Win 2000。而微软在Windows 7,Vista新提供ShellNotify MouseHover参数,显然不能用于XP,会为程序带来极麻烦的兼容性。

另外说一下,MSDN上公布的托盘图标MouseHover新特性,刚刚更新不到一个月,至今无人去实现。所以我充分自信的说绝对是历史第一人。包括国外平台,搜尽全网,也没有发现有人做成过这事。能简单的MouseHover在托盘区上的代码,都极罕见。要如此完美,更是绝无仅有。

废话不多说,稍微解释一下需要常量PX,PY来记录前次的坐标,initX,initY记录第一次停在图标内的坐标


Case WM_MOUSEMOVE 'mousemove有多讨厌用过的人都知道,动一个像素,程序响应一次,要拿来判断Hover,难啊,何况微软又不提供Hover参数给状态栏...我的办法来了
GetCursorPos P ’鼠标在托盘图标内移动,则获得它的坐标
PX = P.x
PY = P.y
Timer1.Enabled = True ’启动Timer计时器,延后再测一次鼠标坐标,最好设定在120毫秒以上,稍后再解释


Private Sub Timer1_Timer()

Dim P As POINTAPI
Dim i As Long, j As Long
GetCursorPos P ' 120毫秒后再次得到鼠标坐标i = P.x - PX
j = P.y - PY

If i = 0 And j = 0 And initX = 0 And initY = 0 Then ’坐标没变,说明它终于停住了,而且是第一次
DetectFFDshow
SetTrayTips
Shell_NotifyIcon NIM_MODIFY, nfIconData
initX = P.x '保留鼠标停止的证据
initY = P.y

ElseIf CheckMouseOut(P.x, P.y, initX, initY) = True Then '如果发现有第二次鼠标停止的行为,则跳到我的函数区去判断鼠标到底离开了图标没有,如果已经离开,一切清空,从头再来
initX = 0
initY = 0
End If

Timer1.Enabled = False

End Sub

'好了,讲解这个精妙而有创新性的判断鼠标是否离开了,你必须要非常了解MouseMove事件,才能精确的得到这个完美的结果。SetCapture,ReleaseCapture问题太多了。Timer绝对的好,只是很多人太菜鸟,误以为Timer就不能和SetCapture一样精确。想精确捕捉控件的,不妨也参考下。

Public Function CheckMouseOut(ByVal nx As Long, ByVal ny As Long, ByVal ix As Long, ByVal iy As Long) As Boolean

Dim Buffer As Long
Dim bInfo As TBBUTTON
Dim udtTray As TRAYDATA
Dim vRect As RECT, RCTray As RECT
Dim nItems As Integer, tbIndex As Long
Dim IconWidth As Long, IconHeight As Long
Dim Fhwnd As Long, pIdExplorer As Long, hExplorer As Long
Dim NotHiddenIcon As Boolean


Fhwnd = FindWindow("Shell_TrayWnd", vbNullString)
Fhwnd = FindWindowEx(Fhwnd, 0, "TrayNotifyWnd", vbNullString)
GetWindowRect Fhwnd, RCTray '先得到一下托盘区的总高,后面有用
Fhwnd = FindWindowEx(Fhwnd, 0, "SysPager", vbNullString)
Fhwnd = FindWindowEx(Fhwnd, 0, "ToolbarWindow32", vbNullString)'获得托盘区域的句柄

nItems = SendMessage(Fhwnd, TB_BUTTONCOUNT, 0&, 0&)
If nItems <= 0 Then Exit Function

GetWindowThreadProcessId Fhwnd, pIdExplorer

hExplorer = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pIdExplorer)
Buffer = VirtualAllocEx(hExplorer, ByVal 0&, ByVal 1024, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)

For tbIndex = 0 To nItems - 1

SendMessage Fhwnd, TB_GETBUTTON, tbIndex, Buffer

ReadProcessMemory hExplorer, ByVal Buffer, ByVal VarPtr(bInfo), ByVal Len(bInfo), ByVal 0&
ReadProcessMemory hExplorer, ByVal bInfo.dwData, ByVal VarPtr(udtTray), ByVal Len(udtTray), ByVal 0&


Dim fullpath As String
If Right(App.Path, 1) = "\" Then fullpath = App.Path + App.EXEName + ".exe" Else: fullpath = App.Path + "\" + App.EXEName + ".exe" '判断这个图标是不是你自己的,注意,一定要用路径,这才是你的唯一合法的身份标识,有些笨蛋,偷懒用程序标题来判断,我问你,如果你的程序,以后版本升级了,你想自己和自己发生冲突吗?所以做事要讲究逻辑性

If InStr(udtTray.ExePath, fullpath) <> 0 Then '不用管屁股上的chr(0)了,直接挂上你的程序路径,看看里面对不对得到字符
NotHiddenIcon = True '能找到自己就说明没有在三角箭头的隐藏窗口里
SendMessage Fhwnd, TB_GETITEMRECT, tbIndex, Buffer ’马上发消息探查自己图标的坐标
ReadProcessMemory hExplorer, Buffer, VarPtr(vRect), 16, 0
IconWidth = vRect.Right - vRect.Left
IconHeight = vRect.Bottom - vRect.Top
ClientToScreen Fhwnd, vRect
Exit For 'ok找到自己的位置了,跳出循环
End If

Next tbIndex
Call VirtualFreeEx(hExplorer, ByVal Buffer, 0&, MEM_RELEASE)'释放内存空间不要省掉
CloseHandle hExplorer

If NotHiddenIcon = True Then '如果鼠标没在隐藏区,容易,直接对着坐标,就知道到底鼠标离开了没有。
If nx - vRect.Left > IconWidth - 2 Or nx < vRect.Left + 1 Then CheckMouseOut = True
If RCTray.Bottom = vRect.Top + IconHeight Then
If ny - vRect.Top > IconHeight - 1 Or ny < vRect.Top + 1 Then CheckMouseOut = True
Else
If ny - vRect.Top > IconHeight - 2 Or ny < vRect.Top + 2 Then CheckMouseOut = True
End If
End If

If NotHiddenIcon = False Then '惨了,在隐藏区,这是很多人没碰到过的难题,不怕,我有高招,太聪明了,自己佩服下自己

Dim RCFlow As RECT
Dim wFlow As Long, hFlow As Long
Dim wFlowArea As Long, hFlowArea As Long

Fhwnd = FindWindow("NotifyIconOverflowWindow", vbNullString) '找到托盘溢出窗口的句柄,哈哈,很多人不知道它的名字呢,这回把它曝光,让所有人都知道
GetWindowRect Fhwnd, RCFlow '拿到它的窗口坐标,如果你细心观察,你是知道地,这个窗口边框尺寸是固定的,幸运的是它里面的图标全部是32*32大小,不会和状态栏一样,一会儿40的高,一会儿44,一会儿41,少了不少麻烦。接下来,还有啥说的自己体会喔,你有了自己刚才停留在图标的坐标,还怕找不到图标的位置?一切如此简单。算一下就可以了。
wFlow = RCFlow.Right - RCFlow.Left
hFlow = RCFlow.Bottom - RCFlow.Top
hFlowArea = hFlow - 75
If ny - RCFlow.Top - 15 - 32 * Int((iy - RCFlow.Top - 15) / 32) > 30 Or ny < RCFlow.Top + 15 + 32 * Int((iy - RCFlow.Top - 15) / 32) + 2 Then CheckMouseOut = True

If wFlow > 93 Then
If nx - RCFlow.Left - 16 - 32 * Int((ix - RCFlow.Left - 16) / 32) > 30 Or nx < RCFlow.Left + 16 + 32 * Int((ix - RCFlow.Left - 16) / 32) + 1 Then CheckMouseOut = True
Else
If nx - RCFlow.Left - 29 - 32 * Int((ix - RCFlow.Left - 29) / 32) > 30 Or nx < RCFlow.Left + 29 + 32 * Int((ix - RCFlow.Left - 29) / 32) + 1 Then CheckMouseOut = True
End If

End If

NotHiddenIcon = False
End Function


有些人嫌这里乱,我也知道直接求整,比较Int((nx - RCFlow.Left - 16) / 32) <> Int((ix - RCFlow.Left - 16) / 32),代码好看多,也简单。但是这里正是又一个创新之处。用Timer来判断MouseExit,MouseOut的都可以参考。图标区外缘,你必须得给它加1,2个像素的缓冲区,微软的一个小秘密,它的MouseMove,鼠标进来第一个像素,马上会被当成是MouseMove已经发生,但你立即在这个像素上后退,MouseMove就没了,所以MouseMove看似很难用,但其实如果你的鼠标全部只在图标第一个像素,也就是外缘上绕圈运动,根本就不会有MouseMove的响应,说明微软故意留了后门在这里,方便大家后续的处理。

举例说明,图标是32*32大小,但你不能让Timer在33的坐标上,才认为鼠标已经退出,那么你用Timer漏洞就来了,如果鼠标移动非常缓慢的退出边界的话,Timer会误以为,鼠标一直没离开。也就是很多人一知半解以为SetCapture才精准。当你把图标视为31*31的大小时,最后一个像素32则会为你保持最后一次的MouseMove响应,一切问题解决,当Timer设到120毫秒的间隔时,超完美,鼠标移动再慢,也会被Timer完全探测到已经离开。注意!到底是要一个像素还是二个像素缓冲,看图标的具体位置,和微软的后门有关。微软在认为常用的位置比如托盘图标的右侧,经常有鼠标出没,它设了2道门,以便精确响应MouseMove,所以那个地方设了2个像素的缓冲,你就得在自己的坐标上去掉它。参考我的就可以了,不论是任务栏在上边,左边,右边,下边。全部完美的,你离开托盘图标一个位置,我就响应,你重新进来我就再次响应。如果你的鼠标还在图标内做疯狂的MouseMove,我也不鸟你的MouseMove,就这样子,鼠标进来,图标就弹出消息,移开图标,消息自动消失,完美而简单的实现了!不需要什么钩子,乱七八糟的钩坏系统。

Timer用到其它控件上也是一个道理,留下一个缓冲区,MouseMove就是这么运作的。用Timer足矣,不必SetCpature带来新的混乱。
...全文
9275 393 打赏 收藏 转发到动态 举报
写回复
用AI写文章
393 条回复
切换为时间正序
请发表友善的回复…
发表回复
fsyyyy 2013-06-17
  • 打赏
  • 举报
回复
谢谢无私分享。之前在用钩子。。。
zj_zwl 2013-05-06
  • 打赏
  • 举报
回复
记下,有用到的地方
chenjinshu1988 2012-08-15
  • 打赏
  • 举报
回复
学习,很不错哦,cool
perry0759 2012-04-12
  • 打赏
  • 举报
回复
太好了的东西
hzy694358 2012-04-11
  • 打赏
  • 举报
回复
搞不明白楼主在计算隐藏区域托盘图标位置
隐藏区域有多个托盘图标,怎么才能找到自己的呢?
LZ怎么好像在计算整个窗口

Fhwnd = FindWindow("NotifyIconOverflowWindow", vbNullString
GetWindowRect Fhwnd, RCFlow
这个找到的应该是整个溢出窗口的大小吧?
老葛 2011-11-24
  • 打赏
  • 举报
回复
表示晕
pxm380107283 2011-08-15
  • 打赏
  • 举报
回复
学习。学习
myoswin7 2011-03-18
  • 打赏
  • 举报
回复
Dim R As RECT

Wnd = FindWindow("Shell_TrayWnd", vbNullString)
Wnd = FindWindowEx(Wnd, 0, "TrayNotifyWnd", vbNullString)
Wnd = FindWindowEx(Wnd, 0, "SysPager", vbNullString)
Wnd = FindWindowEx(Wnd, 0, "ToolbarWindow32", vbNullString)
Wnd = FindWindow("NotifyIconOverflowWindow", vbNullString)

GetWindowRect Wnd, R
BD6500K 2010-10-20
  • 打赏
  • 举报
回复
晕死,论坛代码怎么这样,没法显示颜色啊,XP在这里不要减2。没必要剔除外围的像素了。让Timer定是判断一下鼠标离开没有。

If ix <> 0 And Int((nx - vRect.Left - 2) / IconWidth) <> Int((ix - vRect.Left - 2) / IconWidth) Or Int((ny - vRect.Top) / IconHeight) <> Int((iy - vRect.Top) / IconHeight) Then
CheckMouseOut = True
vRect.Top = 0
End If

Timer代码可以这样写。

Private Sub Timer1_Timer()
Dim P As POINTAPI
Dim i As Long, j As Long
Dim lngP As Long
GetCursorPos P
i = P.x - PX
j = P.y - PY
If i = 0 And j = 0 And initX = 0 And initY = 0 Then
initX = P.x
initY = P.y
DrawAero
Timer1.Interval = 200
ElseIf CheckMouseOut(P.x, P.y, initX, initY) = True Then
initX = 0
initY = 0
DisableAero
Timer1.Interval = 800
Timer1.Enabled = False
End If
End Sub

BD6500K 2010-10-20
  • 打赏
  • 举报
回复
永远不要和傻子争论,否则你的智商就会和他们一样,因为他们比你有经验。再次发布极致简约版,6行代码结束事件判断,现在还有谁不承认韩国仔的XP程序是白痴,在国外论坛还5星级,无缘无故多条线程来放钩子探测,如此愚蠢。6行代码,试问还有谁可以。

有人不服气,认为这个代码不是第一次,我想请问,Windows 7面世了多久?没人做过就是没人做过。有些人啊,啥也不懂的还不服气,这种人永远不要和他争论,因为他比你有经验。托盘区的特性极其特殊,与其叫图标叫button,不如叫label,完全没有句柄的label,更离谱的是这个label是透明穿透的,所以托盘图标很难操控。 这个蠢材还抬出微软,认为微软应该啥都干过。就好比有人100米跑第一了,他不服气,还跑到奥委会去质问,你们奥委会的人到底行不行?

可是微软又咋样,仅用6行代码完成了事件判断。试问还有谁需要控件?谁还有必要用微软不中用的,没有兼容性的Windows7新特性 Tray MouseHover?并且无法自主调节。

Windows7托盘区二侧多出6个像素,所以需要蓝体字的地方减2。XP不需要,但XP暂未测试。
没想到能这么简洁的完成,真是太高兴了。。。就当我在说胡话吧

Public vRect As RECT
Public IconWidth As Long, IconHeight As Long

Public Function CheckMouseOut(ByVal nx As Long, ByVal ny As Long, ByVal ix As Long, ByVal iy As Long) As Boolean

Dim Buffer As Long
Dim Fhwnd As Long, pIdExplorer As Long, hExplorer As Long
Dim BtnSize As Long

If ix <> 0 And vRect.Top = 0 Then
Fhwnd = WindowFromPoint(ix, iy)
GetWindowRect Fhwnd, vRect
BtnSize = SendMessage(Fhwnd, TB_GETBUTTONSIZE, 0&, 0&)
IconWidth = BtnSize And &HFFFF&
IconHeight = (BtnSize / &H10000) And &HFFFF&
End If

If ix <> 0 And Int((nx - vRect.Left - 2) / IconWidth) <> Int((ix - vRect.Left - 2) / IconWidth) Or Int((ny - vRect.Top) / IconHeight) <> Int((iy - vRect.Top) / IconHeight) Then
CheckMouseOut = True
vRect.Top = 0
End If

End Function
ahssw 2010-10-13
  • 打赏
  • 举报
回复
还好那
kumanong 2010-10-12
  • 打赏
  • 举报
回复
虽然不懂,还是要看看!支持下!
ChargeForward 2010-10-12
  • 打赏
  • 举报
回复
嗯 开源思想 谢谢分享!!! 支持楼主!
BD6500K 2010-10-12
  • 打赏
  • 举报
回复
[Quote=引用 354 楼 tigerge 的回复:]
引用 295 楼 bd6500k 的回复:
引用 280 楼 tigerge 的回复:
没什么兴趣,也不搞VB,只是对楼主的语气很好奇,不知道受过什么刺激.MSDN上有的东西你能确定会没人去实现?只是你不知道罢了.自古文无第一,在通往NB的路上必须谦虚一点.


中国为什么不出优秀的程序员?一是像你这样,说话不负责任。什么子类化托盘这种根本实现不了的事情,一来来N个人。总之我在国外论坛绝……
[/Quote]

所以说你就是个纯粹用脑子来臆断所有事情的人。即然你武断的认定了这么多事情,那出糗的也就是你自己,爱怎么无理取闹,你就无理取闹去吧。

我在这儿发帖,一来,解决大家多年来的困扰,看似简单,无人解决。二来,听听大家对代码的意见。并无多少实际意义的回复,我也就只能结帖。
Viskag 2010-10-12
  • 打赏
  • 举报
回复
好,随便看看·············
hflh1989 2010-10-12
  • 打赏
  • 举报
回复
这个楼主好嚣张呀呀呀呀呀
mojieke 2010-10-12
  • 打赏
  • 举报
回复
盖个章,留个印
凤凰涅檠 2010-10-12
  • 打赏
  • 举报
回复
[Quote=引用 5 楼 yachong 的回复:]
留个脚印方便以后查找
[/Quote]

支持
hq0927 2010-10-12
  • 打赏
  • 举报
回复
留下脚印...
yu2qing1 2010-10-12
  • 打赏
  • 举报
回复
留下脚印先
加载更多回复(284)

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧