vb托盘代码(vb托盘图标)
admin 发布:2022-12-19 21:56 118
今天给各位分享vb托盘代码的知识,其中也会对vb托盘图标进行解释,如果能碰巧解决你现在面临的问题,别忘了关注本站,现在开始吧!
本文目录一览:
VB中实现托盘功能
在Form中制作一个菜单,在窗体上点右键-菜单编辑器,标题随便,名称“F00”(不含引号,下同),去掉“可见”前的勾,“下一个”,标题“打开”,名称“F01”,点“右箭头”,“下一个”,标题退出,名称“F02”,点“右箭头”,“确定”
以下是代码,效果是程序运行时不显示在托盘中图标,点最小化后显示在托盘图标并且不在任务栏中显示窗口,双击图标打开窗口,右键点图标弹出菜单
'-----------------------窗体中--------------------------
Dim WindowTop, WindowLeft
Function WindowStyle()
'以下把程序放入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 = "已最小化到托盘" vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Function
Private Sub Form_Resize()
WindowTop = Me.Top
WindowLeft = Me.Left
If Me.WindowState = 1 Then
WindowStyle
End If
End Sub
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_LBUTTONDBLCLK '双击左键显示窗体,要改成其他的看模块里的定义
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
'Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
Me.SetFocus
Case WM_RBUTTONUP '在托盘图标上点右键显示菜单
PopupMenu F00 '菜单名称为F00,做菜单时你可以改成别的,这里也得改成相应的
End Select
End Sub
Private Sub F01_Click()
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub F02_Click()
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'退出程序时删除托盘图标
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
'-----------------------模块中--------------------------
'在系统托盘显示图标的模块
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
vb 托盘程序
Form1 的VB代码
Private bIsQuit As Boolean
Private Sub Form_Load()
bIsQuit = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not bIsQuit Then
Dim rc As Long
Dim OwnerhWnd As Long
' 让窗体不可见
Me.Visible = False
' 从任务管理器列表中移除
OwnerhWnd = GetWindow(Me.HWnd, GW_OWNER)
rc = ShowWindow(OwnerhWnd, SW_HIDE)
Call Icon_Add(Form1, Me.topmenu, Me.Timer1, Me.HWnd, "ICON Test", Me.Icon, 0)
Cancel = 1
Else
Cancel = 0
End If
End Sub
Private Sub mnuQuit_Click()
bIsQuit = True
Call Icon_Del(Me.HWnd, 0) '删除通知栏图标
Unload Me
End Sub
Private Sub mnuShow_Click()
Call Icon_Del(Me.HWnd, 0) '删除通知栏图标
Me.Show '调出窗口
Me.WindowState = 0
End Sub
Private Sub Timer1_Timer()
Call Common.procesSD
End Sub
Common模块代码
'Window消息处理函数,目的是: 窗口最小化到托盘时,程序自己处理消息
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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'点击X时,最小化到托盘
Public Const SW_HIDE = 0
Public Const GW_OWNER = 4
Declare Function GetWindow Lib "user32" (ByVal HWnd As Long, ByVal wCmd As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal HWnd As Long, ByVal nCmdShow As Long) As Long
'添加、删除、更改托盘图标 Windows API
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const DefaultIconIndex = 1 '图标缺省索引
Public Const WM_LBUTTONDOWN = H201 '按鼠标左键
Public Const WM_RBUTTONDOWN = H204 '按鼠标右键
Public Const WM_LBUTTONDBLCLK = H203 '双击左键
Public Const WM_USER = H400
Public Const TRAY_CALLBACK = (WM_USER + 1001)
Public Const GWL_WNDPROC = (-4)
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(提示)有效
Type NOTIFYICONDATA
cbSize As Long '需填入NOTIFYICONDATA数据结构的长度
HWnd As Long '设置成窗口的句柄
Uid As Long '为图标所设置的ID值
UFlags As Long '设置uCallbackMessage,hIcon,szTip是否有效
UCallbackMessage As Long '消息编号
hIcon As Long '显示在状态栏上的图标
SzTip As String * 64 '提示信息
End Type
'声明上述类型的对象
Private IconVa As NOTIFYICONDATA
'声明获取处理Windows 消息前的window句柄
Public OldWindowProc As Long
'判断单击,双击的两个标志
Private bIsSingle As Boolean
Private bIsDouble As Boolean
'声明主窗体,右键菜单和时钟,这里的时钟是为了区分单双击左键,显得比较笨拙
Private frmMain As Form
Private topmenu As Menu
Private timMain As Timer
'函数定义
'添加图标至通知栏
Public Function Icon_Add(frmParent As Form, mnuParent As Menu, timParent As Timer, iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
'参数说明:iHwnd:窗口句柄,sTips:当鼠标移到通知栏图标上时显示的提示内容
'hIcon:图标句柄,IconID:图标Id号
'初始化控件成员
Set frmMain = frmParent
Set topmenu = mnuParent
Set timMain = timParent
With IconVa
.HWnd = iHwnd
.SzTip = sTips + Chr$(0)
.hIcon = hIcon
.Uid = IconID
.UCallbackMessage = TRAY_CALLBACK
.cbSize = Len(IconVa)
.UFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
End With
'获得让程序处理事件的权利
OldWindowProc = SetWindowLong(iHwnd, GWL_WNDPROC, AddressOf NewWindowProc)
'初始化单双击的判别标志
bIsSingle = False
bIsDouble = False
'初始化时钟
timMain.Enabled = True
timMain.Interval = 500
Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)
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
'当图标从托盘删除后,关闭时钟,不在监视单双击事件
timMain.Enabled = True
'让操作系统处理消息
SetWindowLong iHwnd, GWL_WNDPROC, OldWindowProc
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 = TRAY_CALLBACK
.cbSize = Len(IconVa)
.UFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
End With
Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)
End Function
'程序处理Windows传递的消息
Public Static 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_RBUTTONDOWN Then
'则弹出右键菜单
frmMain.PopupMenu topmenu
Exit Function
End If
'如果双击左键
If lParam = WM_LBUTTONDBLCLK Then
bIsDouble = True
bIsSingle = False
Exit Function
End If
'如果点击了左键
If lParam = WM_LBUTTONDOWN Then
bIsSingle = True
bIsDouble = False
Exit Function
End If
End If
'如果是其他类型的消息则传递给原有默认的窗口函数
NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)
End Function
'被时钟调用,来区分单击,还是双击,以及事件处理内容
Public Sub procesSD()
'如果是双击,就恢复窗口,并把图标从托盘删除
If bIsDouble Then
Call Icon_Del(frmMain.HWnd, 0) '删除通知栏图标
frmMain.Show '调出窗口
frmMain.WindowState = 0
frmMain.SetFocus
ElseIf bIsSingle Then
'如果是单击,就弹出左键菜单
frmMain.PopupMenu topmenu
End If
'恢复单双击判断的标志
bIsSingle = False
bIsDouble = False
End Sub
vb如何让当程序最小化时最小化到托盘 急!!!
最小化的事件在resize中判断即可,这时窗口的WindowState属性是1
Private Sub Form_Resize()
If Me.WindowState = 1 Then “到托盘去”
End Sub
在设计阶段,把窗体的WindowState属性改为0或2,可能是这里被你改为1,所以一启动就最小化了。
VB托盘代码问题
原因分析:气泡响应的信息已经注入,不清除将无法覆盖
处理方法:删除原来的气泡,再传递新的值
'在这段加一行代码 XP +VB6 测试通过
Private Sub Form_Unload(Cancel As Integer)
Dim ky
If Check1.Value = 1 Then
ky = "111111111111" vbNullChar
Else
ky = "22222222" vbNullChar
End If
'===================下面是关键========================
Shell_NotifyIcon NIM_DELETE, nfIconData
'===================上面是关键========================
Cancel = 1
nfIconData.cbSize = Len(nfIconData)
nfIconData.uID = vbNull
nfIconData.hwnd = Me.hwnd
nfIconData.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
nfIconData.uCallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Me.Icon
nfIconData.szTip = ky vbNullChar
Shell_NotifyIcon NIM_ADD, nfIconData
Me.Hide
有疑问或测试不成功 请留言
vb托盘代码的介绍就聊到这里吧,感谢你花时间阅读本站内容,更多关于vb托盘图标、vb托盘代码的信息别忘了在本站进行查找喔。
版权说明:如非注明,本站文章均为 AH站长 原创,转载请注明出处和附带本文链接;
相关推荐
- 05-09网页代码,网页代码快捷键
- 05-06单页网站的代码(完整的网页代码)[20240506更新]
- 05-06个人主页图片代码(个人主页图片代码怎么弄)[20240506更新]
- 05-06提取微信名片代码(微信名片信息提取)[20240506更新]
- 05-06php后台权限管理代码(php管理员权限)[20240506更新]
- 05-06付费观看代码php(付费观看代码)[20240506更新]
- 05-06在线html执行代码(html怎么运行)[20240506更新]
- 05-06源代码管理资源管理器(资源管理器运行代码)[20240506更新]
- 05-06代码源软件库(程序代码库)[20240506更新]
- 05-06点击弹出密码代码(点击弹出密码代码错误)[20240506更新]
取消回复欢迎 你 发表评论:
- 标签列表
- 最近发表
- 友情链接