托盘图标提示

2004年10月14日 10:02:00

'窗体代码

'*************************************************************************'**模 块 名：frmTest'**说 明：YFsoft 版权所有2004 - 2005(C)'**创 建 人：叶帆'**日 期：2004-10-14 09:08:28'**修 改 人：'**日 期：'**描 述：托盘气球提示'**版 本：V1.0.0'*************************************************************************Option Explicit'*************************************************************************'**函 数 名：cmdDel_Click'**输 入：无'**输 出：无'**功能描述：删除图标'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:34:58'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Private Sub cmdDel_Click() DelNotifyIcon MeEnd Sub'*************************************************************************'**函 数 名：cmdShow_Click'**输 入：无'**输 出：无'**功能描述：显示提示'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:34:44'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Private Sub cmdShow_Click() ShowNotifyIcon Me, txtTitle, txtInfo, cmbType.ListIndexEnd Sub'*************************************************************************'**函 数 名：Form_Load'**输 入：无'**输 出：无'**功能描述：'**全局变量：'**调用模块：初始化'**作 者：叶帆'**日 期：2004-10-14 09:08:57'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Private Sub Form_Load() cmbType.ListIndex = 1 '信息图标 cmdShow_Click '显示信息End Sub'*************************************************************************'**函 数 名：Form_Unload'**输 入：Cancel(Integer) -'**输 出：无'**功能描述：结束'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:35:32'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Private Sub Form_Unload(Cancel As Integer) '删除图标 cmdDel_Click ' 卸载所有窗体 Dim frm As Form For Each frm In Forms Unload frm NextEnd Sub--------------------------------------------------------------------------------'模块代码 '*************************************************************************'**模 块 名：mdlNotifyBase'**说 明：YFsoft 版权所有2004 - 2005(C)'**创 建 人：叶帆'**日 期：2004-10-14 09:17:46'**修 改 人：'**日 期：'**描 述：显示托盘提示模块'**版 本：V1.0.0'*************************************************************************Option ExplicitPrivate Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Const WM_RBUTTONUP = &H205Private Const WM_USER = &H400Private Const WM_NOTIFYICON = WM_USER + 1 ' 自定义消息Private Const WM_LBUTTONDBLCLK = &H203Private Const GWL_WNDPROC = (-4)' 关于气球提示的自定义消息, 2000下不产生这些消息Private Const NIN_BALLOONSHOW = (WM_USER + &H2) ' 当 Balloon Tips 弹出时执行Private Const NIN_BALLOONHIDE = (WM_USER + &H3) ' 当 Balloon Tips 消失时执行（如 SysTrayIcon 被删除）， ' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息Private Const NIN_BALLOONTIMEOUT = (WM_USER + &H4) ' 当 Balloon Tips 的 TimeOut 时间到时执行Private Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。 ' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮, ' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPrivate Type NOTIFYICONDATA cbSize As Long ' 结构大小(字节) hwnd As Long ' 处理消息的窗口的句柄 uId As Long ' 唯一的标识符 uFlags As Long ' Flags uCallBackMessage As Long ' 处理消息的窗口接收的消息 hIcon As Long ' 托盘图标句柄 szTip As String * 128 ' Tooltip 提示文本 dwState As Long ' 托盘图标状态 dwStateMask As Long ' 状态掩码 szInfo As String * 256 ' 气球提示文本 uTimeoutOrVersion As Long ' 气球提示消失时间或版本 ' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000) ' uVersion - 版本(0 for V4, 3 for V5) szInfoTitle As String * 64 ' 气球提示标题 dwInfoFlags As Long ' 气球提示图标End Type' dwState to NOTIFYICONDATA structurePrivate Const NIS_HIDDEN = &H1 ' 隐藏图标Private Const NIS_SHAREDICON = &H2 ' 共享图标' dwInfoFlags to NOTIFIICONDATA structurePrivate Const NIIF_NONE = &H0 ' 无图标Private Const NIIF_INFO = &H1 ' "消息"图标Private Const NIIF_WARNING = &H2 ' "警告"图标Private Const NIIF_ERROR = &H3 ' "错误"图标' uFlags to NOTIFYICONDATA structurePrivate Const NIF_ICON As Long = &H2Private Const NIF_INFO As Long = &H10Private Const NIF_MESSAGE As Long = &H1Private Const NIF_STATE As Long = &H8Private Const NIF_TIP As Long = &H4' dwMessage to Shell_NotifyIconPrivate Const NIM_ADD As Long = &H0Private Const NIM_DELETE As Long = &H2Private Const NIM_MODIFY As Long = &H1Private Const NIM_SETFOCUS As Long = &H3Private Const lngNIM_SETVERSION As Long = &H4Private lngPreWndProc As Long'*************************************************************************'**函 数 名：ShowNotifyIcon'**输 入：frm(Form) - 窗体'** ：strTitle(String) - 托盘提示标题'** ：strInfo(String) - 托盘提示信息'** ：Optional lngType(Long = 1) - 托盘提示类型 0 无 1 信息 2 警告 3 错误'** ：Optional lngTime(Long = 10000) - 停留时间'**输 出：无'**功能描述：显示托盘图标提示信息'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:23:14'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Public Sub ShowNotifyIcon(frm As Form, strTitle As String, strInfo As String, Optional lngType As Long = 1, Optional lngTime As Long = 10000) ' 向托盘区添加图标 Dim IconData As NOTIFYICONDATA strTitle = strTitle & vbNullChar strInfo = strInfo & vbNullChar With IconData .cbSize = Len(IconData) .hwnd = frm.hwnd .uId = 0 .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE .uCallBackMessage = WM_NOTIFYICON .szTip = strTitle .hIcon = frm.Icon.Handle .dwState = 0 .dwStateMask = 0 .szInfo = strInfo .szInfoTitle = strTitle .dwInfoFlags = lngType .uTimeoutOrVersion = lngTime End With If lngPreWndProc = 0 Then '没有初始化 Shell_NotifyIcon NIM_ADD, IconData lngPreWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf WindowProc) Else '已初始化 Shell_NotifyIcon NIM_MODIFY, IconData End If End Sub'*************************************************************************'**函 数 名：DelNotifyIcon'**输 入：frm(Form) - 窗体'**输 出：无'**功能描述：删除托盘图标'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:33:01'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Public Sub DelNotifyIcon(frm As Form) If lngPreWndProc >< 0 Then ' 删除托盘区图标 Dim IconData As NOTIFYICONDATA With IconData .cbSize = Len(IconData) .hwnd = frm.hwnd .uId = 0 .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE .uCallBackMessage = WM_NOTIFYICON .szTip = "" .hIcon = frm.Icon.Handle End With Shell_NotifyIcon NIM_DELETE, IconData SetWindowLong frm.hwnd, GWL_WNDPROC, lngPreWndProc lngPreWndProc = 0 End IfEnd Sub'*************************************************************************'**函 数 名：WindowProc'**输 入：ByVal hwnd(Long) -'** ：ByVal msg(Long) -'** ：ByVal wParam(Long) -'** ：ByVal lParam(Long) -'**输 出：(Long) -'**功能描述：frmTest 窗口入口函数'**全局变量：'**调用模块：'**作 者：叶帆'**日 期：2004-10-14 09:19:06'**修 改 人：'**日 期：'**版 本：V1.0.0'*************************************************************************Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' 拦截 WM_NOTIFYICON 消息 If msg = WM_NOTIFYICON Then Select Case lParam Case WM_RBUTTONUP ' 右键单击图标是运行这里的代码, 可以在这里添加弹出右键菜单的代码 Case WM_LBUTTONDBLCLK ' 左键单击 显示窗体 frmTest.Show Case NIN_BALLOONSHOW Debug.Print "显示气球提示" Case NIN_BALLOONHIDE Debug.Print "删除托盘图标" Case NIN_BALLOONTIMEOUT Debug.Print "气球提示消失" Case NIN_BALLOONUSERCLICK Debug.Print "单击气球提示" End Select End If WindowProc = CallWindowProc(lngPreWndProc, hwnd, msg, wParam, lParam)End Function

Trackback: http://tb.blog.youkuaiyun.com/TrackBack.aspx?PostId=135813