Attribute VB_Name = "Moduletray"
'*****************系統托盤********************


Option Explicit

Public thefrm As Form
Public themnu As Menu
Public oldwindowproc 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_USER = &H400
Public Const TRAY_CALLBACK = (WM_USER + 1001&)

 
   
'其中各參數的意義如下表:

'參數:  意義
'dwMessage 為消息設置值，它可以是以下的幾個常數值：0、1、2
'NIM_ADD = 0　 加入圖標到系統狀態欄中
'NIM_MODIFY = 1  修改系統狀態欄中的圖標
'NIM_DELETE = 2  刪除系統狀態欄中的圖標

    'LpData 用以傳入NOTIFYICONDATA數據結構變量，其結構如下所示：

Type NOTIFYICONDATA

    cbSize As Long               '需填入NOTIFYICONDATA數據結構的長度
    HWnd As Long                 '設置成窗口的句柄
    Uid As Long                  '為圖標所設置的ID值
    UFlags As Long               '設置uCallbackMessage,hIcon,szTip是否有效
    UCallbackMessage As Long     '消息編號
    HIcon As Long                '顯示在狀態欄上的圖標
    SzTip As String * 64         '提示信息
End Type
Private theData As NOTIFYICONDATA
    '返回值 Long，非零表示成功，零表示失敗
    
:

      Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      '如果用戶點擊了托盤中的圖標，則進行判斷是點擊了左鍵還是右鍵
      If Msg = TRAY_CALLBACK Then
          '如果點擊了左鍵
          If lParam = WM_LBUTTONUP Then
                '恢復到最小化前的窗體狀態
                thefrm.WindowState = 0
                thefrm.Show
                delicon
                Exit Function
          End If
          '如果點擊了右鍵
          If lParam = WM_RBUTTONUP Then
              '則彈出右鍵菜單
              thefrm.PopupMenu themnu
              Exit Function
          End If
      End If
      '如果是其他類型的消息則傳遞給原有默認的窗口函數
      NewWindowProc = CallWindowProc(oldwindowproc, HWnd, Msg, wParam, lParam)
      End Function
   
    
    
    
    
    '*********************************************]
'添加圖標
Sub addicon(frm As Form, mnu As Menu)
Set thefrm = frm
Set themnu = mnu

oldwindowproc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
  
With theData
        .Uid = 0
        .HWnd = frm.HWnd              'frm.HWnd是程序主窗體的句柄
        .cbSize = Len(theData)
        .HIcon = frm.Icon.Handle    'frm.Icon.Handle指向主窗體的圖標
        .UFlags = NIF_ICON
        .UCallbackMessage = TRAY_CALLBACK
         '作用是允許返回消息
        .UFlags = .UFlags Or NIF_MESSAGE
        .cbSize = Len(theData)
      End With
      Shell_NotifyIcon NIM_ADD, theData
      thefrm.Visible = False
    '根據前面定義NIM_ADD，設置為“添加模式”，然后添加
End Sub
  
'刪除圖標
Sub delicon()
With theData
        .UFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, theData
'根據前面定義NIM_DELETE，設置為“刪除模式”

SetWindowLong thefrm.HWnd, GWL_WNDPROC, oldwindowproc
End Sub
'更改圖標
 Sub changeicon(pic As Picture)
 With theData
    .HIcon = pic.Handle
    'pic是圖片PictureBox，存放圖標文件
    .UFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根據前面定義NIM_MODIFY，設置為“更改模式”
 End Sub
'圖標提示
Sub iconshow(tip As String)
With theData
        .SzTip = tip & vbNullChar
           'tip是字符串string，存儲提示信息
        .UFlags = NIF_TIP
        '指明要對浮動提示進行設置
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根據前面定義NIM_MODIFY，設置為“修改模式”
End Sub