首页 /编程语言和算法/VB6/ASP
 VB6 代码管家-创建程序托盘图标
2024年12月8日 21:47
'以下代码须要两个按command,一个菜单(菜单里分别包含一个主菜单,三个子菜单,名称分别为sys\add\move\exit)
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'------------------------------------声名API
Private nfIconData As NOTIFYICONDATA
Const MAX_TOOLTIP As Integer = 50    '提示字符串中预显示的个数
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 Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
	Dim lMsg As Single
	lMsg = X / Screen.TwipsPerPixelX
	If lMsg = WM_LBUTTONDBLCLK Then '如果单击右键
	Me.PopupMenu sys            '菜单显示在光标处
	End If
End Sub '此事件中的代码只针对托盘上的图标
'---------------------------------------------------显示菜单

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
	If Button = 2 Then   '当点击右键时(2表示右键,1表示左键)
	Me.PopupMenu sys     '菜单显示在光标处
	End If
End Sub '此事件中的代码只针对未被最小化托盘窗体
'---------------------------------------------------显示菜单

Private Sub command1_Click()
	nfIconData.hwnd = Me.hwnd
	nfIconData.uID = Me.Icon
	nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
	nfIconData.uCallbackMessage = WM_MOUSEMOVE
	nfIconData.hIcon = Me.Icon.Handle
	nfIconData.szTip = "这就是在托盘上显示的文字!" & vbNullChar 'vbNullChar表示删除右边多于的空格
	nfIconData.cbSize = Len(nfIconData)
	
	Call Shell_NotifyIcon(NIM_ADD, nfIconData)    '添加图标到托盘
End Sub

Private Sub command2_Click()
	Call Shell_NotifyIcon(NIM_DELETE, nfIconData) '从托盘删除
End Sub

Private Sub move_Click() '从托盘删除
	Call command2_Click
End Sub

Private Sub add_Click()  '添加图标到托盘
	Call command1_Click
End Sub

Private Sub exit_Click() '退出程序
	End
End Sub

Private Sub Form_Unload(Cancel As Integer) '从托盘删除
	Call command2_Click
End Sub


 
全部回复(0)
首页 | 电脑版 |