frmtray.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form frmTray 
   Caption         =   "Form1"
   ClientHeight    =   3345
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5310
   Icon            =   "frmTray.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   223
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   354
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   Begin VB.Image imgTrayIcon 
      Height          =   480
      Index           =   3
      Left            =   4440
      Picture         =   "frmTray.frx":0442
      Top             =   1320
      Width           =   480
   End
   Begin VB.Image imgTrayIcon 
      Height          =   480
      Index           =   2
      Left            =   3645
      Picture         =   "frmTray.frx":0884
      Top             =   1320
      Width           =   480
   End
   Begin VB.Image imgTrayIcon 
      Height          =   480
      Index           =   1
      Left            =   2835
      Picture         =   "frmTray.frx":0CC6
      Top             =   1320
      Width           =   480
   End
   Begin VB.Image imgTrayIcon 
      Height          =   480
      Index           =   0
      Left            =   2040
      Picture         =   "frmTray.frx":1108
      Top             =   1320
      Width           =   480
   End
   Begin VB.Menu mnuTray 
      Caption         =   "提示菜单"
      Begin VB.Menu mnuCard 
         Caption         =   "黑桃(&S)"
         Index           =   0
      End
      Begin VB.Menu mnuCard 
         Caption         =   "红心(&H)"
         Index           =   1
      End
      Begin VB.Menu mnuCard 
         Caption         =   "草花(&C)"
         Index           =   2
      End
      Begin VB.Menu mnuCard 
         Caption         =   "方块(&D)"
         Index           =   3
      End
      Begin VB.Menu mnuSepter1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRestart 
         Caption         =   "重新启机(&R)"
      End
      Begin VB.Menu mnuShutDown 
         Caption         =   "关机"
      End
      Begin VB.Menu mnuSepter2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "关于(&A)"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)"
      End
   End
End
Attribute VB_Name = "frmTray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'窗体代码
Option Explicit
'定义消息
Private Const NIM_ADD = &H0     '添加图标到任务栏提示区
Private Const NIM_MODIFY = &H1  '图标特性已改变的消息
Private Const NIM_DELETE = &H2      '删除图标
'定义标识位
Private Const NIF_MESSAGE = &H1  '消息合法
Private Const NIF_ICON = &H2      '图标句柄合法
Private Const NIF_TIP = &H4        '提示合法
Private Const WM_MOUSEMOVE = &H200
'定义MouseMove消息，该消息将被发送到
'窗体的MouseMove事件处理函数中处理
'定义鼠标消息常数
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
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
Dim mtIconData As NOTIFYICONDATA
Dim mnCard As Integer
 '与退出Windows 95有关的变量和函数
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
    (ByVal dwMessage As Long, _
    pnid As NOTIFYICONDATA _
    ) As Long
Private Declare Function ExitWindowsEx Lib "user32" _
    (ByVal uFlags As Long, _
    ByVal dwReserved As Long _
    ) As Long
Private Const EWX_FORCE = 4
Private Const EWX_REBOOT = 2
Private Const EWX_SHUTDOWN = 1
Private Sub Form_Load()
    AddIconToTray
End Sub
Private Sub Form_Unload(Cancel As Integer)
    DeleteIconFromTray  '在此调用图标清除函数,这样每次退出时自动清除图标
    Set frmTray = Nothing
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '在AddIconToTray中语句uCallbackMessage = WM_MOUSEMOVE
    '将回调消息发送到此函数中进行处理
    '实际的回调消息存储在参数X中
    '注意在此情况下，X是一个消息而不是坐标
    Static bBusy As Boolean
    If bBusy = False Then    '控制变量，确保每次事件发生只处理一次
        bBusy = True
        Select Case CLng(X)
            Case WM_LBUTTONDBLCLK
               '处理双击消息，显示关于对话框
                mnuAbout_Click
            Case WM_LBUTTONDOWN
              '处理左键按下消息，依次改变图标显示的图案
                Select Case mnCard
                    Case 0: mnCard = 1
                    Case 1: mnCard = 2
                    Case 2: mnCard = 3
                    Case 3: mnCard = 0
                End Select
                With mtIconData
                    .hIcon = imgTrayIcon(mnCard).Picture
                    .szTip = imgTrayIcon(mnCard).Tag & Chr$(0)
                End With
                If Shell_NotifyIcon(NIM_MODIFY, mtIconData) = 0 Then
                    MsgBox "不能改变图标!"
                End If
            Case WM_LBUTTONUP       '处理左键释放消息
            Case WM_RBUTTONDBLCLK   '处理右键双击消息
                mnuShutDown_Click
            Case WM_RBUTTONDOWN     '处理右键按下消息
            Case WM_RBUTTONUP
                '处理右键释放消息，显示弹出菜单
                PopupMenu mnuTray, 2, , , mnuAbout
        End Select
        bBusy = False
    End If
End Sub
Private Sub AddIconToTray() '添加图标到提示区
    With mtIconData
        .cbSize = Len(mtIconData)
        .hWnd = Me.hWnd       '定义处理回调消息的窗口
        .uCallbackMessage = WM_MOUSEMOVE
                      '告诉图标发送MouseMove消息
        .uID = 1&           '定义图标号
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .hIcon = imgTrayIcon(0).Picture
                  '定义程序运行时显示的图标
        .szTip = imgTrayIcon(0).Tag & Chr$(0)
                    '定义提示
        If Shell_NotifyIcon(NIM_ADD, mtIconData) = 0 Then
                    '在任务栏提示区创建一图标
            MsgBox "不能创建图标!"
        End If
    End With
End Sub
Private Sub DeleteIconFromTray()
    If Shell_NotifyIcon(NIM_DELETE, mtIconData) = 0 Then
        MsgBox "不能删除图标!"
    End If
End Sub
Private Sub mnuCard_Click(Index As Integer)
    mnCard = Index
    With mtIconData
        .hIcon = imgTrayIcon(mnCard).Picture
        .szTip = imgTrayIcon(mnCard).Tag & Chr$(0)
    End With
    If Shell_NotifyIcon(NIM_MODIFY, mtIconData) = 0 Then
        MsgBox "不能改变图标!"
    Else
        MsgBox "你把牌换成了" & imgTrayIcon(mnCard).Tag
    End If
End Sub
Private Sub mnuAbout_Click()
    MsgBox "系统任务栏提示区编程演示"
End Sub
Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuRestart_Click()
    Dim lResult As Long
    lResult = ExitWindowsEx(EWX_REBOOT, 0&)
End Sub

Private Sub mnuShutDown_Click()
    Dim lResult As Long
    lResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)
End Sub