form1.frm

vb 窗体实例 都是自己的例子

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "带图标的菜单"
   ClientHeight    =   2895
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   3300
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2895
   ScaleWidth      =   3300
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   405
      Left            =   900
      Picture         =   "Form1.frx":000C
      TabIndex        =   2
      Top             =   1965
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "去除图标"
      Height          =   405
      Left            =   900
      Picture         =   "Form1.frx":3890
      TabIndex        =   1
      Top             =   1275
      Width           =   1335
   End
   Begin VB.CommandButton command1 
      Caption         =   "添加图标"
      Height          =   405
      Left            =   900
      Picture         =   "Form1.frx":7114
      TabIndex        =   0
      Top             =   570
      Width           =   1335
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   210
      Top             =   345
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   48
      ImageHeight     =   48
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":A998
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":B2EC
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":BC40
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu menu 
      Caption         =   "工具"
      Begin VB.Menu hb 
         Caption         =   "画笔"
      End
      Begin VB.Menu xp 
         Caption         =   "橡皮"
      End
      Begin VB.Menu kd 
         Caption         =   "刻刀"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 GetMenuItemID 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

Const MF_bitmap = &H4&

Private Sub Command1_Click()
'为菜单添加图标
  Dim i As Integer
  Dim menu1 As Long
  Dim menuID As Long
  menu1 = GetMenu(Me.hwnd)
  For i = 1 To 3
    menuID = GetMenuItemID(GetSubMenu(menu1, 0), i - 1)
    SetMenuItemBitmaps menu1, menuID, MF_bitmap, ImageList1.ListImages(i).Picture, _
                       ImageList1.ListImages(i).Picture
  Next
'弹出式菜单
  PopupMenu menu, 0, X, Y
End Sub

Private Sub Command2_Click()
'去除菜单的图标
  Dim i As Integer
  Dim menu1 As Long
  Dim menuID As Long
  menu1 = GetMenu(Me.hwnd)
  For i = 1 To 3
    menuID = GetMenuItemID(GetSubMenu(menu1, 0), i - 1)
    SetMenuItemBitmaps menu1, menuID, MF_bitmap, 0, 0
  Next
'弹出式菜单
  PopupMenu menu, 0, X, Y
End Sub

Private Sub Command3_Click()
'退出程序
  End
End Sub