托盘控件

VERSION 5.00
Begin VB.UserControl 托盘控件 
   BackStyle       =   0  '透明
   CanGetFocus     =   0   'False
   ClientHeight    =   885
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1140
   ClipBehavior    =   0  '无
   ClipControls    =   0   'False
   FontTransparent =   0   'False
   HasDC           =   0   'False
   ScaleHeight     =   885
   ScaleWidth      =   1140
   ToolboxBitmap   =   "托盘控件.ctx":0000
   Begin VB.Image Image1 
      Height          =   480
      Left            =   0
      Picture         =   "托盘控件.ctx":0312
      Top             =   0
      Width           =   480
   End
   Begin VB.Shape Shape1 
      BorderStyle     =   0  'Transparent
      DrawMode        =   1  'Blackness
      FillStyle       =   0  'Solid
      Height          =   495
      Left            =   0
      Shape           =   4  'Rounded Rectangle
      Top             =   0
      Width           =   495
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   0
      Width           =   90
   End
   Begin VB.Menu 文件 
      Caption         =   "文件"
      Begin VB.Menu A 
         Caption         =   "A"
      End
   End
End
Attribute VB_Name = "托盘控件"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_IconData  As NOTIFYICONDATA
Private Type NOTIFYICONDATA
    cbSize          As Long
    hWnd            As Long
    uID             As Long
    uFlags          As Long
    uCallbackMessage As Long
    hIcon           As Long
    szTip           As String * 128
    dwState         As Long
    dwStateMask     As Long
    szInfo          As String * 256
    uTimeout        As Long
    szInfoTitle     As String * 64
    dwInfoFlags     As Long
End Type
Enum 图标
    无图标 = &H0                                                                '  NIIF_NONE = &H0
    信息图标 = &H1                                                              '  NIIF_INFO = &H1
    警告图标 = &H2                                                              '  NIIF_WARNING = &H2
    错误图标 = &H3                                                              '  NIIF_ERROR = &H3
    托盘图标 = &H4                                                              '  NIIF_GUID = &H4
End Enum
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Event PopupMenu()
Event 单击托盘()
Dim 图标缓存        As StdPicture

Public Function 创建气泡(Optional 标题 As String = "", Optional 内容 As String = "", Optional 告示图标 As 图标 = 信息图标)
    With m_IconData
        .cbSize = Len(m_IconData)
        .hWnd = UserControl.hWnd
        .uID = vbNull
        .uFlags = &H2 Or &H10 Or &H1 Or &H4 Or &H1
        .uCallbackMessage = &H200
        .hIcon = Image1
        .dwState = 0
        .dwStateMask = 0
        .szInfoTitle = 标题 & Chr(0)
        .szInfo = 内容 & Chr(0)
        .dwInfoFlags = 告示图标
        .uTimeout = 300
    End With
    Shell_NotifyIcon &H1, m_IconData
    Shell_NotifyIcon &H0, m_IconData
End Function
                                                                    
Public Property Get 创建托盘() As Boolean
    创建托盘 = UserControl.Enabled
End Property
                                                                    
Public Property Let 创建托盘(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    If Enabled = True Then
        创建气泡
    Else
        Shell_NotifyIcon &H2, m_IconData
    End If
End Property
                                                                    
Public Property Get Icon() As StdPicture
    If Nothing Is Image Then Exit Property
    Set Icon = Image1
End Property
                                                                    
Public Property Set Icon(ByVal Handle As StdPicture)
    Set Image1.Picture = Handle
    Set 图标缓存 = Handle
End Property
                                                                    
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Screen.TwipsPerPixelX <> 15 Then Exit Sub
    If Button = 1 Then RaiseEvent 单击托盘: Exit Sub
    If Button = 2 Then RaiseEvent PopupMenu: Exit Sub
End Sub
                                                                         
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    On Error Resume Next
    Image1.Picture = PropBag.ReadProperty("图标", Image1.MouseIcon)
End Sub
                                                                         
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    On Error Resume Next
    Call PropBag.WriteProperty("图标", Image1.Picture, Image1.MouseIcon)
End Sub
                                                                         
Private Sub UserControl_Resize()
    UserControl.Width = 500
    UserControl.Height = 500
End Sub
                                                                         
Public Sub 更换托盘图标(Optional ByVal 托盘图标 = 0)
    With m_IconData
        .szInfoTitle = Chr(0)
        .szInfo = Chr(0)
        If 托盘图标 <> 0 Then
            .hIcon = 托盘图标
        End If
    End With
    Shell_NotifyIcon &H0, m_IconData                                            '更换托盘图标
End Sub