用Visual Basic 6.0設計TrayIcon

[魔術王子]

本程式是參考 王國榮先生 所著的Visual Basic 6.0 Windows API講座
不過有一點遺憾,就是在結束時若以End指令結束會出現錯誤
若按表單的關閉鈕則不會,不知是VB的Bug還是小王子的系統有問題
請建一個選單(名稱:Menu):
Caption = "選單"
Visible = 0 'False
Begin VB.Menu Exit
Caption = "還原"
End
另外再新增一個模組...
Form1.frm內容:

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '系統預設值
   Begin VB.Menu Menu 
      Caption         =   "選單"
      Visible         =   0   'False
      Begin VB.Menu Exit 
         Caption         =   "還原"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Exit_Click()
    SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    
    ' 刪除圖示
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    Shell_NotifyIcon NIM_DELETE, nid
    Me.Show
End Sub

Private Sub Form_Load()
    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
    Dim nid As NOTIFYICONDATA
    
    nid.cbSize = Len(nid)
    nid.hWnd = Me.hWnd
    nid.uID = uID
    nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
    nid.hIcon = Me.Icon
    nid.szTip = "TrayIcon"
    nid.uCallbackMessage = uMessage
    Shell_NotifyIcon NIM_ADD, nid
    Me.Hide
    Exit Sub
End Sub

模組Module1.bas內容:

Attribute VB_Name = "Module1"
Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONUP = &H205

Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2

Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4

Public Const uID = 9998
Public Const uMessage = WM_USER + 100

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

Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
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
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public prevWndProc As Long

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_USER + 100 Then
        If lParam = WM_LBUTTONUP Then
            Form1.WindowState = vbNormal
            Form1.Show
        ElseIf lParam = WM_RBUTTONUP Then
            Form1.PopupMenu Form1.Menu
        End If
    End If
    WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function

粗體部分需要自行KeyIn