form1.frm

一个 位图菜单的演示程序(例子 )

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Image Image1 
      Appearance      =   0  'Flat
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Left            =   1800
      Picture         =   "Form1.frx":0000
      Stretch         =   -1  'True
      Top             =   1320
      Width           =   285
   End
   Begin VB.Menu M_Main_File 
      Caption         =   "&File"
      Begin VB.Menu M_Item1 
         Caption         =   "      Item0"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin VB.Menu M_Item1 
         Caption         =   "      Item1"
         Checked         =   -1  'True
         Index           =   1
      End
      Begin VB.Menu M_Item2 
         Caption         =   "Item2"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'这是一个演示如何建立位图菜单的程序
'
'                       作者        陈锐
'                       E-Mail      [e-mail]
'                                   [e-mail]
'                       WebSite     http://www.netease.com/~blackcat
Option Explicit

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As _
        Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu _
        As Long, ByVal nPos As Long) As 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
Private Declare Function GetSystemMetrics Lib "user32" _
        (ByVal nIndex As Long) As Long

Const SM_CXMENUCHECK = 71
Const SM_CYMENUCHECK = 72

Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
    Dim hMenuID As Long
    
    '获得系统中菜单核选标记的长度和宽度
    'Image1.Width = GetSystemMetrics(SM_CXMENUCHECK) * _
    '            Screen.TwipsPerPixelX
    'Image1.Height = GetSystemMetrics(SM_CYMENUCHECK) * _
    '            Screen.TwipsPerPixelY
    
    '获得子菜单的句柄
    hMenuID = GetSubMenu(GetMenu(Me.hwnd), 0)
    
    '设置菜单的核选标记位图为Image1
    SetMenuItemBitmaps hMenuID, 0&, MF_BYPOSITION, _
            Image1.Picture.Handle, Image1.Picture.Handle
End Sub