modsystray.bas

这个源代码主要模仿了一个类似 深度操作系统安装程序中的一个软件自动安装管理器AutoIt v3

Attribute VB_Name = "modSystray"


    Option Explicit
    'Shell 调用，如 HTML 文件, Mail 和网页
    Public Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

    'API 函数声明
    Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
    Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    
        Public 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
            uTimeout                           As Long
            szInfoTitle                        As String * 64
            dwInfoFlags                        As Long
        End Type

    Public multiTip                            As Boolean ' shell32.dll 版本 5, 运行多气泡提示
    Public blnClick                            As Boolean
    Public vbTray                              As NOTIFYICONDATA

    Public Const SWP_NOMOVE                    As Long = &H2
    Public Const SWP_NOSIZE                    As Long = &H1
    Public Const FLAGS                         As Long = SWP_NOMOVE Or SWP_NOSIZE
    Public Const WM_RBUTTONUP                  As Long = &H205
    Public Const WM_RBUTTONCLK                 As Long = &H204
    Public Const WM_LBUTTONCLK                 As Long = &H202
    Public Const WM_LBUTTONDBLCLK              As Long = &H203
    Public Const WM_MOUSEMOVE                  As Long = &H200
    Public Const NIM_ADD                       As Long = &H0
    Public Const NIM_DELETE                    As Long = &H2
    Public Const NIF_ICON                      As Long = &H2
    Public Const NIF_MESSAGE                   As Long = &H1
    Public Const NIM_MODIFY                    As Long = &H1
    Public Const NIM_SETVERSION                As Long = &H4
    Public Const NIF_TIP                       As Long = &H4
    Public Const NIF_INFO                      As Long = &H10
    Public Const NIS_HIDDEN                    As Long = &H1
    Public Const NIS_SHAREDICON                As Long = &H2
    Public Const NIIF_NONE                     As Long = &H0
    Public Const NIIF_WARNING                  As Long = &H2
    Public Const NIIF_ERROR                    As Long = &H3
    Public Const NIIF_INFO                     As Long = &H1
    Public Const NIIF_GUID                     As Long = &H4 'Shell32.dll 版本 6 (WinXP SP2)，支持真彩色图标
    Public Const HWND_NOTOPMOST                As Long = -2
    Public Const HWND_TOPMOST                  As Long = -1
    Public Const NOTIFYICON_VERSION            As Long = 3


'添加托盘图标
Public Sub SystrayOn(frm As Form, IconTooltipText As String)

    With vbTray
        .cbSize = Len(vbTray)
        .hWnd = frm.hWnd
        .uID = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallbackMessage = WM_MOUSEMOVE
        .szTip = Trim$(IconTooltipText$) & vbNullChar
        .hIcon = frm.Icon
    End With

    Call Shell_NotifyIcon(NIM_ADD, vbTray)
    App.TaskVisible = False

End Sub

'从图盘移除图标
Public Sub SystrayOff(frm As Form)
    With vbTray
        .cbSize = Len(vbTray)
        .hWnd = frm.hWnd
        .uID = vbNull
    End With

    Call Shell_NotifyIcon(NIM_DELETE, vbTray)

End Sub

'更改托盘气泡提示文字
Public Sub ChangeSystrayToolTip(frm As Form, IconTooltipText As String)
    With vbTray
        .cbSize = Len(vbTray)
        .hWnd = frm.hWnd
        .uID = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallbackMessage = WM_MOUSEMOVE
        .szTip = Trim$(IconTooltipText$) & vbNullChar
        .hIcon = frm.Icon
    End With
    Call Shell_NotifyIcon(NIM_MODIFY, vbTray)
End Sub

'窗体始终置顶
Public Sub FormOnTop(frm As Form)

    Call SetWindowPos(frm.hWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, FLAGS)

End Sub


'*************************************************************************
'**函 数 名：PopupBalloon
'**输    入：frm(Form)                  -
'**        ：Message(String)            -
'**        ：Title(String)              -
'**        ：Optional DispIcon(Integer) -
'**输    出：绘制图盘图标
'**功能描述：
'**全局变量：
'**调用模块：
'**作    者：Mndsoft.com
'**日    期：2008-06-22 17:43:01
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub PopupBalloon(frm As Form, Message As String, Title As String, Optional DispIcon As Integer)

    '
    '图标Icons,
    '0 = none    无图标
    '1 = Info    信息提示
    '2 = Warning 警告
    '3 = Error   处错误
    '4 = GUID    自定义
    '
    If multiTip = False Then Call RemoveBalloon(frm)
    

        With vbTray
            .cbSize = Len(vbTray)
            .hWnd = frm.hWnd
            .uID = vbNull
            .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIM_MODIFY  'Or NIF_TIP 'NIF_TIP Or NIF_MESSAGE
            .uCallbackMessage = WM_MOUSEMOVE
            .hIcon = frm.Icon
            .dwState = 0
            .dwStateMask = 0
            .szInfo = Message & Chr(0)
            .szInfoTitle = Title & Chr(0)
            '消息提示图标, NIIF_NONE, NIIF_WARNING, NIIF_ERROR, NIIF_INFO, NIIF_GUID 在 shell32.dll
            .dwInfoFlags = DispIcon  'NIIF_GUID
        End With
    
    Call Shell_NotifyIcon(NIM_MODIFY, vbTray)

End Sub

'移除托盘气泡提示
Public Sub RemoveBalloon(frm As Form)

        With vbTray
            .cbSize = Len(vbTray)
            .hWnd = frm.hWnd
            .uID = vbNull
            .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIM_MODIFY
            .uCallbackMessage = WM_MOUSEMOVE
            .hIcon = frm.Icon
            .dwState = 0
            .dwStateMask = 0
            .szInfo = Chr(0)
            .szInfoTitle = Chr(0)
            .dwInfoFlags = NIIF_NONE
        End With
    
    Call Shell_NotifyIcon(NIM_MODIFY, vbTray)

End Sub