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

相关文章推荐

MFC程序最小化到通知区域补充

  • 2012年11月20日 14:58
  • 43KB
  • 下载

任务栏通知区域(Tray)图标程序

  • 2014年06月13日 11:40
  • 500KB
  • 下载

MFC程序添加通知区域图标

给MFC程序添加通知区域图标          现在起来越多的程序都有一个通知区域图标(托盘图标),既美观又方便。但是MFC不像C#一样提供NotifyIcon控件,要实现通知区域图标,就...

MFC程序添加通知区域图标

给MFC程序添加通知区域图标          现在起来越多的程序都有一个通知区域图标(托盘图标),既美观又方便。但是MFC不像C#一样提供NotifyIcon控件,要实现通知区域图标,就...

打开第二次VB程序时通知第一次运行的程序并自己关闭的方法

开场白:很多程序,如WINDOWS MEDIA PLAYER,在程序第二次打开,第一次的程序并未关闭时,会自动激活第一次运行的程序,而且会自动把选取的音乐添加到第一次的那个程序的播放列表里,这是如何作...

SharePoint2010:使用通知和状态栏区域动态显示信息

新版本的SharePoint带来了很多新的酷的功能,你可能特别想学。其中一个是通过在状态栏和通知区域显示信息给用户,使用户体验更有趣。...

通知区域 历史记录清除

  • 2010年05月20日 22:27
  • 12KB
  • 下载

系统通知区域的箭头恢复

  • 2009年04月06日 12:35
  • 6KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB程序启动后如何在通知区域显示
举报原因:
原因补充:

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