VB6.0的API托盤程序問題

[健叶新吉橙]

VB6.0的API托盤程序問題：
當圖標在任務欄時右擊是如何觸發菜單的，
菜單還要定位對不對啊？
有理論說一上也行，有實例也行。

[daviddivad]

'Download the full source+pictures+... At http://www.geocities.com/SiliconValley/Campus/3636/trayicon.zip
Private 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

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_RBUTTONUP = &H205

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATA
Private Sub Form_Load()
TrayI.cbSize = Len(TrayI)
'Set the window's handle (this will be used to hook the specified window)
TrayI.hWnd = pichook.hWnd
'Application-defined identifier of the taskbar icon
TrayI.uId = 1&
'Set the flags
TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
'Set the callback message
TrayI.ucallbackMessage = WM_LBUTTONDOWN
'Set the picture (must be an icon!)
TrayI.hIcon = imgIcon(2).Picture
'Set the tooltiptext
TrayI.szTip = "Recent" & Chr$(0)
'Create the icon
Shell_NotifyIcon NIM_ADD, TrayI

Me.Hide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'remove the icon
TrayI.cbSize = Len(TrayI)
TrayI.hWnd = pichook.hWnd
TrayI.uId = 1&
Shell_NotifyIcon NIM_DELETE, TrayI
End
End Sub
Private Sub mnuPop_Click(Index As Integer)
Select Case Index
Case 0
MsgBox "KPD-Team 1998" + Chr$(13) + "URL: http://www.allapi.net/" + Chr$(13) + "E-Mail: [e-mail]", vbInformation + vbOKOnly
Case 2
Unload Me
End Select
End Sub
Private Sub pichook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Msg = X / Screen.TwipsPerPixelX
If Msg = WM_LBUTTONDBLCLK Then
'Left button double click
mnuPop_Click 0
ElseIf Msg = WM_RBUTTONUP Then
'Right button click
Me.PopupMenu mnuPopUp
End If
End Sub
Private Sub Timer1_Timer()
Static Tek As Integer
'Animate the icon
Me.Icon = imgIcon(Tek).Picture
TrayI.hIcon = imgIcon(Tek).Picture
Tek = Tek + 1
If Tek = 3 Then Tek = 0
Shell_NotifyIcon NIM_MODIFY, TrayI
End Sub

[yunfeng007]

wk,速度这么快，你真行！^_^

Option Explicit

'
'这是一个将图标添加到WIN的TaskBar的程序，同其他用VB编写的程序不同，这个
'程序可以响应鼠标事件，（其它的很多程序只能将一个图标放在TaskBar上）
'----------------------API Declare-----------------------------------------------------------------------
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 Long
Public Declare 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

'----------------------Type Declare----------------------------------------------------------------------
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

'----------------------Constant Declare------------------------------------------------------------------
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 TPM_LEFTALIGN = &H0&
Public Const TPM_RIGHTBUTTON = &H2&
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 = &H11F
Public Const GWL_WNDPROC = (-4) '替换窗口处理函数

'----------------------User-Defined Declare--------------------------------------------------------------
Private pmenu As Long
Private submenu As Long

Global lproc As Long

Function CMenu(ByVal Frm As Form) As Boolean
'这个函数获得Form的子菜单
Dim L As Long
Dim l1 As Long

pmenu = GetMenu(Frm.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 = "资料伴侣v1.0 cr 所有"
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 Function

Function DialogProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'该函数为Form的窗口处理函数。
Dim L As Long
Dim l1 As Long
Dim po As POINTAPI

Select Case uMsg

Case WM_NOTIFYICON '有鼠标事件产生
Select Case lParam

Case WM_RBUTTONDOWN '按下鼠标右键弹出菜单
If submenu Then
L = GetCursorPos(po) '获的光标位置
'在光标位置处弹出菜单
l1 = TrackPopupMenu(submenu, (TPM_LEFTALIGN Or TPM_RIGHTBUTTON), po.x, po.y, 0, frmTray.hwnd, vbNull)
End If
Case Else
End Select
Case Else
DialogProc = CallWindowProc(lproc, hwnd, uMsg, wParam, lParam)
End Select
End Function

[tanta]

晕~~~vb本身带了一个源程序，编译成控件就可以直接使用，有这么麻烦吗？好象在un什么目录下。

[zyl910]

http://www.fantasiasoft.net/Zyl910/SysTray1.zip
系统托盘编程大全 For VB
作者:zyl910

这个程序包括了所有的托盘程序设计技巧：
1.托盘菜单可以消去
2.Explorer非法操作后能自动恢复图标
3.气泡提示
4.托盘图标的隐藏