menubmp.frm

vb精彩编程希望大家有用

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "位图菜单"
   ClientHeight    =   3495
   ClientLeft      =   1125
   ClientTop       =   1785
   ClientWidth     =   6180
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3495
   ScaleWidth      =   6180
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2955
      Left            =   60
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "menubmp.frx":0000
      Top             =   180
      Width           =   6015
   End
   Begin VB.Label Label1 
      Caption         =   "菜单中使用的图片："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   3240
      Width           =   2535
   End
   Begin VB.Image imCopy 
      Height          =   195
      Left            =   5880
      Picture         =   "menubmp.frx":00FB
      Top             =   3240
      Width           =   225
   End
   Begin VB.Image imPrintSetup 
      Height          =   225
      Left            =   5520
      Picture         =   "menubmp.frx":03AD
      Top             =   3240
      Width           =   180
   End
   Begin VB.Image imPrint 
      Height          =   210
      Left            =   5160
      Picture         =   "menubmp.frx":060B
      Top             =   3240
      Width           =   240
   End
   Begin VB.Image imSave 
      Height          =   210
      Left            =   4800
      Picture         =   "menubmp.frx":08ED
      Top             =   3240
      Width           =   210
   End
   Begin VB.Image imOpen 
      Height          =   195
      Left            =   4440
      Picture         =   "menubmp.frx":0B97
      Top             =   3240
      Width           =   225
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件&F"
      Begin VB.Menu mnuOpen 
         Caption         =   "打开&O"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存&S"
      End
      Begin VB.Menu Sep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPrint 
         Caption         =   "打印&P"
      End
      Begin VB.Menu mnuPrintSetup 
         Caption         =   "退出&X"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑&E"
      Begin VB.Menu mnuExtra 
         Caption         =   "次级目录&S"
         Begin VB.Menu mnuCopy 
            Caption         =   "复制&C"
         End
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
   '  取得窗口中一个菜单的句柄
    '【返回值】
    '  Long，依附于指定窗口的一个菜单的句柄（如果有菜单）；否则返回零
    '【参数表】
    '  hwnd -----------  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 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，复选时为菜单条目显示的一幅位图的句柄。
    ' 可设为零，表示复选时不显示任何标志。如两个位图句柄的值都是零，
    ' 则为这个条目恢复使用默认复选位图

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