mdlnotify.bas

mp3播放器软件

Attribute VB_Name = "mdlNotify"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&模 块 名：mdlNotify
'&&创 建 人：加了些东西,可以在explorer崩溃后重新建立
'&&日    期：2007-09-23 14:08:06
'&&描    述：
'&&版    本：V1.0.0
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WM_RBUTTONUP = &H205
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_USER = &H400
Private Const WM_NOTIFYICON = WM_USER + 1            ' 自定义消息

Public Const WM_SIZE As Integer = &H5
Public Const WM_QUERYENDSESSION As Integer = &H11
Public Const SIZE_MINIMIZED As Integer = 1
Public bEnd As Boolean '是否可以关闭


Private Const GWL_WNDPROC = (-4)
' 关于气球提示的自定义消息, 2000下不产生这些消息
Private Const NIN_BALLOONSHOW = (WM_USER + &H2)      ' 当 Balloon Tips 弹出时执行
Private Const NIN_BALLOONHIDE = (WM_USER + &H3)      ' 当 Balloon Tips 消失时执行（如 SysTrayIcon 被删除），
                                                    ' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息
Private Const NIN_BALLOONTIMEOUT = (WM_USER + &H4)   ' 当 Balloon Tips 的 TimeOut 时间到时执行
Private Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。
                                                    ' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮,
                                                    ' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Type NOTIFYICONDATA
    cbSize As Long              ' 结构大小(字节)
    hwnd As Long                ' 处理消息的窗口的句柄
    uId As Long                 ' 唯一的标识符
    uFlags As Long              ' Flags
    uCallBackMessage As Long    ' 处理消息的窗口接收的消息
    hIcon As Long               ' 托盘图标句柄
    szTip As String * 128       ' Tooltip 提示文本
    dwState As Long             ' 托盘图标状态
    dwStateMask As Long         ' 状态掩码
    szInfo As String * 256      ' 气球提示文本
    uTimeoutOrVersion As Long   ' 气球提示消失时间或版本
                                ' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000)
                                ' uVersion - 版本(0 for V4, 3 for V5)
    szInfoTitle As String * 64  ' 气球提示标题
    dwInfoFlags As Long         ' 气球提示图标
End Type
' dwState to NOTIFYICONDATA structure
Private Const NIS_HIDDEN = &H1              ' 隐藏图标
Private Const NIS_SHAREDICON = &H2          ' 共享图标
' dwInfoFlags to NOTIFIICONDATA structure
Public Enum InfoFlags
        NIIF_NONE = &H0 ' 无图标
        NIIF_INFO = &H1 ' "消息"图标
        NIIF_WARNING = &H2 ' "警告"图标
        NIIF_ERROR = &H3 ' "错误"图标
End Enum

' uFlags to NOTIFYICONDATA structure
Private Const NIF_ICON As Long = &H2
Private Const NIF_INFO As Long = &H10
Private Const NIF_MESSAGE As Long = &H1
Private Const NIF_STATE As Long = &H8
Private Const NIF_TIP As Long = &H4
' dwMessage to Shell_NotifyIcon
Private Const NIM_ADD As Long = &H0
Private Const NIM_DELETE As Long = &H2
Private Const NIM_MODIFY As Long = &H1
Private Const NIM_SETFOCUS As Long = &H3
Private Const lngNIM_SETVERSION As Long = &H4

Private IconData As NOTIFYICONDATA
Private lngPreWndProc As Long
Private MsgTaskbarRestart As Long
Private bTaskbarRestart As Boolean
Private Frm As Form
Private MenuL As Menu
Private MenuR As Menu




