'*************************************************************************
'**模 塊 名：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 Me
End Sub
'*************************************************************************
'**函 數 名：cmdShow_Click
'**輸 入：無
'**輸 出：無
'**功能描述：顯示提示
'**全局變量：
'**調用模塊：
'**作 者：葉帆
'**日 期：2004-10-14 09:34:44
'**修 改 人：
'**日 期：
'**版 本：V1.0.0
'*************************************************************************
Private Sub cmdShow_Click()
ShowNotifyIcon Me, txtTitle, txtInfo, cmbType.ListIndex
End 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
Next
End Sub
--------------------------------------------------------------------------------
'模塊代碼
'*************************************************************************
'**模 塊 名：mdlNotifyBase
'**說 明：YFsoft 版權所有2004 - 2005(C)
'**創 建 人：葉帆
'**日 期：2004-10-14 09:17:46
'**修 改 人：
'**日 期：
'**描 述：顯示托盤提示模塊
'**版 本：V1.0.0
'*************************************************************************
Option Explicit
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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 Long
Private Const WM_RBUTTONUP = &H205
Private Const WM_USER = &H400
Private Const WM_NOTIFYICON = WM_USER + 1 ' 自定義消息
Private Const WM_LBUTTONDBLCLK = &H203
Private 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 Long
Private 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 structure
Private Const NIS_HIDDEN = &H1 ' 隱藏圖標
Private Const NIS_SHAREDICON = &H2 ' 共享圖標
' dwInfoFlags to NOTIFIICONDATA structure
Private Const NIIF_NONE = &H0 ' 無圖標
Private Const NIIF_INFO = &H1 ' "消息"圖標
Private Const NIIF_WARNING = &H2 ' "警告"圖標
Private Const NIIF_ERROR = &H3 ' "錯誤"圖標
' uFlags to NOTIFYICONDATA structure
Private Const NIF_ICON As Long = &H2
Private Const NIF_INFO As Long = &H10
Private Const NIF_MESSAGE As Long = &H1
Private Const NIF_STATE As Long = &H8
Private Const NIF_TIP As Long = &H4
' dwMessage to Shell_NotifyIcon
Private Const NIM_ADD As Long = &H0
Private Const NIM_DELETE As Long = &H2
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_SETFOCUS As Long = &H3
Private Const lngNIM_SETVERSION As Long = &H4
Private 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 If
End 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

托盤圖標提示