关于在window2000下生成托盘图标的问题

Rain_B 2003-11-07 09:46:25
我搜索了很多关于生成托盘图标的资料,发现都是使用的Shell_notifyicon这个API函数,可是win2000下找不到这个函数啊,我查了很多资料都说这个API在windows2000里不支持,我该怎么办?请教高手赐教,一百分全给你,谁最先给我答案我就全给谁。
...全文
38 6 打赏 收藏 转发到动态 举报
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
taosihai1only 2003-11-13
  • 打赏
  • 举报
回复
up
online 2003-11-11
  • 打赏
  • 举报
回复
没有问题
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDBLCLK = &H206
' 结构声明
Private 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

Dim NotifyData As NOTIFYICONDATA
Dim Img_Int As Integer

Private Sub Form_Load()
Timer1.Interval = 500 ' 设置计时器时间间隔
Timer1.Enabled = True ' 使计时器可用
' 隐藏图片
For Img_Int = 0 To 3
Icon_Img(Img_Int).Visible = False
Next Img_Int
Img_Int = 0 ' 初始图片索引

' 调整标签位置,使居中
Shadow_Lab1.Left = (Me.ScaleWidth - Shadow_Lab1.Width) / 2
Shadow_Lab1.Top = (Me.ScaleHeight - Shadow_Lab1.Height) / 2
' 制造阴影效果
Shadow_Lab2.Left = Shadow_Lab1.Left + 80
Shadow_Lab2.Top = Shadow_Lab1.Top + 80
Shadow_Lab1.ZOrder '调整标签顺序

End Sub

Private Sub SysTray_Menu_Click()
' 在 SysTray上添加一个图标
NotifyData.cbSize = Len(NotifyData)
NotifyData.hwnd = Demo_Frm.hwnd
NotifyData.uID = vbNull
NotifyData.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
NotifyData.uCallbackMessage = WM_MOUSEMOVE
NotifyData.hIcon = Demo_Frm.Icon
NotifyData.szTip = "双击以显示窗体" & vbNullChar
Shell_NotifyIcon NIM_ADD, NotifyData ' 添加图标
Demo_Frm.Hide ' 隐藏窗体
End Sub

' 循环显示图片为图标,并在托盘中显示
Private Sub Timer1_Timer()
Img_Int = Img_Int + 1
If Img_Int = 4 Then
Img_Int = 0
End If
Me.Icon = Icon_Img(Img_Int).Picture

' 更新 NOTIFYICONDATA 的值,以反映动画的改变
NotifyData.cbSize = Len(NotifyData)
NotifyData.hwnd = Demo_Frm.hwnd
NotifyData.uID = vbNull
NotifyData.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
NotifyData.hIcon = Demo_Frm.Icon

Shell_NotifyIcon NIM_MODIFY, NotifyData
End Sub

' 判断用户是否双击系统托盘中的图标,若双击则退出系统托盘
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CLng(X / Screen.TwipsPerPixelX) = WM_LBUTTONDBLCLK Or CLng(X / Screen.TwipsPerPixelX) = WM_RBUTTONDBLCLK Then
Shell_NotifyIcon NIM_DELETE, NotifyData
Demo_Frm.Show
Demo_Frm.WindowState = 0
End If
End Sub

' 退出程序
Private Sub Exit_Menu_Click()
Shell_NotifyIcon NIM_DELETE, NotifyData
Set Demo_Frm = Nothing
End
End Sub

Private Sub Form_Terminate()
'删除SysTray上的图标
Shell_NotifyIcon NIM_DELETE, NotifyData
End Sub

Private Sub Form_Unload(Cancel As Integer)
'删除SysTray上的图标
Shell_NotifyIcon NIM_DELETE, NotifyData
Call FormUnload
End Sub

' 卸载窗体时
Public Sub FormUnload()
Set Demo_Frm = Nothing
End
End Sub


yunfeng007 2003-11-08
  • 打赏
  • 举报
