Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const NIM_ADD = &H0 '在任务栏中增加一个图标
Private Const NIM_DELETE = &H2 '删除任务栏中的一个图标
Private Const NIM_MODIFY = &H1 '修改任务栏中个图标信息
Private Const WM_MOUSEMOVE = &H200 '在图标上移动鼠标
Private Const WM_LBUTTONDOWN = &H201 '鼠标左键按下
Private Const WM_LBUTTONUP = &H202 '鼠标左键释放
Private Const HWND_TOPMOST = -1
Private Const SWP_SHOWWINDOW = &H40
Private Type NOTIFYICONDATA
cbSize As Long '该数据结构的大小
hwnd As Long '处理任务栏中图标的窗口句柄
uId As Long '定义的任务栏中图标的标识
uFlags As Long '任务栏图标功能控制,可以是以下值的组合(一般全包括)
ucallbackMessage As Long '任务栏图标通过它与用户程序交换消息,处理该消息的窗口由hWnd决定
hIcon As Long '任务栏中的图标的控制句柄
szTip As String * 64 '图标的提示信息
End Type
Private Const NIF_MESSAGE = &H1 'NIF_MESSAGE 表示发送控制消息;
Private Const NIF_ICON = &H2 'NIF_ICON表示显示控制栏中的图标;
Private Const NIF_TIP = &H4 'NIF_TIP表示任务栏中的图标有动态提示。
Private restoreTime As Date
Dim myData1 As NOTIFYICONDATA
Private Sub Form_Load()
With myData1
.cbSize = Len(myData1)
.hwnd = Me.hwnd
.uId = 0
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.ucallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = "托盘程序测试!" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, myData1
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Message As Long
Message = x / Screen.TwipsPerPixelX
Select Case Message
Case WM_LBUTTONUP
If Me.WindowState = vbMinimized Then
Me.WindowState = vbNormal
Me.Show
End If
End Select
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
Timer1.Interval = 1000
restoreTime = DateAdd("n", 1, Now)
Me.Hide
End If
End Sub
Private Sub Timer1_Timer()
If DateDiff("n", restoreTime, Now) = 0 Then
Me.WindowState = vbNormal
Me.Show
Me.ScaleMode = 3
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.ScaleLeft, Me.ScaleTop, Me.ScaleWidth, Me.ScaleHeight, SWP_SHOWWINDOW
End If
End Sub
'添加一个timer控件,最小化以后看效果,我这里定时是1分钟,你可以根据自己需要去改一下