在托盤圖標中添加氣球提示

    很多朋友都見到過能在托盤圖標上出現氣球提示的軟件,不說軟件,就是在“磁盤空間不足”時Windows給出的提示就屬於氣球提示,那麼怎樣在自己的程序中添加這樣的氣球提示呢?

    其實並不難,關鍵就在添加托盤圖標時所使用的NOTIFYICONDATA結構,源代碼如下:

窗體模塊:

Option Explicit

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 NIM_SETVERSION As Long = &H4

Private Sub Form_Load()
    ' 向托盤區添加圖標
    Dim IconData As NOTIFYICONDATA
    Dim title As String
    title = "托盤程序" & vbNullChar
    With IconData
        .cbSize = Len(IconData)
        .hwnd = Me.hwnd
        .uId = 0
        .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE
        .uCallBackMessage = WM_NOTIFYICON
        .szTip = title
        .hIcon = Me.Icon.Handle
        .dwState = 0
        .dwStateMask = 0
        .szInfo = "這是氣球提示" & vbNullChar
        .szInfoTitle = title
        .dwInfoFlags = NIIF_INFO
        .uTimeoutOrVersion = 10000
    End With
    Shell_NotifyIcon NIM_ADD, IconData
    preWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' 刪除托盤區圖標
    Dim IconData As NOTIFYICONDATA
    With IconData
        .cbSize = Len(IconData)
        .hwnd = Me.hwnd
        .uId = 0
        .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE
        .uCallBackMessage = WM_NOTIFYICON
        .szTip = "托盤程序"
        .hIcon = Me.Icon.Handle
    End With
    Shell_NotifyIcon NIM_DELETE, IconData
    SetWindowLong Me.hwnd, GWL_WNDPROC, preWndProc

    ' 卸載所有窗體
    Dim frm As Form
    For Each frm In Forms
        Unload frm
    Next
End Sub

標準模塊:

Option Explicit

Public 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

Public Const WM_RBUTTONUP = &H205
Public Const WM_USER = &H400
Public Const WM_NOTIFYICON = WM_USER + 1            ' 自定義消息
Public Const WM_LBUTTONDBLCLK = &H203
Public Const GWL_WNDPROC = (-4)

' 關於氣球提示的自定義消息, 2000下不產生這些消息
Public Const NIN_BALLOONSHOW = (WM_USER + &H2)      ' 當 Balloon Tips 彈出時執行
Public Const NIN_BALLOONHIDE = (WM_USER + &H3)      ' 當 Balloon Tips 消失時執行(如 SysTrayIcon 被刪除),
                                                    ' 但指定的 TimeOut 時間到或鼠標點擊 Balloon Tips 後的消失不發送此消息
Public Const NIN_BALLOONTIMEOUT = (WM_USER + &H4)   ' 當 Balloon Tips 的 TimeOut 時間到時執行
Public Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 當鼠標點擊 Balloon Tips 時執行。
                                                    ' 注意:在XP下執行時 Balloon Tips 上有個關閉按鈕,
                                                    ' 如果鼠標點在按鈕上將接收到 NIN_BALLOONTIMEOUT 消息。

Public preWndProc As Long

' Form1 窗口入口函數
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
                Unload Form1
            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(preWndProc, hwnd, msg, wParam, lParam)
End Function

    源代碼下載地址:http://csdngoodname008.51.net/Balloon.zip

*-------------------------------------------*<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

*  轉載請通知作者並註明出處,CSDN歡迎您!   *

*  作者:盧培培(goodname008              *

*  郵箱:[email protected]                *

*  專欄:http://blog.csdn.net/goodname008   *

*-------------------------------------------*

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章