关于系统托盘的问题。。。

harp 2002-03-29 01:11:59
有源代码否?

可最小化为图标,且对CLICK有反应。。。
...全文
59 6 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
bswangming 2002-03-29
  • 打赏
  • 举报
回复


' *********************************************
' 为托盘中的图标加上浮动提示(也就是鼠标移上去时出现的提示字条)
' *********************************************
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
bswangming 2002-03-29
  • 打赏
  • 举报
回复
'如果是其他类型的消息则传递给原有默认的窗口函数
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)

'知识点滴:HWnd属性
'返回窗体或控件的句柄。语法: object.HWnd
'说明:Microsoft Windows 运行环境,通过给应用程序中的每个窗体和控件
'分配一个句柄(或 hWnd)来标识它们。hWnd 属性用于Windows API调用。

'将主窗体图标添加在托盘中
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
bswangming 2002-03-29
  • 打赏
  • 举报
回复
'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

'---- 其中参数uCallbackMessage、hIcon、szTip也应在模块中声明为以下的常量:
'Public Const NIF_MESSAGE = 1
'Public Const NIF_ICON = 2
'Public Const NIF_TIP = 4

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long


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

'记录 设置托盘图标的数据 的数据类型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

'TheData变量记录设置托盘图标的数据
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
zyl910 2002-03-29
  • 打赏
  • 举报
回复
'Download the full source+pictures+... At http://www.geocities.com/SiliconValley/Campus/3636/trayicon.zip
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 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_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONUP = &H205

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATA
Private Sub Form_Load()
TrayI.cbSize = Len(TrayI)
'Set the window's handle (this will be used to hook the specified window)
TrayI.hWnd = pichook.hWnd
'Application-defined identifier of the taskbar icon
TrayI.uId = 1&
'Set the flags
TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
'Set the callback message
TrayI.ucallbackMessage = WM_LBUTTONDOWN
'Set the picture (must be an icon!)
TrayI.hIcon = imgIcon(2).Picture
'Set the tooltiptext
TrayI.szTip = "Recent" & Chr$(0)
'Create the icon
Shell_NotifyIcon NIM_ADD, TrayI

Me.Hide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'remove the icon
TrayI.cbSize = Len(TrayI)
TrayI.hWnd = pichook.hWnd
TrayI.uId = 1&
Shell_NotifyIcon NIM_DELETE, TrayI
End
End Sub
Private Sub mnuPop_Click(Index As Integer)
Select Case Index
Case 0
MsgBox "KPD-Team 1998" + Chr$(13) + "URL: http://www.allapi.net/" + Chr$(13) + "E-Mail: KPDTeam@Allapi.net", vbInformation + vbOKOnly
Case 2
Unload Me
End Select
End Sub
Private Sub pichook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Msg = X / Screen.TwipsPerPixelX
If Msg = WM_LBUTTONDBLCLK Then
'Left button double click
mnuPop_Click 0
ElseIf Msg = WM_RBUTTONUP Then
'Right button click
Me.PopupMenu mnuPopUp
End If
End Sub
Private Sub Timer1_Timer()
Static Tek As Integer
'Animate the icon
Me.Icon = imgIcon(Tek).Picture
TrayI.hIcon = imgIcon(Tek).Picture
Tek = Tek + 1
If Tek = 3 Then Tek = 0
Shell_NotifyIcon NIM_MODIFY, TrayI
End Sub
zyl910 2002-03-29
  • 打赏
  • 举报
回复
搜索以前的贴子!
combread 2002-03-29
  • 打赏
  • 举报
回复
把你的Mail留下,发源程序给你。

743

社区成员

发帖
与我相关
我的任务
社区描述
VB 版八卦、闲侃,联络感情地盘,禁广告帖、作业帖
社区管理员
  • 非技术类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

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