马大哈 发表于 2007-3-5 21:22:09

[原创]马大哈系列功能模块-----托盘图标类(VB6.0)

<P>改自老外的一个标准模块,原模块是使用SubClass技术.</P>
<P>我本意是想改为不使用SubClass,但是遇到一点麻烦,还没解决....</P>
<P>先放上这个利用图片框WndProc的类来.</P>
<P>以下是部分代码:</P>
<P>'*************************************************************************<BR>'**模 块 名：cTray<BR>'**说&nbsp;&nbsp;&nbsp; 明：设置托盘图标<BR>'**创 建 人：马大哈 <A href="http://www.m5home.com/">http://www.m5home.com/</A><BR>'**日&nbsp;&nbsp;&nbsp; 期：2007年3月5日<BR>'**版&nbsp;&nbsp;&nbsp; 本：V1.0<BR>'**备&nbsp;&nbsp;&nbsp; 注：改自老外一个标准模块,封装成为一个类.<BR>'*************************************************************************<BR>Option Explicit</P>
<P>Public Sub DelTrayIco()<BR>&nbsp;&nbsp;&nbsp; '删除托盘图标<BR>'&nbsp;&nbsp;&nbsp; DoEvents<BR>&nbsp;&nbsp;&nbsp; With TheData<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uFlags = 0<BR>&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Shell_NotifyIcon NIM_DELETE, TheData<BR>End Sub</P>
<P>Public Sub AddTrayIco(ByRef EventPic As PictureBox)<BR>&nbsp;&nbsp;&nbsp; '设置托盘图标<BR>&nbsp;&nbsp;&nbsp; On Error Resume Next<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Set cPic = EventPic<BR>&nbsp;&nbsp;&nbsp; With TheData<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uID = 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .hWnd = cPic.hWnd<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .cbSize = Len(TheData)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uFlags = NIF_ICON<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uCallbackMessage = WM_MOUSEMOVE<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uFlags = .uFlags Or NIF_MESSAGE<BR>&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Shell_NotifyIcon NIM_ADD, TheData<BR>End Sub</P>
<P>Public Sub SetTrayTip(Tip As String)<BR>&nbsp;&nbsp;&nbsp; '设置提示信息<BR>&nbsp;&nbsp;&nbsp; With TheData<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .szTip = Tip &amp; vbNullChar<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uFlags = NIF_TIP<BR>&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Shell_NotifyIcon NIM_MODIFY, TheData<BR>End Sub</P>
<P>Public Sub SetTrayIcon(Pic As StdPicture)<BR>&nbsp;&nbsp;&nbsp; If Pic.Type &lt;&gt; vbPicTypeIcon Then Exit Sub</P>
<P>&nbsp;&nbsp;&nbsp; With TheData<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .hIcon = Pic.Handle<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .uFlags = NIF_ICON<BR>&nbsp;&nbsp;&nbsp; End With<BR>&nbsp;&nbsp;&nbsp; Shell_NotifyIcon NIM_MODIFY, TheData<BR>End Sub</P>
<P>Private Sub cPic_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)<BR>&nbsp;&nbsp;&nbsp; x = x / Screen.TwipsPerPixelX<BR>&nbsp;&nbsp;&nbsp; Select Case x<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_LBUTTONUP&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '左键抬起<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbLeftButton, False)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_LBUTTONDBLCLK&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '左键双击<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbLeftButton, True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_RBUTTONUP&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '右键抬起<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbRightButton, False)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_RBUTTONDBLCLK&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '右键双击<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbRightButton, True)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_MBUTTONUP&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '中键抬起<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbMiddleButton, False)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Case WM_MBUTTONDBLCLK&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '中键双击<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RaiseEvent MouseClick(vbMiddleButton, True)<BR>&nbsp;&nbsp;&nbsp; End Select<BR>End Sub</P>
<P>&nbsp;</P>
<P>示例工程在此下载:</P>
<P>&nbsp;</P>
<P><FONT color=#602464><A href="http://www.m5home.com/blog2/attachments/month_0703/u20073521427.rar">http://www.m5home.com/blog2/attachments/month_0703/u20073521427.rar</A></FONT><A href="http://www.m5home.com/blog2/blogview.asp?logID=203" target=_blank></A></P>
<P>&nbsp;</P>
<P><FONT color=#ff0000><STRONG>*********************************** 已经修正了地址了.............-_-b</STRONG></FONT></P>
<P align=right><FONT color=#000066>[此贴子已经被作者于2008-11-5 16:22:46编辑过]</FONT></P>

everyone 发表于 2008-11-4 15:08:54

<p>楼主的示例工程地址错误了.</p>
<p>我在存档BLOG里找到了正确的地址:</p>
<p><font face="Verdana"><a href="http://www.m5home.com/blog/blogview.asp?logID=203">http://www.m5home.com/blog/blogview.asp?logID=203</a></font></p>

马大哈 发表于 2008-12-19 14:56:10

谢谢....地址已经修正......- -b

nutsky 发表于 2008-12-23 10:06:27

哈 老马的网站全是好东西啊，学习学习~

toutou 发表于 2009-1-4 00:46:33

<p>看看, 改进一下我的助手, 谢谢啦,</p>
<p>&nbsp;</p>
<p>07的帖子,. 08年还编辑, 不错.</p>

everyone 发表于 2009-2-3 14:07:14

<p>好用</p>

vspv 发表于 2010-1-28 03:36:38

为什么退出程序了托盘图标还有残留，要用鼠标过去晃一下才会消失，右键菜单点出来后点一下其他地方菜单也不会消失Private Sub Form_Unload(Cancel As Integer)
    cTrayIco.DelTrayIco
    Set cTrayIco = Nothing
End Sub

马大哈 发表于 2010-1-28 12:41:16

DelTrayIco的代码是这样:Public Sub DelTrayIcon()
    '删除托盘图标
    With TheData
      .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    DoEvents
End Sub此代码目前为止只有你遇到了无法删除的情况,那请给出更详细的信息出来,方便分析.

至于弹出菜单问题,原因是菜单弹出后本进程并未获得焦点,则点击别的地方时,也没有产生"失去焦点"的消息,所以系统并未收回那个弹出菜单.

解决方案很简单,每次弹出菜单前,调用一下SetForegroundWindow即可.

olkl123456 发表于 2010-1-30 22:11:57

此贴不顶不行呀,太感谢了!

hq0927 发表于 2010-6-13 16:44:19

怎么地址又错了??
页: [1]
查看完整版本: [原创]马大哈系列功能模块-----托盘图标类(VB6.0)