模块化的托盘程序

SKY定格

注：SetTrayIcon 是自定义的函数
调用方法： SetTrayIcon 图标，"鼠标移到托盘上所显示的文字"，"操作"
1、增加系统的托盘
SetTrayIcon Me.Icon, "中华人民共和国", "Add"
2、删除系统的托盘
SetTrayIcon Me.Icon, "", "Del"
3、修改系统的托盘
SetTrayIcon Image1.Picture, "你好！！", "Modi"
4、程序退出时的系统托盘
SetTrayIcon Me.Icon, "", "Exit"
补充：大家如果需要实现动画托盘，则可使用 Timer 定时修改系统的托盘。
请大家新建一个模块（.bas）文件，自定义 SetTrayIcon 函数及其他，这样在以后的任何程序中只要调用此模块就可以了。
`本模块是有关系统托盘的
Option Explicit

Const NIM_ADD = 0 `加入图标到系统状态区中
Const NIM_MODIFY = 1 `修改系统状态区的图标
Const NIM_DELETE = 2 `删除系统状态区的图标

Const NIF_MESSAGE = 1 `消息
Const NIF_ICON = 2 `设置图标
Const NIF_TIP = 4 `提示

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

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long `建立系统状态区的图标

Const GWL_WNDPROC = (-4) `窗口函数的地址
Const WM_USER = &H400
Const WM_MOUSEFIRST = &H200`鼠标移动时发生，比 WM_MOUSEMOVE 要早
Const WM_MOUSEMOVE = &H200`鼠标移动时发生
Const WM_LBUTTONDOWN = &H201`鼠标左键按下时发生
Const WM_LBUTTONUP = &H202`鼠标左键放开时发生
Const WM_LBUTTONDBLCLK = &H203 `鼠标左键双击时发生
Const WM_RBUTTONDOWN = &H204`鼠标右键按下时发生
Const WM_RBUTTONUP = &H205`鼠标右键放开时发生
Const WM_RBUTTONDBLCLK = &H206 `鼠标右键双击时发生
Const WM_MBUTTONDOWN = &H207`中间键按下时发生
Const WM_MBUTTONUP = &H208`中间键放开时发生
Const WM_MBUTTONDBLCLK = &H209 `中间键双击时发生
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 `将消息传送给指定的窗口
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long `取得窗口消息
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long `设置窗口消息

Dim tray_win As Long `保存窗口的变量
Dim tray_nid As NOTIFYICONDATA `定义系统区图标
Dim tray_IsWinAddress As Boolean `是否取得窗口信息的判断
Const uID = 9998
Const tray_uMessage = WM_USER + 100

`Msg 传过来的是区域(如果工作区、标题区、系统状态区等等) lParam 传过来的是消息(如鼠标左键点击、右键点击等等) wParam 自己感觉没有多大的用处,通过前面传过来的信息,进行判断处理
Function trayWndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_USER + 100 Then
Select Case lParam `下面是大部分的鼠标操作，你可根据所需的事件，定义自己的操作
Case WM_MOUSEFIRST `鼠标移动时发生，比 WM_MOUSEMOVE 要早

Case WM_MOUSEMOVE `鼠标移动时发生

Case WM_LBUTTONDOWN `鼠标左键按下时发生

Case WM_LBUTTONUP `鼠标左键放开时发生

Case WM_LBUTTONDBLCLK `鼠标左键双击时发生

Case WM_RBUTTONDOWN `鼠标右键按下时发生

Case WM_RBUTTONUP `鼠标右键放开时发生

Case WM_RBUTTONDBLCLK `鼠标右键双击时发生

Case WM_MBUTTONDOWN `中间键按下时发生

Case WM_MBUTTONUP `中间键放开时发生

Case WM_MBUTTONDBLCLK`中间键双击时发生

End Select
End If
trayWndProc = CallWindowProc(tray_win, hWnd, Msg, wParam, lParam) `将消息传送给指定的窗口
End Function

Function SetTrayIcon(ByVal Icon As Long, ByVal Tip As String, ByVal Action As String)
If tray_IsWinAddress = False Then `判断是否需要取得、设置窗口信息，如果重复取得、设置，将会造成程序死掉
tray_win = GetWindowLong(Form1.hWnd, GWL_WNDPROC) `取得(备份)窗口信息
SetWindowLong Form1.hWnd, GWL_WNDPROC, AddressOf trayWndProc `设置新的窗口信息
End If

tray_nid.cbSize = Len(tray_nid) `取数据结构的长度设置给 cbSize
tray_nid.hWnd = Form1.hWnd `设置图标的句柄，这里为本窗口的
tray_nid.uID = 9999
tray_nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE `设置图标、提示、消息
tray_nid.hIcon = Icon `图标
tray_nid.szTip = Tip + Chr(0) `图标提示
tray_nid.uCallbackMessage = tray_uMessage

Select Case Action
Case "Add"
Shell_NotifyIcon NIM_ADD, tray_nid`加入图标到系统状态区中
Case "Del"
Shell_NotifyIcon NIM_DELETE, tray_nid `删除系统区的图标
Case "Modi"
Shell_NotifyIcon NIM_MODIFY, tray_nid `修改系统区的图标
Case "Exit"
Shell_NotifyIcon NIM_DELETE, tray_nid `删除系统区的图标
SetWindowLong Form1.hWnd, GWL_WNDPROC, tray_win `恢复窗口信息
End Select
tray_IsWinAddress = True `不需要再取得窗口信息
End Function