'1个Picture 控件 picture属性必须是个ico 或cur 文件 Public Declare Function MSS Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As LongPublic Declare Function GetDesktopWindow Lib "user32" () As Long Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const WM_MOUSEMOVE = &H200 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean Public t As NOTIFYICONDATAPublic Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Type POINTAPI X As Long Y As Long End Type 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 Type Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare 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 LongPublic Const SWP_NOSIZE = &H1 Public Const HWND_TOPMOST = -1 Public Const SWP_NOMOVE = &H2Public Const SWP_FRAMECHANGED = &H20Function Icon_Del(ihwnd As Long) As Long Dim ano As NOTIFYICONDATA Dim l As Long
ano.hwnd = ihwnd ano.uID = 0 ano.cbSize = Len(ano) '删除图标 Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano) End Function'以上在模块中 Sub TuoPan() 'On Error Resume Next Dim t As NOTIFYICONDATA t.cbSize = Len(t) t.hwnd = Picture1.hwnd t.uID = 1& t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE t.uCallbackMessage = WM_MOUSEMOVE t.hicon = Picture1.Picture t.szTip = "我的托盘" & Chr$(0) Shell_NotifyIcon NIM_ADD, t private From_load call tuopan end sub private From_Unload call Call Icon_Del(Me.hwnd)end sub
'对不起 刚才我没看清楚 应该这样 Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Hex(X) = "1E3C" And Me.Visible = False Then …… End If End Sub
'狂晕 我随手复制多了! 对不起哈 Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Hex(X) = "1E3C" False Then '这个是右击触发的 这放你的代码 End If End Sub
建立一个模块 '------------------------ By 陈锐 ------------------------------------ '如果你要在Internet或BBS上转贴程序,请通知我本人知道 '请参观我的网址 http://www.nease.net/~blackcat '我的EMail是[email protected]或[email protected] ' '这是一个将图标添加到WIN95的TaskBar的程序,同其他用VB编写的程序不同,这个 '程序可以响应鼠标事件,(其它的很多程序只能将一个图标放在TaskBar上)Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hicon As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongPublic Type POINTAPI x As Long y As Long End TypePublic 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 Type 'uFlags : 这个成员标志着其他哪些成员的数据是有效的, '分别为NIF_ICON, NIF_MESSAGE, NIF_TIP, '分别代表着数据有效的成员是hIcon, uCallbackMessage, szTip。 '当然,三个值可以用“Or”联系到一起。 Public Const NIM_ADD = 0 '添加图标 Public Const NIM_MODIFY = 1 '修改图标 Public Const NIM_DELETE = 2 '删除图标Public Const NIF_MESSAGE = 1 '当有鼠标事件发生时产生消息 Public Const NIF_ICON = 2 ' Public Const NIF_TIP = 4 '图标有提示字符串 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_USER = &H400 Public Const WM_NOTIFYICON = WM_USER + &H100 Public Const WM_COMMAND = &H111 Public Const WM_DESTROY = &H2 Public Const WM_DRAWITEM = &H2B Public Const WM_INITDIALOG = &H110 Public Const WM_PAINT = &HF Public Const WM_MENUSELECT = &H11FPublic Const GWL_WNDPROC = (-4) '替换窗口处理函数Dim pmenu As Long Dim submenu As LongGlobal lproc As Long Function CMenu() As Boolean '这个函数获得Form1的子菜单 Dim l As Long Dim l1 As Long
pmenu = GetMenu(Form1.hwnd) submenu = GetSubMenu(pmenu, 0) If submenu Then CMenu = True Else CMenu = False End If End Function Function Icon_Del(ihwnd As Long) As Long Dim ano As NOTIFYICONDATA Dim l As Long
ano.hwnd = ihwnd ano.uID = 0 ano.cbSize = Len(ano) '删除图标 Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano) End Function '这个函数接收图标句柄和窗口句柄并且新建图标 Function Icon_Add(ihwnd As Long, hicon As Long) As Long Dim ano As NOTIFYICONDATA Dim astr As String
'为图标添加提示行 astr = LTrim$(InputBox$("Input the tips you wanted to add.")) ano.szTip = astr + Chr$(0) '设置消息接收窗口 ano.hwnd = ihwnd ano.uID = 0 '图标有提示并且可以发送消息 ano.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE ano.hicon = hicon ano.cbSize = Len(ano) '将图标的回调消息设置为WM_NOTIFYICON,当在图标区域有鼠标消息,系统就会向 '消息接收窗口发送WM_NOTIFYICON消息。 ano.uCallbackMessage = WM_NOTIFYICON Icon_Add = Shell_NotifyIcon(NIM_ADD, ano) End FunctionFunction DialogProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '该函数为Form2的窗口处理函数。 Dim l As Long Dim l1 As Long Dim po As POINTAPI
Select Case uMsg Case WM_INITDIALOG Case WM_DESTROY Case WM_COMMAND Case WM_DRAWITEM Case WM_NOTIFYICON '有鼠标事件产生 Select Case lParam Case WM_LBUTTONDOWN '按下鼠标左键 '提示是否删除图标 l = MsgBox("Delete icon?", vbYesNo) If l = vbYes Then '删除图标同时恢复窗口处理函数 l = Icon_Del(hwnd) l = SetWindowLong(Form2.hwnd, GWL_WNDPROC, lproc) Form1.Show Else End If Case WM_RBUTTONDOWN '按下鼠标右键弹出菜单 If submenu Then l = GetCursorPos(po) '获的光标位置 '在光标位置处弹出菜单 l1 = TrackPopupMenu(submenu, (TPM_LEFTALIGN Or TPM_RIGHTBUTTON), po.x, po.y, 0, Form1.hwnd, vbNull) End If Case Else End Select Case Else DialogProc = False End Select DialogProc = True End Function 下面这句修改窗体默认窗口过程,放入Form_Load中就行 lproc = SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf DialogProc)实际上,上面的Module并不完美,有点繁琐,可参考VB光盘中自带的SysTray控件。
Public Declare Function MSS Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As LongPublic Declare Function GetDesktopWindow Lib "user32" () As Long
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Public t As NOTIFYICONDATAPublic Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
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 Type
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare 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 LongPublic Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2Public Const SWP_FRAMECHANGED = &H20Function Icon_Del(ihwnd As Long) As Long
Dim ano As NOTIFYICONDATA
Dim l As Long
ano.hwnd = ihwnd
ano.uID = 0
ano.cbSize = Len(ano)
'删除图标
Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano)
End Function'以上在模块中
Sub TuoPan()
'On Error Resume Next
Dim t As NOTIFYICONDATA
t.cbSize = Len(t)
t.hwnd = Picture1.hwnd
t.uID = 1&
t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.uCallbackMessage = WM_MOUSEMOVE
t.hicon = Picture1.Picture
t.szTip = "我的托盘" & Chr$(0)
Shell_NotifyIcon NIM_ADD, t
private From_load
call tuopan
end sub
private From_Unload
call Call Icon_Del(Me.hwnd)end sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Hex(X) = "1E3C" And Me.Visible = False Then ……
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Hex(X) = "1E3C" False Then '这个是右击触发的
这放你的代码
End If
End Sub
'------------------------ By 陈锐 ------------------------------------
'如果你要在Internet或BBS上转贴程序,请通知我本人知道
'请参观我的网址 http://www.nease.net/~blackcat
'我的EMail是[email protected]或[email protected]
'
'这是一个将图标添加到WIN95的TaskBar的程序,同其他用VB编写的程序不同,这个
'程序可以响应鼠标事件,(其它的很多程序只能将一个图标放在TaskBar上)Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hicon As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongPublic Type POINTAPI
x As Long
y As Long
End TypePublic 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 Type
'uFlags : 这个成员标志着其他哪些成员的数据是有效的,
'分别为NIF_ICON, NIF_MESSAGE, NIF_TIP,
'分别代表着数据有效的成员是hIcon, uCallbackMessage, szTip。
'当然,三个值可以用“Or”联系到一起。
Public Const NIM_ADD = 0 '添加图标
Public Const NIM_MODIFY = 1 '修改图标
Public Const NIM_DELETE = 2 '删除图标Public Const NIF_MESSAGE = 1 '当有鼠标事件发生时产生消息
Public Const NIF_ICON = 2 '
Public Const NIF_TIP = 4 '图标有提示字符串
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_USER = &H400
Public Const WM_NOTIFYICON = WM_USER + &H100
Public Const WM_COMMAND = &H111
Public Const WM_DESTROY = &H2
Public Const WM_DRAWITEM = &H2B
Public Const WM_INITDIALOG = &H110
Public Const WM_PAINT = &HF
Public Const WM_MENUSELECT = &H11FPublic Const GWL_WNDPROC = (-4) '替换窗口处理函数Dim pmenu As Long
Dim submenu As LongGlobal lproc As Long
Function CMenu() As Boolean
'这个函数获得Form1的子菜单
Dim l As Long
Dim l1 As Long
pmenu = GetMenu(Form1.hwnd)
submenu = GetSubMenu(pmenu, 0)
If submenu Then
CMenu = True
Else
CMenu = False
End If
End Function
Function Icon_Del(ihwnd As Long) As Long
Dim ano As NOTIFYICONDATA
Dim l As Long
ano.hwnd = ihwnd
ano.uID = 0
ano.cbSize = Len(ano)
'删除图标
Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano)
End Function
'这个函数接收图标句柄和窗口句柄并且新建图标
Function Icon_Add(ihwnd As Long, hicon As Long) As Long
Dim ano As NOTIFYICONDATA
Dim astr As String
'为图标添加提示行
astr = LTrim$(InputBox$("Input the tips you wanted to add."))
ano.szTip = astr + Chr$(0)
'设置消息接收窗口
ano.hwnd = ihwnd
ano.uID = 0
'图标有提示并且可以发送消息
ano.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
ano.hicon = hicon
ano.cbSize = Len(ano)
'将图标的回调消息设置为WM_NOTIFYICON,当在图标区域有鼠标消息,系统就会向
'消息接收窗口发送WM_NOTIFYICON消息。
ano.uCallbackMessage = WM_NOTIFYICON
Icon_Add = Shell_NotifyIcon(NIM_ADD, ano)
End FunctionFunction DialogProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'该函数为Form2的窗口处理函数。
Dim l As Long
Dim l1 As Long
Dim po As POINTAPI
Select Case uMsg
Case WM_INITDIALOG
Case WM_DESTROY
Case WM_COMMAND
Case WM_DRAWITEM
Case WM_NOTIFYICON '有鼠标事件产生
Select Case lParam
Case WM_LBUTTONDOWN '按下鼠标左键
'提示是否删除图标
l = MsgBox("Delete icon?", vbYesNo)
If l = vbYes Then
'删除图标同时恢复窗口处理函数
l = Icon_Del(hwnd)
l = SetWindowLong(Form2.hwnd, GWL_WNDPROC, lproc)
Form1.Show
Else
End If
Case WM_RBUTTONDOWN '按下鼠标右键弹出菜单
If submenu Then
l = GetCursorPos(po) '获的光标位置
'在光标位置处弹出菜单
l1 = TrackPopupMenu(submenu, (TPM_LEFTALIGN Or TPM_RIGHTBUTTON), po.x, po.y, 0, Form1.hwnd, vbNull)
End If
Case Else
End Select
Case Else
DialogProc = False
End Select
DialogProc = True
End Function
下面这句修改窗体默认窗口过程,放入Form_Load中就行
lproc = SetWindowLong(Form2.hwnd, GWL_WNDPROC, AddressOf DialogProc)实际上,上面的Module并不完美,有点繁琐,可参考VB光盘中自带的SysTray控件。
[email protected]
------------------------------------------------------------
给我也来一份 [email protected]