Question

200分:vb如何在托盘设置右键菜单和弹出提示信息

做一个小程序，已做好托盘效果,即是当最小化时在托盘显示（桌面右下角）.

求写出下面代码:

一、当某个信息来时,在托盘弹出提示信息,就好像QQ弹出系统信息那样?
二、如果在托盘点击右键，弹出一个菜单，点击时有动作？
请写出实现代码.

Answer 1

1、新建一个类模块，粘贴如下内容：

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
Form1.Print "右键点击"
Form1.PopupMenu Form1.A '这个form1.A 是你的菜单名字，不要填错哦~~不然vb会死掉的
' 右键单击图标是运行这里的代码, 可以在这里添加弹出右键菜单的代码
Case WM_LBUTTONDBLCLK
MsgBox "你双击了我哦，我现在会退出..."
Unload Form1
Case NIN_BALLOONSHOW
Form1.Print "显示提示"
Case NIN_BALLOONHIDE
Form1.Print "删除托盘图标"
Case NIN_BALLOONTIMEOUT
Form1.Print "提示消失"
Case NIN_BALLOONUSERCLICK
MsgBox "你点了我一次..."
Form1.Print "单击提示"
End Select
End If
WindowProc = CallWindowProc(preWndProc, hwnd, msg, wParam, lParam)
End Function

2、在form中，粘贴如下内容：
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 = "呵呵 看到了么? 点我试试? 如果要改图标，直接改form的图标就可以了！" & 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

3、最后不要忘了在form1里面用菜单编辑器新建一个叫做A的菜单（标题随便取，但名称一定要是A），在它下面多建几个子菜单，然后添加事件，然后...就可以运行了~~

Answer 2

'--------------------------------------------------------
'模块
'在任务栏显示小图标
Option Explicit
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2 '删除图标
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0 '添加图标到任务栏提示区
Const NIM_DELETE = &H2
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 SW_RESTORE = 9
Const SW_HIDE = 0
Private 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
Private Const WM_USER As Long = &H400
'鼠标事件
Public Enum TrayRetunEventEnum
MouseMove = &H200
LeftUp = &H202
LeftDown = &H201
LeftDbClick = &H203
RightUp = &H205
RightDown = &H204
RightDbClick = &H206
MiddleUp = &H208
MiddleDown = &H207
MiddleDbClick = &H209
BalloonClick = (WM_USER + 5)
End Enum

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private nfIconData As NOTIFYICONDATA

Sub AddIcon()
nfIconData.hwnd = Form1.hwnd
nfIconData.uId = Form1.Icon
nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
nfIconData.ucallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Form1.Icon.Handle
nfIconData.szTip = "小小外挂(阿勇) QQ:357731659" & vbNullChar
nfIconData.cbSize = Len(nfIconData)
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
End Sub

Sub DelIcon()
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub Form_Load() '装载
AddIcon
End Sub
Private Sub Form_Unload(Cancel As Integer)
DelIcon
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'气泡单击时的鼠标事件
Dim cEvent As Single
cEvent = X / Screen.TwipsPerPixelX

Select Case cEvent

Case MouseMove
'Debug.Print "MouseMove"
Case LeftUp
' Debug.Print "左键放开"
Case LeftDown
' Debug.Print "左键按下"
Case LeftDbClick
' Debug.Print "左键双击"
Form1.WindowState = 0
Form1.Show
Case MiddleUp
' Debug.Print "中间键放开"
Case MiddleDown
' Debug.Print "中间键按下"
Case MiddleDbClick
' Debug.Print "中间键单击"
Case RightUp
' Debug.Print "右健放开"
Case RightDown
' Debug.Print "右健按下"
Me.PopupMenu Me.menu
Case RightDbClick
' Debug.Print "右健双击"
Case BalloonClick
' Debug.Print "单击气泡"

End Select
End Sub

Answer 3

有个类的啊

Answer 4

有个类的

Answer 5

给出你的邮箱，1~2内发给你（付上详细要求）

Answer 6

要看到你做的托盘程序怎么写的才知道怎么定义右键菜单的

建议用SysTray.ocx来做系统托盘,比较方便