ÏÂÃæÊÇ°Ñͼ±ê·ÅÈëϵͳÍÐÅ̵ÄËùÓÐÄÚÈÝ£¬°üÀ¨Ð½¨£¬Ð޸ģ¬É¾³ý
Public 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 TypePublic MyIconData As NOTIFYICONDATAPublic Const NIM_ADD = &H0 'ÍùÈÎÎñÀ¸ÖмÓÈëͼ±ê
Public Const NIM_MODIFY = &H1 'ÐÞ¸Äͼ±ê
Public Const NIM_DELETE = &H2 'ɾ³ýͼ±ê
Public Const NIF_MESSAGE = &H1 'ÔÊÐíת·¢Í¼±êÏûÏ¢
Public Const NIF_ICON = &H2 'ͼ±ê¾äºÏ·¨
Public Const NIF_TIP = &H4 'ÔÊÐíÏÔʾͼ±êÌáʾÐÅÏ¢´®
Public Const WM_MOUSEMOVE = &H200 'ÒÔ϶¨ÒåÊó±êÏûÏ¢
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_KEYUP = &H101Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATAPublic Sub AddIconToTaskbar(thishWnd As Long, thisIcon As Long, TaskTip As String) 'Ìí¼Óͼ±êÖÁÈÎÎñÀ¸
Dim I As Integer
With MyIconData
.cbSize = Len(MyIconData)
.hWnd = thishWnd '¶¨Òå´¦Âñ»Øµ÷ÏûÏ¢µÄ´°¿Ú
.uCallbackMessage = WM_MOUSEMOVE '֪ͨͼ±ê·¢ËÍ MouseMove ÏûÏ¢
.uID = 1& '¶¨Òåͼ±êºÅ
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.hIcon = thisIcon '¶¨Òå³ÌÐòÔËÐÐʱÏÔʾµÄͼ±ê
TaskTip = TaskTip + Chr(&H0)
.szTip = TaskTip '¶¨ÒåÏÔʾÎÄ×Ö
End With
If Shell_NotifyIcon(NIM_ADD, MyIconData) = 0 Then 'ÔÚÈÎÎñÀ¸´´½¨Ò»Í¼±ê
' MsgBox "ͼ±ê¼Ù´´½¨Ê§°Ü!"
End If
End Sub
Public Sub ModifyIconToTaskbar(thishWnd As Long, thisIcon As Long, TaskTip As String) 'Ìí¼Óͼ±êÖÁÈÎÎñÀ¸
Dim I As Integer
With MyIconData
.cbSize = Len(MyIconData)
.hWnd = thishWnd '¶¨Òå´¦Âñ»Øµ÷ÏûÏ¢µÄ´°¿Ú
.uCallbackMessage = WM_MOUSEMOVE '֪ͨͼ±ê·¢ËÍ MouseMove ÏûÏ¢
.uID = 1& '¶¨Òåͼ±êºÅ
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.hIcon = thisIcon '¶¨Òå³ÌÐòÔËÐÐʱÏÔʾµÄͼ±ê
TaskTip = TaskTip + Chr(&H0)
.szTip = TaskTip '¶¨ÒåÏÔʾÎÄ×Ö
End With
If Shell_NotifyIcon(NIM_MODIFY, MyIconData) = 0 Then 'ÔÚÈÎÎñÀ¸´´½¨Ò»Í¼±ê
' MsgBox "ͼ±ê¼Ù´´½¨Ê§°Ü!"
End If
End SubPublic Sub DeleteIconFromTaskbar()
If Shell_NotifyIcon(NIM_DELETE, MyIconData) = 0 Then
End If
End SubÓÃÀý£º ''¼ÓÈëÍÐÅÌͼ±ê
AddIconToTaskbar Me.hwnd, Me.Icon, Me.Caption
''ʼþ´¥·¢
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case CLng(X)
Case WM_LBUTTONDBLCLK, WM_LBUTTONUP
Call SetShowStyle
Case 7740 'WM_RBUTTONDOWN
CreatePopMenu
PopupMenu menuFunction
End Select
'MsgBox X
End Sub
Public 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 TypePublic MyIconData As NOTIFYICONDATAPublic Const NIM_ADD = &H0 'ÍùÈÎÎñÀ¸ÖмÓÈëͼ±ê
Public Const NIM_MODIFY = &H1 'ÐÞ¸Äͼ±ê
Public Const NIM_DELETE = &H2 'ɾ³ýͼ±ê
Public Const NIF_MESSAGE = &H1 'ÔÊÐíת·¢Í¼±êÏûÏ¢
Public Const NIF_ICON = &H2 'ͼ±ê¾äºÏ·¨
Public Const NIF_TIP = &H4 'ÔÊÐíÏÔʾͼ±êÌáʾÐÅÏ¢´®
Public Const WM_MOUSEMOVE = &H200 'ÒÔ϶¨ÒåÊó±êÏûÏ¢
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_KEYUP = &H101Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATAPublic Sub AddIconToTaskbar(thishWnd As Long, thisIcon As Long, TaskTip As String) 'Ìí¼Óͼ±êÖÁÈÎÎñÀ¸
Dim I As Integer
With MyIconData
.cbSize = Len(MyIconData)
.hWnd = thishWnd '¶¨Òå´¦Âñ»Øµ÷ÏûÏ¢µÄ´°¿Ú
.uCallbackMessage = WM_MOUSEMOVE '֪ͨͼ±ê·¢ËÍ MouseMove ÏûÏ¢
.uID = 1& '¶¨Òåͼ±êºÅ
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.hIcon = thisIcon '¶¨Òå³ÌÐòÔËÐÐʱÏÔʾµÄͼ±ê
TaskTip = TaskTip + Chr(&H0)
.szTip = TaskTip '¶¨ÒåÏÔʾÎÄ×Ö
End With
If Shell_NotifyIcon(NIM_ADD, MyIconData) = 0 Then 'ÔÚÈÎÎñÀ¸´´½¨Ò»Í¼±ê
' MsgBox "ͼ±ê¼Ù´´½¨Ê§°Ü!"
End If
End Sub
Public Sub ModifyIconToTaskbar(thishWnd As Long, thisIcon As Long, TaskTip As String) 'Ìí¼Óͼ±êÖÁÈÎÎñÀ¸
Dim I As Integer
With MyIconData
.cbSize = Len(MyIconData)
.hWnd = thishWnd '¶¨Òå´¦Âñ»Øµ÷ÏûÏ¢µÄ´°¿Ú
.uCallbackMessage = WM_MOUSEMOVE '֪ͨͼ±ê·¢ËÍ MouseMove ÏûÏ¢
.uID = 1& '¶¨Òåͼ±êºÅ
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.hIcon = thisIcon '¶¨Òå³ÌÐòÔËÐÐʱÏÔʾµÄͼ±ê
TaskTip = TaskTip + Chr(&H0)
.szTip = TaskTip '¶¨ÒåÏÔʾÎÄ×Ö
End With
If Shell_NotifyIcon(NIM_MODIFY, MyIconData) = 0 Then 'ÔÚÈÎÎñÀ¸´´½¨Ò»Í¼±ê
' MsgBox "ͼ±ê¼Ù´´½¨Ê§°Ü!"
End If
End SubPublic Sub DeleteIconFromTaskbar()
If Shell_NotifyIcon(NIM_DELETE, MyIconData) = 0 Then
End If
End SubÓÃÀý£º ''¼ÓÈëÍÐÅÌͼ±ê
AddIconToTaskbar Me.hwnd, Me.Icon, Me.Caption
''ʼþ´¥·¢
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case CLng(X)
Case WM_LBUTTONDBLCLK, WM_LBUTTONUP
Call SetShowStyle
Case 7740 'WM_RBUTTONDOWN
CreatePopMenu
PopupMenu menuFunction
End Select
'MsgBox X
End Sub
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 NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private SysTray As NOTIFYICONDATAPrivate Sub Menu_Click(Index As Integer)
Unload Me
End SubPrivate Sub mnu_Restore_Click()
SysTray.cbSize = Len(SysTray)
SysTray.hWnd = picSysTray(0).hWnd
SysTray.uId = 1&
Shell_NotifyIcon NIM_DELETE, SysTray
Me.Show
App.TaskVisible = True
End SubPrivate Sub mnu_SysTray_Click()
SysTray.cbSize = Len(SysTray)
SysTray.hWnd = picSysTray(0).hWnd
SysTray.uId = 1&
SysTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
SysTray.ucallbackMessage = WM_MOUSEMOVE
SysTray.hIcon = picSysTray(0).Picture
SysTray.szTip = "Shell_NotifyIcon ..." & Chr$(0)
Shell_NotifyIcon NIM_ADD, SysTray
Me.Hide
App.TaskVisible = False
End SubPrivate Sub picSysTray_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Hex(X) = "1E3C" Then
If Button = vbRightButton Then
Me.PopupMenu xx
End If
'End If
End Sub
DoEvents
Call SetForegroundWindow(Me.hwnd)例子:
====================================================
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Hex(X) = "1E3C" Then
DoEvents
Call SetForegroundWindow(Me.hwnd)
Me.PopupMenu menu
End If
End Sub
Public TheForm As Form
Public TheMenu As MenuDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2Public 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 TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = TRAY_CALLBACK Then
' The user clicked on the tray icon.
' Look for click events.
If lParam = WM_RBUTTONUP Then
' On right click, show the menu.
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
' Send other messages to the original
' window proc.
NewWindowProc = CallWindowProc( _
OldWindowProc, hwnd, Msg, _
wParam, lParam)
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
' ShowInTaskbar must be set to False at
' design time because it is read-only at
' run time. ' Save the form and menu for later use.
Set TheForm = frm
Set TheMenu = mnu
' Install the new WindowProc.
OldWindowProc = SetWindowLong(frm.hwnd, _
GWL_WNDPROC, AddressOf NewWindowProc)
' Install the form's icon in the tray.
With TheData
.uID = 0
.hwnd = frm.hwnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON
.uCallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
' Remove the icon from the tray.
With TheData
.uFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData
' Restore the original window proc.
SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
OldWindowProc
End Sub
' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub