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
