VB程序启动后如何在通知区域显示

转载 2005年03月02日 17:49:00

'语言:Micrisift Visual Basic 6.0
'功能:向系统托盘区添加图标
'作者:黄旭东
'日期:2004-10-22
'版权:CopyRight 2001-2005 By Faib Studio
'网址:http://faib.yeah.net
'邮件:faib920@163.com

Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const GWL_USERDATA = (-21)
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 NIF_INFO = &H10
Private Const NIIF_NONE = &H0
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_INFO = &H1

Private Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutOrVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type

Public Enum EnumTrayEvent
    fbmNone = &H0
    fbmOnLButtonUp = &H1
    fbmOnRButtonUp = &H2
    fbmOnMButtonUp = &H4
    fbmOnLButtonDown = &H8
    fbmOnRButtonDown = &H10
    fbmOnMButtonDown = &H20
    fbmOnLButtonDbClick = &H40
    fbmOnRButtonDbClick = &H80
    fbmOnMButtonDbClick = &H100
    fbmOnAllClickEvents = &H1FF
End Enum
Public Enum EnumTrayMessage
    fbmMouseMove = &H200
    fbmLButtonDown = &H201
    fbmLButtonUp = &H202
    fbmLButtonDbClick = &H203
    fbmRButtonDown = &H204
    fbmRButtonUp = &H205
    fbmRButtonDbClick = &H206
    fbmMButtonDown = &H207
    fbmMButtonUp = &H208
    fbmMButtonDbClick = &H209
End Enum
Enum EnumTitleIcon
   fbiNone = 0
   fbiInfo = 1
   fbiWarning = 2
   fbiError = 3
End Enum

Dim sIcon As StdPicture
Dim sVis As Boolean
Dim sForm As Form
Dim sMenu As Menu
Dim shWnd As Long
Dim sTip As String
Dim sStyle As EnumTrayEvent
Dim nTray As NOTIFYICONDATA
Dim proWnd As Long
Dim mHook As Long
Dim mVis As Boolean

Public Property Let HookAddress(ByVal NewVal As Long)
'hook地址
    mHook = NewVal
End Property

Public Property Get PopupStyle() As EnumTrayEvent
'返回/设置托盘菜单的动作模式
    PopupStyle = sStyle
End Property

Public Property Let PopupStyle(NewVal As EnumTrayEvent)
    sStyle = NewVal
End Property

Public Property Get Icon() As StdPicture
'图标
    Set Icon = sIcon
End Property

Public Property Set Icon(NewVal As StdPicture)
    If sIcon Is Nothing Then
        Set sIcon = NewVal
    Else
        If Not NewVal Is sIcon Then Set sIcon = NewVal
    End If
    If Not sVis Then Exit Property '如果没有显示则退出,否则修改图标
    Modify "Icon"
End Property

Public Property Get TrayForm() As Form
'主窗体
    Set TrayForm = sForm
End Property

Public Property Set TrayForm(NewVal As Form)
    If sForm Is Nothing Then
        Set sForm = NewVal
    Else
        If Not NewVal Is sForm Then Set sForm = NewVal
    End If
End Property

Public Property Get PopupMenu() As Menu
'弹出菜单
    Set PopupMenu = sMenu
End Property


Public Property Set PopupMenu(NewVal As Menu)
    If sMenu Is Nothing Then
        Set sMenu = NewVal
    Else
        If Not sMenu Is sMenu Then Set sMenu = NewVal
    End If
End Property

Public Property Get TipText() As String
'提示信息
    TipText = sTip
End Property

Public Property Let TipText(NewVal As String)
    sTip = NewVal
    If Not sVis Then Exit Property '如果没有显示则退出,否则修改提示信息
    Modify "Tip"
End Property

Public Property Get Visible() As Boolean
'是否显示
    Visible = sVis
End Property

Public Property Let Visible(NewVal As Boolean)
    If NewVal = sVis Then Exit Property '如果设置相同则退出
    sVis = NewVal
    If NewVal Then Show Else Hide
End Property

Public Sub Show() '显示
    If mVis Then Exit Sub
    With nTray
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .cbSize = Len(nTray)
        .hWnd = sForm.hWnd
        .uId = vbNull
        .uCallBackMessage = fbmMouseMove
        .hIcon = sIcon.Handle
        .szTip = sTip & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, nTray
    proWnd = SetWindowLong(sForm.hWnd, GWL_WNDPROC, AddressOf Wndproc)
    mVis = True: sVis = True
End Sub

Public Sub Hide() '移除
    If Not mVis Then Exit Sub
    SetWindowLong sForm.hWnd, GWL_WNDPROC, proWnd
    Shell_NotifyIcon NIM_DELETE, nTray
    mVis = False: sVis = False
End Sub

Public Sub ShowMessage(Title As String, Message As String, Optional TitleIcon As EnumTitleIcon = 0, Optional TimeOut As Long = 500)
    If Not sVis Then Exit Sub
    With nTray
        .uFlags = NIF_INFO Or NIF_MESSAGE
        .dwInfoFlags = NIIF_INFO
        .dwState = 0
        .hIcon = TitleIcon
        .dwStateMask = 0
        .szInfo = Message & vbNullChar
        .uTimeoutOrVersion = TimeOut
        .szInfoTitle = Title & vbNullChar
    End With
    Shell_NotifyIcon NIM_MODIFY, nTray
