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 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 Long
Dim TrayIcon As NOTIFYICONDATA, bolFlag As Boolean
Private 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 Sub
Private 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 Sub
Private 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 Sub
'-------------------------------------------------
' 让菜单中出现图标一法
'-------------------------------------------------
' 洪恩在线 求知无限
'-------------------------------------------------
'程序应用三个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
' 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