'*************************************************************************
'**函 数 名：ShowNotifyIcon
'**输    入：frForm(Form) (主窗体)                           -
'**        ：Optional mnuMenuL(Menu = Nothing)(是否有左菜单,有则写名字,无则留空)       -
'**        ：Optional mnuMenuR(Menu = Nothing)(是否有右菜单)       -
'**        ：Optional bShowTip(Boolean = False)(是否有气泡提示,默认无)      -
'**        ：Optional strTitle(String = "")(气泡提示标题,默认空)          -
'**        ：Optional strInfo(String = "")气泡提示文字,默认空           -
'**        ：Optional lngType(InfoFlags = NIIF_NONE)气泡提示图标类型 -
'**        ：Optional lngTime(Long = 15000) 气泡提示时间,大于15S         -
'**输    出：无
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：希望
'**日    期：2007-09-23 14:09:22
'**版    本：V1.0.0
'*************************************************************************
Public Sub ShowNotifyIcon(frForm As Form, _
                            Optional mnuMenuL As Menu = Nothing, _
                            Optional mnuMenuR As Menu = Nothing, _
                            Optional bShowTip As Boolean = False, _
                            Optional strTitle As String = "", _
                            Optional strInfo As String = "", _
                            Optional lngType As InfoFlags = NIIF_NONE, _
                            Optional lngTime As Long = 15000)
    
    
    strTitle = strTitle & vbNullChar
    strInfo = strInfo & vbNullChar
    
    With IconData
        .cbSize = Len(IconData)
        .hwnd = frForm.hwnd
        .uId = 0
        .uFlags = IIf(bShowTip = False, NIF_ICON Or NIF_TIP Or NIF_MESSAGE, NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE)
        .uCallBackMessage = WM_NOTIFYICON
        .szTip = strTitle
        .hIcon = frForm.Icon.Handle
        .dwState = 0
        .dwStateMask = 0
        .szInfo = strInfo
        .szInfoTitle = strTitle
        .dwInfoFlags = lngType
        .uTimeoutOrVersion = lngTime
    End With
    
    If lngPreWndProc = 0 Then    '没有初始化
       Set Frm = frForm
       If Not mnuMenuL Is Nothing Then Set MenuL = mnuMenuL
       If Not mnuMenuR Is Nothing Then Set MenuR = mnuMenuR
       Shell_NotifyIcon NIM_ADD, IconData
       MsgTaskbarRestart = RegisterWindowMessage("TaskbarCreated")
       lngPreWndProc = SetWindowLong(Frm.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    Else                      '已初始化
      If bTaskbarRestart = True Then
        Shell_NotifyIcon NIM_ADD, IconData
        bTaskbarRestart = False
      Else
        Shell_NotifyIcon NIM_MODIFY, IconData
      End If
    End If
    
End Sub

Public Sub DelNotifyIcon()
    If lngPreWndProc <> 0 Then
        Dim IconData As NOTIFYICONDATA
        With IconData
            .cbSize = Len(IconData)
            .hwnd = Frm.hwnd
            .uId = 0
            .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE
            .uCallBackMessage = WM_NOTIFYICON
            .szTip = ""
            .hIcon = Frm.Icon.Handle
        End With
        Shell_NotifyIcon NIM_DELETE, IconData
        SetWindowLong Frm.hwnd, GWL_WNDPROC, lngPreWndProc
        lngPreWndProc = 0
    End If
End Sub


Public Sub SetTrayIcon(picIcon As Picture)
    If picIcon.Type <> vbPicTypeIcon Then Exit Sub
    With IconData
        .hIcon = picIcon.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, IconData
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo ERRHAND
    If MSG = WM_NOTIFYICON Then
        Select Case lParam
            Case WM_LBUTTONUP
                 If Not MenuL Is Nothing Then
                    SetForegroundWindow Frm.hwnd
                    Frm.PopupMenu MenuL
                 End If
            Case WM_RBUTTONUP
                 If Not MenuR Is Nothing Then
                    SetForegroundWindow Frm.hwnd
                    Frm.PopupMenu MenuR
                End If
            Case WM_LBUTTONDBLCLK
                 Frm.Visible = Not Frm.Visible
                 If Frm.Visible = True Then
                 SetForegroundWindow Frm.hwnd
                 Frm.WindowState = 0
                 Frm.SetFocus
                 End If
            Case NIN_BALLOONSHOW
                'Debug.Print "显示气球提示"
            Case NIN_BALLOONHIDE
                'Debug.Print "删除托盘图标"
            Case NIN_BALLOONTIMEOUT
                'Debug.Print "气球提示消失"
            Case NIN_BALLOONUSERCLICK
                'Debug.Print "单击气球提示"
        End Select
    ElseIf MSG = WM_SIZE Then
        If wParam = SIZE_MINIMIZED Then Frm.Visible = False
    ElseIf MSG = WM_QUERYENDSESSION Then '拦截到关机信息
        bEnd = True
    End If
    If MSG = MsgTaskbarRestart Then
        bTaskbarRestart = True
        'ShowNotifyIcon Frm, MenuL, MenuR, True, ".0", "Explorer崩溃，现在重建托盘", NIIF_ERROR, 5000
        Exit Function
    End If
    WindowProc = CallWindowProc(lngPreWndProc, hwnd, MSG, wParam, lParam)
Exit Function
ERRHAND:
MsgBox Err.Description
End Function