End Sub

Private Function Wndproc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If Msg = fbmMouseMove Then
        Select Case lParam
        Case &H2
            Call Hide: Set sForm = Nothing: Set sIcon = Nothing
        Case fbmLButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonDbClick) Then Popup
        Case fbmLButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonDown) Then Popup
        Case fbmLButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonUp) Then Popup
        Case fbmMButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonDbClick) Then Popup
        Case fbmMButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonDown) Then Popup
        Case fbmMButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonUp) Then Popup
        Case fbmRButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonDbClick) Then Popup
        Case fbmRButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonDown) Then Popup
        Case fbmRButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonUp) Then Popup
        Case fbmMouseMove
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
        End Select
    End If
    Wndproc = CallWindowProc(proWnd, hWnd, Msg, wParam, lParam)
End Function

Private Sub Modify(s As String)
    With nTray
        Select Case s
        Case "Icon"
            .hIcon = sIcon.Handle
            .uFlags = NIF_ICON
        Case "Tip"
            .uFlags = NIF_TIP
            .szTip = sTip & vbNullChar
        End Select
    End With
    Shell_NotifyIcon NIM_MODIFY, nTray
End Sub

Private Sub Popup()
'弹出菜单
    SetForegroundWindow sForm.hWnd
    sForm.PopupMenu sMenu
End Sub

VB程序启动后如何在通知区域显示

语言:Micrisift Visual Basic 6.0功能:向系统托盘区添加图标作者:黄旭东日期:2004-10-22版权:CopyRight 2001-2005 By Faib Studio网址...
  • vbcrack
  • vbcrack
  • 2005年03月02日 17:38
  • 1002

本地网络连接——已选“连接后在通知区域显示图标”却不显示

今天课上有一位同事跟我提到他电脑上的“本地网络连接”图标不见了,我很自然的问他有没有在属性页上选中“连接后在通知区域显示图标”。他说他选了,他已经为选了还不出现图标苦恼很久了。根据这位先生的描述,这个...
  • gracexu
  • gracexu
  • 2007年05月30日 23:52
  • 12427

windows系统通知区域编程(SystemTray or NotificationIcon)

最近有个VC程序急切希望具有windows 通知区域图标的功能,从CSDN上参考了几篇文章,但改的效果并不是很理想,于是自己开始思考此问题,并找到源自MS的例子源码。     在MSDN中查找She...
  • tumin999
  • tumin999
  • 2014年12月03日 11:21
  • 758

vs调试补遗

讲完Visual Studio调试之断点技巧篇以后,翻翻以前看得一些资料和自己写的一些文章,发现还有几个关于中断程序的技巧在前面的文章里面遗漏了,决定还是在这里总结一下。当然啦,如果你知道这些技巧,忽...
  • Steven_ssm
  • Steven_ssm
  • 2017年08月18日 08:17
  • 79

通过服务+广播+通知实现的一个通知栏音乐控制器

之前的一段时间在学习服务和广播这两个知识点,然后在网上看到一些对于后台操作需要通过服务与广播的一些例子,便索性做一个小demo对这些知识点进行巩固;通过服务+广播+通知对后台音乐进行播放、暂停、停止这...
  • li527425
  • li527425
  • 2017年10月15日 17:08
  • 254

VBA - Excel编程概念之:【单元格和区域】一、如何引用单元格和区域

使用 Visual Basic 的普通任务是指定单元格或单元格区域,然后对该单元格或单元格区域进行一些操作,如输入公式或更改格式。通常用一条语句就能完成操作,该语句可标识单元格,还可更改某个属性或应用...
  • LeosHope
  • LeosHope
  • 2007年06月16日 12:06
  • 4485

多个图标集于一张背景图片在网页上显示指定区域

早就发现了。。很多大一点的门户里面用的一些背景图都是一个页面只有一张背景图。。所有要用的图标全都放到一张图里面。开始想应该是用位置来控制的,但自己在做网页的时候位置太难调了一直没去实现。。今天在网上找...
  • zxcdhm
  • zxcdhm
  • 2013年04月24日 21:50
  • 1746

给MFC程序添加通知区域图标

给MFC程序添加通知区域图标        现在起来越多的程序都有一个通知区域图标(托盘图标),既美观又方便。但是MFC不像C#一样提供NotifyIcon控件,要实现通知区域图标,就要自己做一个CT...
  • sijingyijun
  • sijingyijun
  • 2011年07月11日 23:24
  • 1435

Android8.1_SystemUI_通知中心原生BUG处理

1/16 $
  • QrowWong
  • QrowWong
  • 2018年01月16日 13:34
  • 58

C#程序从32位系统迁移到64位系统的问题

前段用C#做了个程序,现在要把程序支持64位系统。 首先是把该程序支持到 Windows Server 2003 和 Windows Server 2008两个系统,由于我的程序是在XP上测...
  • wwwgeyang777
  • wwwgeyang777
  • 2011年12月09日 09:45
  • 5840
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB程序启动后如何在通知区域显示
举报原因:
原因补充:

(最多只允许输入30个字)