回复
Public Const DefaultIconIndex = 1 '图标缺省索引
Public Const WM_LBUTTONDOWN = &H201 '按鼠标左键
Public Const WM_RBUTTONDOWN = &H204 '按鼠标右键

Public Const NIM_ADD = 0 '添加图标
Public Const NIM_MODIFY = 1 '修改图标
Public Const NIM_DELETE = 2 '删除图标

Public Const NIF_MESSAGE = 1 'message 有效
Public Const NIF_ICON = 2 '图标操作(添加、修改、删除)有效
Public Const NIF_TIP = 4 'ToolTip(提示)有效

'API函数声明
'图标操作
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'判断窗口是否最小化
Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
'
'设置窗口位置和状态(position)的功能
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) 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 * 64
End Type

'函数定义
'添加图标至通知栏
Public Function Icon_Add(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
 '参数说明:iHwnd:窗口句柄,sTips:当鼠标移到通知栏图标上时显示的提示内容
 'hIcon:图标句柄,IconID:图标Id号
 Dim IconVa As NOTIFYICONDATA
 With IconVa
  .hwnd = iHwnd
  .szTip = sTips + Chr$(0)
  .hIcon = hIcon
  .uID = IconID
  .uCallbackMessage = WM_LBUTTONDOWN
  .cbSize = Len(IconVa)
  .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
  Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)
 End With
End Function
'删除通知栏图标(参数说明同Icon_Add)
Function Icon_Del(iHwnd As Long, lIndex As Long) As Long
 Dim IconVa As NOTIFYICONDATA
 Dim L As Long
 With IconVa
  .hwnd = iHwnd
  .uID = lIndex
  .cbSize = Len(IconVa)
 End With
 Icon_Del = Shell_NotifyIcon(NIM_DELETE, IconVa)
End Function
'修改通知栏图标(参数说明同Icon_Add)
Public Function Icon_Modify(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
 Dim IconVa As NOTIFYICONDATA
 With IconVa
  .hwnd = iHwnd
  .szTip = sTips + Chr$(0)
  .hIcon = hIcon
  .uID = IconID
  .uCallbackMessage = WM_LBUTTONDOWN
  .cbSize = Len(IconVa)
  .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
  Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)
 End With
End Function
----------------------------------------------
以上代码放到模块中
yunfeng007 2003-11-08
  • 打赏
  • 举报
回复
不可能!我的就是2000系统,怎么就能用啊!
射天狼 2003-11-08
  • 打赏
  • 举报
回复
'这个函数没有系统限制!!
Option Explicit

Private 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 Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONUP = &H205
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Dim TrayIcon As NOTIFYICONDATA, bolFlag As Boolean

Private Sub Form_Load()
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = hWnd
TrayIcon.uId = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
TrayIcon.hIcon = Me.Icon
TrayIcon.szTip = "拖盘" & Chr(0)

'在系统栏添加拖盘
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'构造系统拖盘结构
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = Me.hWnd
TrayIcon.uId = vbNull

'删除系统栏的拖盘
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Message As Long

Message = X / Screen.TwipsPerPixelX

'判断鼠标消息,执行不同的功能
Select Case Message
Case WM_LBUTTONDOWN
'点击拖盘
Case WM_RBUTTONUP
SetForegroundWindow Me.hWnd
'按右键弹出菜单
'PopupMenu mnuPopup
End Select
End Sub

Private Sub Timer1_Timer()
bolFlag = Not bolFlag

TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = hWnd
TrayIcon.uId = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
TrayIcon.hIcon = IIf(bolFlag, Me.Icon, Picture1.Picture)
TrayIcon.szTip = "拖盘" & Chr(0)

'在系统栏添加拖盘
Call Shell_NotifyIcon(NIM_MODIFY, TrayIcon)
End Sub
iwzw 2003-11-07
  • 打赏
  • 举报
回复
我电脑里没2000系统,但是我试了同一程序在98和xp下均可实现生成托盘图标。

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