标题: VB6.0实现托盘图标示例
作者: dnawo
日期: 2009-10-14 11:07 AM
分类: Win编程
内容: 打开菜单编辑器，添加下边菜单项：
1). 添加模块Tray.bas：
复制内容到剪贴板 程序代码Option Explicit
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'记录 设置托盘图标的数据 的数据类型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 * 64
End Type
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_Delete = &H2
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Private TheData As NOTIFYICONDATA
' *********************************************
' 新的窗口过程--主程序中采用SetWindowLong函数改变了窗口函数的地址，消息转向由NewWindowProc处理
' *********************************************
Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果用户点击了托盘中的图标，则进行判断是点击了左键还是右键
If Msg = TRAY_CALLBACK Then
'如果点击了左键
If lParam = WM_LBUTTONUP Then
'而这时窗体的状态是最小化时
If TheForm.WindowState = vbMinimized Then _
'恢复到最小化前的窗体状态
TheForm.WindowState = TheForm.LastState
TheForm.SetFocus
Exit Function
End If
End If
'如果点击了右键
If lParam = WM_RBUTTONUP Then
'则弹出右键菜单
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
'如果是其他类型的消息则传递给原有默认的窗口函数
NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)
End Function
' *********************************************
' 把主窗体的图标（Form1.icon属性可改变）添加到托盘中
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
'保存当前窗体和菜单信息
Set TheForm = frm
Set TheMenu = mnu
'GWL_WNDPROC获得该窗口的窗口函数的地址
OldWindowProc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
'将主窗体图标添加在托盘中
With TheData
.Uid = 0 '忘了吗？参考一下前面内容,Uid图标的序号，做动画图标有用
.HWnd = frm.HWnd
.cbSize = Len(TheData)
.HIcon = frm.Icon.Handle
.UFlags = NIF_ICON '指明要对图标进行设置
.UCallbackMessage = TRAY_CALLBACK
.UFlags = .UFlags or NIF_MESSAGE '指明要设置图标或返回信息给主窗体，此句不能省去
.cbSize = Len(TheData) '为什么呢？我们需要在添加图标的同时，让其返回信息
End With '给主窗体，Or的意思是同时进行设置和返回消息
Shell_NotifyIcon NIM_ADD, TheData '根据前面定义NIM_ADD，设置为“添加模式”
End Sub
' *********************************************
' 删除系统托盘中的图标
' *********************************************
Public Sub RemoveFromTray()
'删除托盘中的图标
With TheData
.UFlags = 0
End With
Shell_NotifyIcon NIM_Delete, TheData '根据前面定义NIM_Delete，设置为“删除模式”
'恢复原有的设置
SetWindowLong TheForm.HWnd, GWL_WNDPROC, OldWindowProc
End Sub
' *********************************************
' 为托盘中的图标加上浮动提示（也就是鼠标移上去时出现的提示字条）
' *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.SzTip = tip & vbNullChar
.UFlags = NIF_TIP '指明要对浮动提示进行设置
End With
Shell_NotifyIcon NIM_MODIFY, TheData '根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub
' *********************************************
' 设置托盘的图标（在本例中没有用到，如果要动态改变托盘内显示的图标，它非常有用）
' 例如：1、显示动画图标（方法你一定猜到了，对！使用Timer控件，不断调用此过程，注意把动画放在pic数组中）
' 2、程序处于不同状态时，显示不同的图标，方法是类似的
' 有兴趣的话试一试吧。
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
'判断一下pic中存放的是不是图标
If pic.Type <> vbPicTypeIcon Then Exit Sub
'更换图标为pic中存放的图标
With TheData
.HIcon = pic.Handle
.UFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
2).窗体代码：
复制内容到剪贴板 程序代码Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const SC_RESTORE = &HF120&
Private Const SC_SIZE = &HF000&
Public LastState As Integer
Private Sub Form_Load()
'窗体的WindowState属性，返回或设置一个值，该值用来指定在运行时窗体窗口的可视状态
'vbNormal 0 （缺省值）正常 。
'VbMinimized 1 最小化（最小化为一个图标）
'VbMaximized 2 最大化（扩大到最大尺寸）
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If
AddToTray Me, mnuTray '将图标添加到托盘的函数
SetTrayTip "鼠标移到托盘图标就看到我了^_^"
End Sub
'在主窗体Form1大小改变时，相应改变右键菜单mnuTray的菜单项的可用属性Enabled
Private Sub Form_Resize()
Select Case WindowState
'如果窗体最小化了，把菜单项“最大化”“恢复”设为可用，
'而把“最小化”“移动”“大小”三项设为不可用.
'如果这时在托盘图标上点击鼠标右键，会发现不可用项变为灰色
Case vbMinimized
mnuTrayMaximize.Enabled = True
mnuTrayMinimize.Enabled = False
mnuTrayMove.Enabled = False
mnuTrayRestore.Enabled = True
mnuTraySize.Enabled = False
'窗体最大化时
Case vbMaximized
mnuTrayMaximize.Enabled = False
mnuTrayMinimize.Enabled = True
mnuTrayMove.Enabled = False
mnuTrayRestore.Enabled = True
mnuTraySize.Enabled = False
'一般状态下
Case vbNormal
mnuTrayMaximize.Enabled = True
mnuTrayMinimize.Enabled = True
mnuTrayMove.Enabled = True
mnuTrayRestore.Enabled = False
mnuTraySize.Enabled = True
End Select
If WindowState <> vbMinimized Then LastState = WindowState
End Sub
'保证在程序退出时删除托盘图标
Private Sub Form_Unload(Cancel As Integer)
RemoveFromTray
End Sub
'“文件”菜单的“退出”项被点击时
Private Sub mnuFileExit_Click()
Unload Me
End Sub
'托盘图标右键菜单上的“退出”项被点击时
Private Sub mnuTrayClose_Click()
Unload Me
End Sub
'托盘图标右键菜单上的“最大化”项被点击时
Private Sub mnuTrayMaximize_Click()
WindowState = vbMaximized
End Sub
'托盘图标右键菜单上的“最小化”项被点击时
Private Sub mnuTrayMinimize_Click()
WindowState = vbMinimized
End Sub
'托盘图标右键菜单上的“移动”项被点击时
Private Sub mnuTrayMove_Click()
SendMessage HWnd, WM_SYSCOMMAND, SC_MOVE, 0&
End Sub
'托盘图标右键菜单上的“恢复”项被点击时
Private Sub mnuTrayRestore_Click()
SendMessage HWnd, WM_SYSCOMMAND, SC_RESTORE, 0&
End Sub
'托盘图标右键菜单上的“退出”项被点击时
Private Sub mnuTraySize_Click()
SendMessage HWnd, WM_SYSCOMMAND, SC_SIZE, 0&
End Sub
运行即可看到效果！
+ 查看当前日志评论 (0)
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.076 ms
标题: VB6.0实现托盘图标示例
你没有权限发表评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.076 ms
暂无评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.076 ms