Option Explicit

Private Sub cmdAddIcon_Click()
    Call AddIcon
End Sub

Private Sub cmdDeleteIcon_Click()
    Call DeleteIcon
End Sub

Private Sub Form_Load()

    'このフォームのウィンドウプロシージャにフックをかけ、標準モジュール内のWndProcに
    'ウィンドウメッセージが運ばれるようにする、戻り値は本来のウィンドウプロシージャのアドレス
    lngOriginalWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WndProc)

End Sub

Private Sub AddIcon()
    Dim ret As Long
    Dim nid As NOTIFYICONDATA
    
    With nid
        .cbSize = Len(nid) 'この構造体のサイズを入れる
        .hWnd = Me.hWnd '通知を受けるウィンドウ
        .uID = 1 'ユーザー定義のアイコン識別ID(メッセージが通知された時、wParamに入っている)
        .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP 'この構造体のメンバーのどの要素が有効かのフラグ
        .uCallbackMessage = TRAY_NOTIFYICON 'このメッセージが発行される
        .hIcon = imgIcon.Picture 'アイコン
        .szTip = "チップヘルプ" & vbNullChar
    End With
    
    ret = Shell_NotifyIcon(NIM_ADD, nid)
    'アイコンを登録したら非表示にする
End Sub

Private Sub DeleteIcon()
    Dim ret As Long
    Dim nid As NOTIFYICONDATA
    
    With nid
        .cbSize = Len(nid)
        .hWnd = Me.hWnd
        .uID = vbNull
        .uFlags = NIF_MESSAGE Or NIF_TIP
        .uCallbackMessage = TRAY_NOTIFYICON
        .hIcon = imgIcon.Picture
        .szTip = "" & vbNullChar
    End With
    ret = Shell_NotifyIcon(NIM_DELETE, nid)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '終了時にはアイコンを削除する
    DeleteIcon
End Sub

Option Explicit
Declare Function Shell_NotifyIcon Lib "SHELL32" Alias "Shell_NotifyIconA" ( _
	ByVal dwMessage As Long, _
	ByRef pnid 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 SetWindowLong Lib "USER32" Alias "SetWindowLongA" ( _
	ByVal hWnd As Long, _
	ByVal nIndex As Long, _
	ByVal dwNewLong As Long) As Long

'タスクトレイ関連の構造体と定数
Public Type NOTIFYICONDATA
    cbSize As Long              '構造体のサイズ
    hWnd As Long                '通知を受け取るウインドウのハンドル
    uID As Long                 'タスクバーアイコンのユーザー定義の ID
    uFlags As Long              '有効なメンバーを示す次の定数の組み合せ
    uCallbackMessage As Long    'ユーザー定義メッセージ
    hIcon As Long               'アイコンのハンドル
    szTip As String * 64        'チップヘルプの文字列
    dwState As Long             'アイコンの状態(？？？)
    dwStateMask As Long         'アイコンの状態のマスク(？？？)
End Type

Public Const NIF_ICON = &H2     'hIconの値は有効
Public Const NIF_MESSAGE = &H1  'uCallbackMessageの値は有効
Public Const NIF_TIP = &H4      'szTipの値は有効

Public Const NIM_ADD = &H0      'アイコンを追加する
Public Const NIM_DELETE = &H2   'アイコンを削除する
Public Const NIM_MODIFY = &H1   'アイコンを変更する

'ウィンドウメッセージ定数
Public Const GWL_WNDPROC = -4
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_USER = &H400
Public Const TRAY_NOTIFYICON = WM_USER + 1 'タスクトレイの通知メッセージ

'変数の宣言
Public lngOriginalWndProc As Long '本来のウィンドウプロシージャのアドレスを保持する変数

'ウィンドウプロシージャ
Public Function WndProc( _
	ByVal hTargetWnd As Long, _
	ByVal msg As Long, _
	ByVal wParam As Long, _
	ByVal lParam As Long) As Long

    If msg = TRAY_NOTIFYICON Then
        Select Case lParam
            Case WM_LBUTTONDOWN
                frmMain.lblState = "WM_LBUTTONDOWN(左ボタンが押された)"
            Case WM_LBUTTONUP
                frmMain.lblState = "WM_LBUTTONUP(左ボタンが放された)"
            Case WM_LBUTTONDBLCLK
                frmMain.lblState = "WM_LBUTTONDBLCLK(左ボタンがダブルクリックされた)"
            Case WM_RBUTTONDOWN
                frmMain.lblState = "WM_RBUTTONDOWN(右ボタンが押された)"
            Case WM_RBUTTONUP
                frmMain.lblState = "WM_RBUTTONUP(右ボタンが放された)"
            Case WM_RBUTTONDBLCLK
                frmMain.lblState = "WM_RBUTTONDBLCLK(右ボタンがダブルクリックされた)"
            Case WM_MBUTTONDOWN
                frmMain.lblState = "WM_MBUTTONDOWN(中央ボタンが押された)"
            Case WM_MBUTTONUP
                frmMain.lblState = "WM_MBUTTONUP(中央ボタンが放された)"
            Case WM_MBUTTONDBLCLK
                frmMain.lblState = "WM_MBUTTONDBLCLK(中央ボタンがダブルクリックされた)"
            Case WM_MOUSEMOVE
                frmMain.lblState = "WM_MOUSEMOVE(マウスが移動しました)"
            Case Else
                frmMain.lblState = "その他のメッセージ " & lParam
        End Select
    End If
    
    WndProc = CallWindowProc(lngOriginalWndProc, hTargetWnd, msg, wParam, lParam)

End Function