如何将窗体最小化到任务栏,显示托盘图标?

Option Explicit

Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu

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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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

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

Private TheData As NOTIFYICONDATA
'替换Windows进程
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 lParam = WM_RBUTTONUP Then
' 鼠标右键单击,弹出菜单
TheForm.PopupMenu TheMenu
Exit Function
' End If
End If
End If

' 发送消息到原来进程
NewWindowProc = CallWindowProc( _
OldWindowProc, hwnd, Msg, _
wParam, lParam)
End Function

' 添加图标到托盘区(Tray)
Public Sub AddToTray(frm As Form, mnu As Menu)
' 表单的ShowInTaskbar = Fals
Set TheForm = frm
Set TheMenu = mnu

' 安装新的Windows进程
OldWindowProc = SetWindowLong(frm.hwnd, _
GWL_WNDPROC, AddressOf NewWindowProc)

' 安装图标到Tray区
With TheData
.uID = 0
.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
Shell_NotifyIcon NIM_ADD, TheData
End Sub

' 将图标从托盘区移走
Public Sub RemoveFromTray()

With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData

' 恢复原来的进程
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
End Sub

' 设置图标为新的图片框图标
Public Sub SetTrayIcon(pic As Picture)
' 如果图片框没有图标时退出.
If pic.Type <> vbPicTypeIcon Then Exit Sub

' 更新Tray区的图标.
With TheData
.hIcon = pic.Handle
.uFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub