如何在系统托盘里面加上图标

Question

不好意思，又问一次,呵呵，我不是要托盘的图标,而是托盘里面的每个菜单项有不同的图标

Answer 1

'-------------------------------------------------
'               让菜单中出现图标一法
'-------------------------------------------------
'               洪恩在线  求知无限
'-------------------------------------------------
'程序应用三个API函数实现了在菜单项中加入小图标
'GetMenu、GetSubMenu、SetMenuItemBitmaps
'-------------------------------------------------
Option Explicit
'【VB声明】
'  Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long'【说明】
'  取得窗口中一个菜单的句柄'【返回值】
'  Long，依附于指定窗口的一个菜单的句柄（如果有菜单）；否则返回零'【参数表】
'  hwnd -----------  Long，窗口句柄。对于vb，这应该是一个窗体句柄。注意可能不是子窗口的句柄
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
'-------------------------------------------------
'【VB声明】
'  Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long'【说明】
'  取得一个弹出式菜单的句柄，它位于菜单中指定的位置'【返回值】
'  Long，位于指定位置的弹出式菜单的句柄（如果有的话）；否则返回零'【参数表】
'  hMenu ----------  Long，菜单的句柄'  nPos -----------  Long，条目在菜单中的位置。第一个条目的编号为0
Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long
'-------------------------------------------------
'【VB声明】
'  Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long'【说明】
'  设置一幅特定位图，令其在指定的菜单条目中使用，代替标准的复选符号（√）。位图的大小必须与菜单复选符号的正确大小相符，这个正确大小可以由GetMenuCheckMarkDimensions函数获得'【返回值】
'  Long，非零表示成功，零表示失败。会设置GetLastError'【备注】
'  使用的位图可能由多个条目共享。一旦不再需要，位图必须由应用程序清除，因为windows不能自动对它进行清除'【参数表】
'  hMenu ----------  Long，菜单句柄'  nPosition ------  Long，欲设置位图的一个菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND，这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION，这个参数就代表菜单条目在菜单中的位置（第一个条目的位置为零）'  wFlags ---------  Long，常数MF_BYCOMMAND或MF_BYPOSITION，取决于nPosition参数'  hBitmapUnchecked -  Long，撤消复选时为菜单条目显示的一幅位图的句柄。如果为零，表示不在未复选状态下显示任何标志'  hBitmapChecked -  Long，复选时为菜单条目显示的一幅位图的句柄。可设为零，表示复选时不显示任何标志。如两个位图句柄的值都是零，则为这个条目恢复使用默认复选位图
Private Declare Function SetMenuItemBitmaps Lib "user32" _
   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
    ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
'-------------------------------------------------Const MF_BYPOSITION = &H400&Private Sub Form_Load()
    Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
    '取得菜单的句柄并赋值给mHandle
    mHandle = GetMenu(hwnd)
    '取得mHandle句柄所指菜单的第一个弹出式菜单（文件&F）的句柄并赋值给sHandle
    sHandle = GetSubMenu(mHandle, 0)
    '将弹出式菜单的第0-4项加上图片，为什么跳过2呢？因为2是分割线
    lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, imOpen.Picture, imSave.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, imSave.Picture, imSave.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, imPrint.Picture, imPrint.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, imPrintSetup.Picture, imPrintSetup.Picture)
    '取得mHandle句柄所指菜单的第二个弹出式菜单（编辑&E）的句柄并赋值给sHandle
    sHandle = GetSubMenu(mHandle, 1)
    '取得sHandle句柄所指菜单的第一个次级菜单（次级菜单&S）的句柄并赋值给sHandle2
    sHandle2 = GetSubMenu(sHandle, 0)
    '将次级菜单中的第1项加上图片
    lRet = SetMenuItemBitmaps(sHandle2, 0, MF_BYPOSITION, imCopy.Picture, imCopy.Picture)
'提示：在SetMenuItemBitmaps（）我们把后两项设为相同的图片，如果设为不同的两张图片会有什么效果呢？
'      原来这两张图片分别表示复选和撤消复选时的状态,你只须在菜单项被点击的函数中加入以下语句：
'      Private Sub mnuOpen_Click()
'       If mnuOpen.Checked = True Then
'       mnuOpen.Checked = False
'       Else: mnuOpen.Checked = True
'       End If
'      End Sub
'      然后在SetMenuItemBitmaps（）我们把后两项设为不同的图片即可，有兴趣的话试一试。
End Sub

Answer 2

http://www.hongen.com/pc/program/apitutor/zip/api0010.zip

Answer 3

托盘程序详解(一)
http://www.hongen.com/pc/program/apitutor/api0012/api01.htm先做好图标菜单，然后PopupMenu TheMenu 即可

Answer 4

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
    
    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