說明

在表單縮到右下角中有對SystemTray詳細的說明，但是要使用SubClass的技巧，這就令人覺得煩，而以下的方式不用SubClass，因是借用 WM_MouseMove當作是uCallbackMessage(Mouse Click時送出的訊息)，所以只要在MouseMove中Check X 座標便可以得知該MouseMove是來自正常的MouseMove或SystemTray Click所產生的MouseMove

程式

'以下程式在Form，需四個Command Button，一個Picture1,1個Label1

'並自訂Menu，Menu結構如下

'mnuShow  (Visable = False)
'   |
'   +-- mnuDisplay (Caption="顯示",Visable = true)
'   |
'   +-- mnuQuit (Caption="結束", Visable = true)

Option Explicit
Private mlngID

Private Sub Command1_Click()
    If mlngID = 0 Then
        mlngID = AddToSystemTray(Picture1.hWnd, WM_MOUSEMOVE, Me.Icon, Text1.Text)
        Command1.Enabled = False
        Command2.Enabled = True
        Command3.Enabled = True
        Command4.Enabled = True
    End If
End Sub

Private Sub Command2_Click()
    If mlngID <> 0 Then
        DeleteFromSystemTray mlngID
        mlngID = 0
        Command1.Enabled = True
        Command2.Enabled = False
        Command3.Enabled = False
        Command4.Enabled = False
    End If
End Sub

Private Sub Command3_Click()
If mlngID <> 0 Then
    ModifySystemTrayTip mlngID, Text1.Text '請自行更動成您的訊息
    Me.Visible = False
End If
End Sub

Private Sub Command4_Click()
    Static wpic As Boolean
    If mlngID <> 0 Then
        wpic = Not wpic
        If wpic Then
            Dim picNew As StdPicture
            Set picNew = LoadPicture(App.Path & "\Pgm03.ico") '請自行更動成您的Icon
            ModifySystemTrayIcon mlngID, picNew
        Else
            ModifySystemTrayIcon mlngID, Me.Icon
        End If
    End If
End Sub

Private Sub Form_Load()
    Command1.Caption = "加入SystemTray"
    Command2.Caption = "取消SystemTray"
    Command3.Caption = "更改Tips"
    Command4.Caption = "更改Icon"
    Picture1.Visible = False
End Sub

Private Sub mnuQuit_Click()
    Unload Me
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Msg As Long
If Me.ScaleMode = 1 Then
   Msg = X / Screen.TwipsPerPixelX
Else
 
End If
Select Case Msg
      Case WM_MOUSEMOVE '移動滑鼠
          'Label1.Caption = "正在移動滑鼠"
      Case WM_LBUTTONDBLCLK '連點滑鼠左鍵
          Label1.Caption = "連點滑鼠左鍵"
      Case WM_LBUTTONDOWN '按下滑鼠左鍵
          Label1.Caption = "按下滑鼠左鍵"
      Case WM_LBUTTONUP '放開滑鼠左鍵
          Label1.Caption = "放開滑鼠左鍵"
      Case WM_RBUTTONDBLCLK '連點滑鼠右鍵
          Label1.Caption = "連點滑鼠右鍵"
      Case WM_RBUTTONDOWN '按下滑鼠右鍵
          Label1.Caption = "按下滑鼠右鍵"
          Me.PopupMenu mnuShow, vbPopupMenuLeftAlign + vbPopupMenuRightButton
      Case WM_RBUTTONUP '放開滑鼠右鍵
          Label1.Caption = "放開滑鼠右鍵"
End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)
    If mlngID <> 0 Then
        DeleteFromSystemTray mlngID
        mlngID = 0
    End If
  
End Sub

Private Sub mnuDisplay_Click()
    Me.Visible = True
End Sub


---


'以下程式在模組中
Option Explicit

Private Declare Function Shell_NotifyIconA Lib "SHELL32.DLL" _
                (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Type NOTIFYICONDATA
        cbSize As Long
        hWnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type

Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4

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

Private mlngID As Long
Private mcolNID As Collection

'----------------------------------------------------------------------------------
Public Function AddToSystemTray(ByVal hWnd As Long, _
                                ByVal vlngCallbackMessage As Long, _
                                ByVal vipdIcon As IPictureDisp, _
                                ByVal vstrTip As String) As Long

    mlngID = mlngID + 1
  
    Dim nidTemp As NOTIFYICONDATA
  
    With nidTemp
        .cbSize = Len(nidTemp)
        .hWnd = hWnd
        .uID = mlngID
        .uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
        .uCallbackMessage = vlngCallbackMessage
        .hIcon = CLng(vipdIcon)
        .szTip = vstrTip & vbNullChar
    End With

    If mcolNID Is Nothing Then Set mcolNID = New Collection

    mcolNID.Add hWnd, CStr(mlngID)

    Shell_NotifyIconA NIM_ADD, nidTemp
  
    AddToSystemTray = mlngID

End Function

Public Sub ModifySystemTrayMessage(ByVal vlngID As Long, _
                                   ByVal vlngCallbackMessage As Long)

    Dim nidTemp As NOTIFYICONDATA
  
    With nidTemp
        .cbSize = Len(nidTemp)
        .hWnd = mcolNID(CStr(vlngID))
        .uID = vlngID
        .uFlags = NIF_MESSAGE
        .uCallbackMessage = vlngCallbackMessage
        .hIcon = 0
        .szTip = vbNullChar
    End With

    Shell_NotifyIconA NIM_MODIFY, nidTemp

End Sub

Public Sub ModifySystemTrayIcon(ByVal vlngID As Long, _
                                ByVal vipdIcon As IPictureDisp)

    Dim nidTemp As NOTIFYICONDATA
  
    With nidTemp
        .cbSize = Len(nidTemp)
        .hWnd = mcolNID(CStr(vlngID))
        .uID = vlngID
        .uFlags = NIF_ICON
        .uCallbackMessage = 0
        .hIcon = CLng(vipdIcon)
        .szTip = vbNullChar
    End With

    Shell_NotifyIconA NIM_MODIFY, nidTemp

End Sub
Public Sub ModifySystemTrayTip(ByVal vlngID As Long, _
                               ByVal vstrTip As String)

    Dim nidTemp As NOTIFYICONDATA
  
    With nidTemp
        .cbSize = Len(nidTemp)
        .hWnd = mcolNID(CStr(vlngID))
        .uID = vlngID
        .uFlags = NIF_TIP
        .uCallbackMessage = 0
        .hIcon = 0
        .szTip = vstrTip & vbNullChar
    End With

    Shell_NotifyIconA NIM_MODIFY, nidTemp

End Sub

Public Sub DeleteFromSystemTray(ByVal vlngID As Long)

    Dim nidTemp As NOTIFYICONDATA
  
    With nidTemp
        .cbSize = Len(nidTemp)
        .hWnd = mcolNID(CStr(vlngID))
        .uID = vlngID
        .uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
    End With

    Shell_NotifyIconA NIM_DELETE, nidTemp

End Sub

範例程式下載

   Tray.exe  3.98Byte

相關資訊

  Shell_NotifyIcon

  Visual Basic SysTray Sample 微軟的Sample

  Q176085 - HOWTO- Use the System Tray Directly from Visual Basic

  Q149276 - HOWTO- Use Icons with the Windows 95-98-Me Taskbar Notification Area

  Q162613 - HOWTO- Manipulate Icons in the System Tray with Visual Basic

文件出處

  不詳 cww說明與修改

  Honey修正部分Bug

整理時間

  2002'1,31.

如果對本站有任何建議,歡迎來信給Honey,我們會盡快給您答覆