Question

VB如何实现关闭后在依然在托盘中显示？（急）即时采纳

要求如下：
1.点击关闭按钮后，窗体关闭后，但程序没有退出，依然在托盘里显示。
2.双击托盘图标弹出窗体。
3.实现右击托盘中的图标，弹出菜单，选择“退出”方能退出程序。

谁能帮我的。（急）即时采纳

Answer 1

模块：
Option Explicit
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Public Type NOTIFYICONDATA
cbSize As Long 'NOTIFYICONDATA类型的大小
hwnd As Long '你的应用程序窗体的名柄
uID As Long '应用程序图标资源的ID号
uFlags As Long '使那些参数有效它是以下枚举类型中的NIF_MESSAGE、NIF_ICON、NIF_TIP三组的组合
uCallbackMessage As Long '鼠标移动时把此消息发给该图标的窗体
hIcon As Long '图标名柄
szTip As String * 64 '当鼠标在图标上时显示的Tip文本
End Type

Public Enum enm_NIM_Shell
NIM_ADD = &H0 '增加图标
NIM_MODIFY = &H1 '修改图标
NIM_DELETE = &H2 '删除图标
NIF_MESSAGE = &H1 '使类型"NOTIFYICONDATA"中的uCallbackMessage有效
NIF_ICON = &H2 '使类型"NOTIFYICONDATA"中的hIcon有效
NIF_TIP = &H4 '使类型"NOTIFYICONDATA"中的szTip有效
End Enum

Public Const WM_MOUSEMOVE = &H200 '在图标上移动鼠标
Public Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
Public Const WM_LBUTTONUP = &H202 '鼠标左键释放
Public Const WM_LBUTTONDBLCLK = &H203 '双击鼠标左键
Public Const WM_RBUTTONDOWN = &H204 '鼠标右键按下
Public Const WM_RBUTTONUP = &H205 '鼠标右键释放
Public Const WM_RBUTTONDBLCLK = &H206 '双击鼠标右键
Public Const WM_SETHOTKEY = &H32 '响应您定义的热键
Public nidProgramData As NOTIFYICONDATA
窗体代码：添加一个菜单
Option Explicit

Private Sub Form_Load()
With nidProgramData
.cbSize = Len(nidProgramData)
.hwnd = Me.hwnd
.uID = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon
.szTip = "托盘显示内容" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nidProgramData
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Form_MouseMove_err:
Dim Result, MSG As Long, I As Integer
If Me.ScaleMode = vbPixels Then
MSG = X
Else
MSG = X / Screen.TwipsPerPixelX
End If
Select Case MSG
Case WM_LBUTTONUP
SetForegroundWindow Me.hwnd '这个函数用来当你不或得焦点时弹出菜单能自动消失
me.show
Case WM_LBUTTONDBLCLK '双击托盘
SetForegroundWindow Me.hwnd
Me.Show
Case WM_RBUTTONUP
SetForegroundWindow Me.hwnd
PopupMenu MnuMain '弹出主菜单
End Select
Exit Sub
Form_MouseMove_err:

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim blnExitMe As Boolean
If blnExitMe = False Then
Cancel = True '取消退出
Me.Hide
Else
Shell_NotifyIcon NIM_DELETE, nidProgramData '退出时删除托盘图标
Cancel = False '从退出菜单才能退出
End If
End Sub

Private Sub MnuQuit_Click() '单击退出按钮时
Shell_NotifyIcon NIM_DELETE, nidProgramData
End
End Sub
’************************************************
希望可以帮到你，如果有什么问题，可以HI我。

Answer 2

'模块
Option Explicit

Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0

Public nfIconData As 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 * MAX_TOOLTIP
End Type

Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

'窗体
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP
'MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"
'单击左键，显示窗体
ShowWindow Me.hWnd, SW_RESTORE
'下面两句的目的是把窗口显示在窗口最顶层
'Me.Show
'Me.SetFocus
'' Case WM_RBUTTONUP
'' PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
'' Case WM_MOUSEMOVE
'' Case WM_LBUTTONDOWN
'' Case WM_LBUTTONDBLCLK
'' Case WM_RBUTTONDOWN
'' Case WM_RBUTTONDBLCLK
'' Case Else
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle

.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)

Me.Hide
End Sub