增加系统托盘图标的问题
我的目的是使用Shell_NotifyIcon函数在系统托盘上增加一个图标，当中遇到点问题，代码是这样的：
' ' ' ' ' ' ' ' ' ' ' ' ' ' '模块代码
Public Declare Function Shell_NotifyIcon Lib "shell32.dll " Alias "Shell_NotifyIconA " (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String
End Type
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '窗体代码:
Private Sub Form_Load()
Dim nficondata As NOTIFYICONDATA
With nficondata
.uID = Me.Icon
.uFlags = &H2
.uCallbackMessage = &H200
.hIcon = Me.Icon.Handle
.szTip = "系统托盘演示 "
.cbSize = 255
End With
Call Shell_NotifyIcon(&H0, nficondata)
End Sub
问题是这样的,上面的程序运行以后,在系统托盘上出现一个图标,可是当我用鼠标移动到这个图标的时候,图标马上就消失了。。
请问如何解决这个问题，请高手指点，谢谢！
[解决办法]
1、新建立一个VB6工程，将Form1的ShowInTaskBar属性设置为False
2、菜单：工程--添加模块 按“打开”这样就添加了一个新模块，名为Module1,保存为Module1.bas
3、在Module1中写下如下代码：
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
4、在Form1的Load事件中写下如下代码：
Private Sub Form_Load()
'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = App.Title + "(版本 " & App.Major & ". " & App.Minor & ". " & App.Revision & ") " & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Sub
5、在Form1的QueryUnload事件中写入如下代码：
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
6、在Form1的MouseMove事件中写下如下代码：
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
7、现在将程序保存起来运行看看系统托盘处是否增加了一个本工程的图标。单击此图标，Form1就自动弹出来了。
参考资料：http://www.programfan.com/article/showarticle.asp?id=2605
