modtray.bas

本程序可以设置本机自动与Internet时间同步。

Attribute VB_Name = "modTray"
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 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 Const GWL_WNDPROC = (-4)

Public Const WM_USER = &H400
Public Const WM_NOTIFYICON = WM_USER + &H100    '托盘消息
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205

Public Const NIS_HIDDEN = &H1              ' 隐藏图标
Public Const NIS_SHAREDICON = &H2          ' 共享图标

' dwInfoFlags to NOTIFIICONDATA structure
Public Const NIIF_NONE = &H0               ' 无图标
Public Const NIIF_INFO = &H1               ' "消息"图标
Public Const NIIF_WARNING = &H2            ' "警告"图标
Public Const NIIF_ERROR = &H3              ' "错误"图标
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

Public 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

Public NotifyIcon As NOTIFYICONDATA
Public pWndProc As Long

Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_NOTIFYICON Then
        Select Case lParam
            Case WM_RBUTTONDOWN
                SetForegroundWindow hwnd '关键的一步
            Case WM_RBUTTONUP
                frmMain.PopupMenu frmMain.mSysPopup
        End Select
    End If
    WndProc = CallWindowProc(pWndProc, hwnd, Msg, wParam, lParam)
End Function