Attribute VB_Name = "mTray"
Option Explicit

Public Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
Public 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_NOTIFYICON = WM_USER + &H100

Public Type NOTIFYICONDATA
    cbSize As Long              ' 結(jié)構(gòu)大小(字節(jié))
    hwnd As Long                ' 處理消息的窗口的句柄
    uId As Long                 ' 唯一的標(biāo)識(shí)符
    uFlags As Long              ' Flags
    uCallBackMessage As Long    ' 處理消息的窗口接收的消息
    hIcon As Long               ' 托盤(pán)圖標(biāo)句柄
    szTip As String * 128       ' Tooltip 提示文本
    dwState As Long             ' 托盤(pán)圖標(biāo)狀態(tài)
    dwStateMask As Long         ' 狀態(tài)掩碼
    szInfo As String * 256      ' 氣球提示文本
    uTimeoutOrVersion As Long   ' 氣球提示消失時(shí)間或版本
    ' uTimeout - 氣球提示消失時(shí)間(單位:ms, 10000 -- 30000)
    ' uVersion - 版本(0 for V4, 3 for V5)
    szInfoTitle As String * 64  ' 氣球提示標(biāo)題
    dwInfoFlags As Long         ' 氣球提示圖標(biāo)
End Type

' dwState to NOTIFYICONDATA structure
Public Const NIS_HIDDEN = &H1              ' 隱藏圖標(biāo)
Public Const NIS_SHAREDICON = &H2          ' 共享圖標(biāo)

' dwInfoFlags to NOTIFIICONDATA structure
Public Const NIIF_NONE = &H0               ' 無(wú)圖標(biāo)
Public Const NIIF_INFO = &H1               ' "消息"圖標(biāo)
Public Const NIIF_WARNING = &H2            ' "警告"圖標(biāo)
Public Const NIIF_ERROR = &H3              ' "錯(cuò)誤"圖標(biāo)
Public Const NIIF_GUID = &H4

' uFlags to NOTIFYICONDATA structure
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10

' dwMessage to Shell_NotifyIcon
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIM_SETFOCUS = &H3
Public Const NIM_SETVERSION = &H4

' 關(guān)于氣球提示的自定義消息, 2000下不產(chǎn)生這些消息
Public Const NIN_BALLOONSHOW = (WM_USER + &H2)      ' 當(dāng) Balloon Tips 彈出時(shí)執(zhí)行
Public Const NIN_BALLOONHIDE = (WM_USER + &H3)      ' 當(dāng) Balloon Tips 消失時(shí)執(zhí)行（如 SysTrayIcon 被刪除），
' 但指定的 TimeOut 時(shí)間到或鼠標(biāo)點(diǎn)擊 Balloon Tips 后的消失不發(fā)送此消息
Public Const NIN_BALLOONTIMEOUT = (WM_USER + &H4)   ' 當(dāng) Balloon Tips 的 TimeOut 時(shí)間到時(shí)執(zhí)行
Public Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 當(dāng)鼠標(biāo)點(diǎn)擊 Balloon Tips 時(shí)執(zhí)行。
' 注意:在XP下執(zhí)行時(shí) Balloon Tips 上有個(gè)關(guān)閉按鈕,
' 如果鼠標(biāo)點(diǎn)在按鈕上將接收到 NIN_BALLOONTIMEOUT 消息。

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_NCLBUTTONDBLCLK = &HA3

Public Const GWL_STYLE = -16
Public Const GWL_WNDPROC = -4

Public pWndProc As Long
Public Const sMyURL As String = "http://www.vbgood.com/viewthread.php?tid=76199"

' 攔截菜單消息 (窗口入口函數(shù))
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Integer, j As Integer
    Dim itemID As Long
    Dim t As String
    Dim pos As POINTAPI

    Select Case uMsg
      Case WM_COMMAND                                                 ' 單擊菜單項(xiàng)
        If wParam < iMenuID And lParam = 0 Then MenuItemSelected wParam

      Case WM_EXITMENULOOP                                            ' 退出菜單消息循環(huán)(保留)

      Case WM_MEASUREITEM                                             ' 處理菜單項(xiàng)高度和寬度
        MeasureItem hwnd, lParam

      Case WM_MENUSELECT                                              ' 選擇菜單項(xiàng)
        itemID = GetMenuItemID(lParam, wParam And &HFF)
        If itemID <> -1 Then MenuItemSelecting itemID

      Case WM_DRAWITEM                                                ' 繪制菜單項(xiàng)
        DrawItem lParam

      Case WM_NOTIFYICON                                              ' 點(diǎn)擊托盤(pán)
        Select Case lParam

          Case WM_LBUTTONDBLCLK
            With frmMain.lstApp
                Call frmMain.CheckWin

                If .ListCount > 0 Then
                    frmMain.ShowWin .ListCount - 1
                Else
                    If MsgBox("您確定不再需要" & App.Title & "的幫助了嗎？ :(", vbQuestion + vbYesNo + vbDefaultButton2, App.Title & " 提示") = vbYes Then
                        Unload frmMain
                    End If
                End If
            End With

          Case WM_RBUTTONDOWN
            For i = UBound(MyItemInfo) To 0 Step -1
                DeleteMenu hMenu, i, 0
            Next

            iMenuID = 0
            Erase MyItemInfo

            With frmMain.lstApp
                Call frmMain.CheckWin

                For i = 0 To .ListCount - 1
                    t = GetWinText(Val(.List(i)))

                    If frmMain.bTitleTrim Then
                        For j = 1 To Len(t)
                            If lstrlen(Left(t, j)) >= 20 Then
                                t = Left(t, j) & " ……"
                                Exit For
                            End If
                        Next
                    End If

                    AddItem CStr(i), GetIcon(GetProcessPath(Val(.List(i)))), t, MIT_STRING
                Next

                If .ListCount > 0 Then AddItem "sep", LoadPicture(), "", MIT_SEPARATOR

                If frmMain.tmrApp.Enabled Then
                    AddItem "hook", frmMain.lstWin.MouseIcon, "監(jiān)控已開(kāi)啟", MIT_STRING
                Else
                    AddItem "hook", frmMain.lstAdd.MouseIcon, "監(jiān)控已關(guān)閉", MIT_STRING
                End If

                AddItem "set", frmMain.lstApp.MouseIcon, "軟件設(shè)置", MIT_STRING
                AddItem "sep", LoadPicture(), "", MIT_SEPARATOR
                AddItem "post", frmMain.lstOld.MouseIcon, "獻(xiàn)良策", MIT_STRING
                AddItem "about", frmMain.MouseIcon, "關(guān)于本軟件", MIT_STRING
                AddItem "exit", frmMain.lstNow.MouseIcon, "退出本軟件", MIT_STRING
            End With

            GetCursorPos pos
            SetForegroundWindow frmMain.hwnd
            PopMenu pos.x, pos.y, POPUP_LEFTALIGN Or POPUP_TOPALIGN

        End Select
    End Select

    WindowProc = CallWindowProc(pWndProc, hwnd, uMsg, wParam, lParam)
End Function

Public Sub DoAction(ByVal iID As Long)
    With frmMain
        Select Case MyItemInfo(iID).itemAlias

          Case "about":
            ShellAbout .hwnd, App.Title & " V" & App.Major & "." & App.Minor & " Build " & Format$(App.Revision, "0000"), _
                       App.CompanyName & " 謝謝您的使用，歡迎前往論壇獻(xiàn)良策", .Icon

          Case "exit":
            Unload frmMain

          Case "hook":
            .tmrApp.Enabled = Not .tmrApp.Enabled

          Case "post":
            ShellExecute 0, vbNullString, sMyURL, vbNullString, vbNullString, vbNormalFocus

          Case "set":
            .Show

          Case Else
            .ShowWin Val(MyItemInfo(iID).itemAlias)

        End Select
    End With
End Sub

Public Function GetWinText(ByVal lHwnd As Long) As String
    Dim s As String * 255

    GetWindowText lHwnd, s, 255
    GetWinText = Blank(s)
End Function

Public Function Blank(ByVal szString As String) As String
    Dim l As Integer

    l = InStr(szString, vbNullChar)
    If l > 0 Then
        Blank = Left(szString, l - 1)
    Else
        Blank = szString
    End If
End Function