Option ExplicitPrivate 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 TypePrivate Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONUP = &H205 Private Const NIM_ADD = &H0 Private Const NIM_MODIFY = &H1 Private Const NIF_MESSAGE = &H1 Private Const NIM_DELETE = &H2 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const WM_MOUSEMOVE = &H200Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As LongDim TrayIcon As NOTIFYICONDATA, bolFlag As BooleanPrivate Sub Form_Load() TrayIcon.cbSize = Len(TrayIcon) TrayIcon.hWnd = hWnd TrayIcon.uId = vbNull TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE TrayIcon.ucallbackMessage = WM_MOUSEMOVE TrayIcon.hIcon = Me.Icon TrayIcon.szTip = "拖盘" & Chr(0)
'在系统栏添加拖盘 Call Shell_NotifyIcon(NIM_ADD, TrayIcon) End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '构造系统拖盘结构 TrayIcon.cbSize = Len(TrayIcon) TrayIcon.hWnd = Me.hWnd TrayIcon.uId = vbNull
'删除系统栏的拖盘 Call Shell_NotifyIcon(NIM_DELETE, TrayIcon) End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error Resume Next Dim Message As Long
Message = X / Screen.TwipsPerPixelX '判断鼠标消息,执行不同的功能 Select Case Message Case WM_LBUTTONDOWN '点击拖盘 Form1.WindowState = vbNormal SetForegroundWindow Form1.hWnd Case WM_RBUTTONUP SetForegroundWindow Me.hWnd '按右键弹出菜单 PopupMenu mnuPopup End Select End SubPrivate Sub Timer1_Timer() bolFlag = Not bolFlag
http://www.hongen.com/pc/program/apitutor/api0012/api01.htm
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End TypePrivate Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONUP = &H205
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As LongDim TrayIcon As NOTIFYICONDATA, bolFlag As BooleanPrivate Sub Form_Load()
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = hWnd
TrayIcon.uId = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
TrayIcon.hIcon = Me.Icon
TrayIcon.szTip = "拖盘" & Chr(0)
'在系统栏添加拖盘
Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'构造系统拖盘结构
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = Me.hWnd
TrayIcon.uId = vbNull
'删除系统栏的拖盘
Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Dim Message As Long
Message = X / Screen.TwipsPerPixelX '判断鼠标消息,执行不同的功能
Select Case Message
Case WM_LBUTTONDOWN
'点击拖盘
Form1.WindowState = vbNormal
SetForegroundWindow Form1.hWnd
Case WM_RBUTTONUP
SetForegroundWindow Me.hWnd
'按右键弹出菜单
PopupMenu mnuPopup
End Select
End SubPrivate Sub Timer1_Timer()
bolFlag = Not bolFlag
TrayIcon.cbSize = Len(TrayIcon)
TrayIcon.hWnd = hWnd
TrayIcon.uId = vbNull
TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayIcon.ucallbackMessage = WM_MOUSEMOVE
TrayIcon.hIcon = IIf(bolFlag, Me.Icon, Picture1.Picture)
TrayIcon.szTip = "拖盘" & Chr(0)
'在系统栏添加拖盘
Call Shell_NotifyIcon(NIM_MODIFY, TrayIcon)
End Sub