'---------------------------------------------
' 使用系統托盤程序演示
'---------------------------------------------
'程序說明：
' 這是一個比較完整的使用系統托盤的程序實例，包括
'了：添加托盤圖標，刪除托盤圖標，動態改變托盤圖標，
'為托盤圖標添加浮動提示信息，實現托盤圖標的鼠標右鍵
'菜單等內容。
'-------名稱-------------------作用------------
' Form1 主窗體
' mnuFile,mnuFileExit 文件菜單，菜單項
' mnuTray,mnuTrayClose... 托盤區右鍵菜單，菜單項
'---------------------------------------------
Option Explicit
'LastState變量的作用是標示主窗體原有狀態
Public LastState As Integer
'【VB聲明】
' Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'【說明】
' 調用一個窗口的窗口函數，將一條消息發給那個窗口。除非消息處理完畢，否則該函數不會返回。SendMessageBynum，
' SendMessageByString是該函數的“類型安全”聲明形式
'【返回值】
' Long，由具體的消息決定
'【參數表】
' hwnd ----------- Long，要接收消息的那個窗口的句柄
' wMsg ----------- Long，消息的標識符
' wParam --------- Long，具體取決于消息
' lParam --------- Any，具體取決于消息
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'表示發送的是系統命令
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
'當主窗體加載時
Private Sub Form_Load()
'窗體的WindowState屬性，返回或設置一個值，該值用來指定在運行時窗體窗口的可視狀態
'vbNormal 0 （缺省值）正常 。
'VbMinimized 1 最小化（最小化為一個圖標）
'VbMaximized 2 最大化（擴大到最大尺寸）
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If
'將圖標添加到托盤的函數，參見模塊中的解釋
'注意了這是從主程序到模塊的入口，本例中并沒有直接調用Shell_NotifyIcon函數
AddToTray Me, mnuTray
SetTrayTip "托盤圖標演示，點擊右鍵彈出菜單"
End Sub
'在主窗體Form1大小改變時，相應改變右鍵菜單mnuTray的菜單項的可用屬性Enabled
Private Sub Form_Resize()
Select Case WindowState
'如果窗體最小化了，把菜單項“最大化”“恢復”設為可用，
'而把“最小化”“移動”“大小”三項設為不可用.
'如果這時在托盤圖標上點擊鼠標右鍵，會發現不可用項變為灰色
Case vbMinimized
mnuTrayMaximize.Enabled = True
mnuTrayMinimize.Enabled = False
mnuTrayMove.Enabled = False
mnuTrayRestore.Enabled = True
mnuTraySize.Enabled = False
'窗體最大化時
Case vbMaximized
mnuTrayMaximize.Enabled = False
mnuTrayMinimize.Enabled = True
mnuTrayMove.Enabled = False
mnuTrayRestore.Enabled = True
mnuTraySize.Enabled = False
'一般狀態下
Case vbNormal
mnuTrayMaximize.Enabled = True
mnuTrayMinimize.Enabled = True
mnuTrayMove.Enabled = True
mnuTrayRestore.Enabled = False
mnuTraySize.Enabled = True
End Select
If WindowState <> vbMinimized Then LastState = WindowState
End Sub
'保證在程序退出時刪除托盤圖標
Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
End Sub
'“文件”菜單的“退出”項被點擊時
Private Sub mnuFileExit_Click()
Unload Me
End Sub
'托盤圖標右鍵菜單上的“退出”項被點擊時
Private Sub mnuTrayClose_Click()
Unload Me
End Sub
'托盤圖標右鍵菜單上的“最大化”項被點擊時
Private Sub mnuTrayMaximize_Click()
WindowState = vbMaximized
End Sub
'托盤圖標右鍵菜單上的“最小化”項被點擊時
Private Sub mnuTrayMinimize_Click()
WindowState = vbMinimized
End Sub
'托盤圖標右鍵菜單上的“移動”項被點擊時
Private Sub mnuTrayMove_Click()
SendMessage HWnd, WM_SYSCOMMAND, _
SC_MOVE, 0&
End Sub
'托盤圖標右鍵菜單上的“恢復”項被點擊時
Private Sub mnuTrayRestore_Click()
SendMessage HWnd, WM_SYSCOMMAND, _
SC_RESTORE, 0&
End Sub
'托盤圖標右鍵菜單上的“退出”項被點擊時
Private Sub mnuTraySize_Click()
SendMessage HWnd, WM_SYSCOMMAND, _
SC_SIZE, 0&
End Sub
'-----------------------------------------
'以下為模塊中的代碼：
'-----------------------------------------
Option Explicit
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
'【VB聲明】
'Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'【說明】
' 此函數發送消息到一個窗口過程
'【返回值】
' Long，依據發送的消息不同而變化
'【參數表】
' lpPrevWndFunc----- Long，原來的窗口過程地址
' HWnd-------------- Long，窗口句柄
' Msg -------------- Long，發送的消息
' wParam ----------- Long，消息類型，參考wParam參數表
' lParam ----------- Long，依據wParam參數的不同而不同
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'【VB聲明】
' Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'【說明】
' 在窗口結構中為指定的窗口設置信息
'【返回值】
' Long，指定數據的前一個值
'【參數表】
' hwnd ----------- Long，欲為其取得信息的窗口的句柄
' nIndex --------- Long，請參考GetWindowLong函數的nIndex參數的說明
' dwNewLong ------ Long，由nIndex指定的窗口信息的新值
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'【VB聲明】
'Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'【說明】
'【參數表】
'參數dwMessage ---- 為消息設置值，它可以是以下的幾個常數值：0、1、2
'NIM_ADD = 0 加入圖標到系統狀態欄中
'NIM_MODIFY = 1 修改系統狀態欄中的圖標
'NIM_DELETE = 2 刪除系統狀態欄中的圖標
'參數LpData ---- 用以傳入NOTIFYICONDATA數據結構變量，我們也需要在"模塊"中定義其結構如下：
'Type NOTIFYICONDATA
' cbSize As Long 需填入NOTIFYICONDATA數據結構的長度
' HWnd As Long 設置成窗口的句柄
' Uid As Long 為圖標所設置的ID值
' UFlags As Long 用來設置以下三個參數uCallbackMessage、hIcon、szTip是否有效
' UCallbackMessage As Long 消息編號
' HIcon As Long 顯示在狀態欄上的圖標
' SzTip As String * 64 提示信息
'End Type
'---- 其中參數uCallbackMessage、hIcon、szTip也應在模塊中聲明為以下的常量：
'Public Const NIF_MESSAGE = 1
'Public Const NIF_ICON = 2
'Public Const NIF_TIP = 4
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
'記錄 設置托盤圖標的數據 的數據類型NOTIFYICONDATA
Public Type NOTIFYICONDATA
cbSize As Long
HWnd As Long
Uid As Long
UFlags As Long
UCallbackMessage As Long
HIcon As Long
SzTip As String * 64
End Type
'TheData變量記錄設置托盤圖標的數據
Private TheData As NOTIFYICONDATA
' *********************************************
' 新的窗口過程--主程序中采用SetWindowLong函數改變了窗口函數的地址，消息轉向由NewWindowProc處理
' *********************************************
Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果用戶點擊了托盤中的圖標，則進行判斷是點擊了左鍵還是右鍵
If Msg = TRAY_CALLBACK Then
'如果點擊了左鍵
If lParam = WM_LBUTTONUP Then
'而這時窗體的狀態是最小化時
If TheForm.WindowState = vbMinimized Then _
'恢復到最小化前的窗體狀態
TheForm.WindowState = TheForm.LastState
TheForm.SetFocus
Exit Function
End If
End If
'如果點擊了右鍵
If lParam = WM_RBUTTONUP Then
'則彈出右鍵菜單
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
'如果是其他類型的消息則傳遞給原有默認的窗口函數
NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)
End Function
' *********************************************
' 把主窗體的圖標（Form1.icon屬性可改變）添加到托盤中
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
'保存當前窗體和菜單信息
Set TheForm = frm
Set TheMenu = mnu
'GWL_WNDPROC獲得該窗口的窗口函數的地址
OldWindowProc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
'知識點滴：HWnd屬性
'返回窗體或控件的句柄。語法: object.HWnd
'說明:Microsoft Windows 運行環境，通過給應用程序中的每個窗體和控件
'分配一個句柄（或 hWnd）來標識它們。hWnd 屬性用于Windows API調用。
'將主窗體圖標添加在托盤中
With TheData
.Uid = 0 '忘了嗎？參考一下前面內容,Uid圖標的序號，做動畫圖標有用
.HWnd = frm.HWnd
.cbSize = Len(TheData)
.HIcon = frm.Icon.Handle
.UFlags = NIF_ICON '指明要對圖標進行設置
.UCallbackMessage = TRAY_CALLBACK
.UFlags = .UFlags Or NIF_MESSAGE '指明要設置圖標或返回信息給主窗體，此句不能省去
.cbSize = Len(TheData) '為什么呢？我們需要在添加圖標的同時，讓其返回信息
End With '給主窗體，Or的意思是同時進行設置和返回消息
Shell_NotifyIcon NIM_ADD, TheData '根據前面定義NIM_ADD，設置為“添加模式”
End Sub
' *********************************************
' 刪除系統托盤中的圖標
' *********************************************
Public Sub RemoveFromTray()
'刪除托盤中的圖標
With TheData
.UFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData '根據前面定義NIM_DELETE，設置為“刪除模式”
'恢復原有的設置
SetWindowLong TheForm.HWnd, GWL_WNDPROC, OldWindowProc
End Sub
' *********************************************
' 為托盤中的圖標加上浮動提示（也就是鼠標移上去時出現的提示字條）
' *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.SzTip = tip & vbNullChar
.UFlags = NIF_TIP '指明要對浮動提示進行設置
End With
Shell_NotifyIcon NIM_MODIFY, TheData '根據前面定義NIM_MODIFY，設置為“修改模式”
End Sub
' *********************************************
' 設置托盤的圖標（在本例中沒有用到，如果要動態改變托盤內顯示的圖標，它非常有用）
' 例如：1、顯示動畫圖標（方法你一定猜到了，對！使用Timer控件，不斷調用此過程，注意把動畫放在pic數組中）
' 2、程序處于不同狀態時，顯示不同的圖標，方法是類似的
' 有興趣的話試一試吧。
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
'判斷一下pic中存放的是不是圖標
If pic.Type <> vbPicTypeIcon Then Exit Sub
'更換圖標為pic中存放的圖標
With TheData
.HIcon = pic.Handle
.UFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub |