5-3.frm

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form1 
   Caption         =   "图像菜单例程"
   ClientHeight    =   2610
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4155
   LinkTopic       =   "Form1"
   ScaleHeight     =   2610
   ScaleWidth      =   4155
   StartUpPosition =   3  '窗口缺省
   Begin ComctlLib.ImageList ImageList1 
      Left            =   120
      Top             =   360
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   24
      ImageHeight     =   23
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   4
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "5-3.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "5-3.frx":067A
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "5-3.frx":0CF4
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "5-3.frx":136E
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnFile 
      Caption         =   "文件（&F）"
      Begin VB.Menu mnExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnEdit 
      Caption         =   "编辑（&E）"
      Begin VB.Menu mnCut 
         Caption         =   ""
      End
      Begin VB.Menu mnCopy 
         Caption         =   ""
      End
      Begin VB.Menu mnPaste 
         Caption         =   ""
      End
      Begin VB.Menu mnSeparate 
         Caption         =   "-"
      End
      Begin VB.Menu mnFind 
         Caption         =   ""
      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

'API 函数声明
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, _
                    ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long

'常量声明
Private Const MF_BITMAP = &H4&
Private Const MF_BYPOSITION = &H400&
Private Const SRCCOPY = &HCC0020


Private Sub Form_Load()
    Dim lResult As Long
    Dim hMenuID As Long
    Dim hBitmap As Long
    
    
    '获取菜单句柄
    '由于“编辑菜单”是主菜单的第二项，所以
    'nPos 参数取“1”（从“0”开始）
    'GetMenu 函数获取窗体主菜单句柄
    'GetSubMenu 函数获取子菜单句柄
    hMenuID = GetSubMenu(GetMenu(Me.hwnd), 1)
    
    '将 ImageList1 中的图形转换为位图句柄（指针）
    'hBitmap 为位图句柄
    '在 Windows95 中，所有的句柄都是长整形
    hBitmap = ImageList1.ListImages(1).Picture
    
    '修改菜单显示为位图菜单
    'GetMenuItemID 函数返回指定子菜单在菜单链表中的位置
    '如：GetMenuItemID(hMenuID, 0) 返回“4”，
    '即“Cut”子菜单是菜单链表中的第4项（从菜单编辑器中可见）
    lResult = ModifyMenu(hMenuID, 0, MF_BYPOSITION Or MF_BITMAP, GetMenuItemID(hMenuID, 0), hBitmap)

    hBitmap = ImageList1.ListImages(2).Picture
    lResult = ModifyMenu(hMenuID, 1, MF_BYPOSITION Or MF_BITMAP, GetMenuItemID(hMenuID, 1), hBitmap)

    hBitmap = ImageList1.ListImages(3).Picture
    lResult = ModifyMenu(hMenuID, 2, MF_BYPOSITION Or MF_BITMAP, GetMenuItemID(hMenuID, 2), hBitmap)

    hBitmap = ImageList1.ListImages(4).Picture
    lResult = ModifyMenu(hMenuID, 4, MF_BYPOSITION Or MF_BITMAP, GetMenuItemID(hMenuID, 4), hBitmap)
End Sub

Private Sub Line1_Click(Index As Integer)
    MsgBox "选择线宽：" + Str(Index), , "提示"
End Sub

Private Sub mnCopy_Click()
    MsgBox "选择了“复制”菜单", , "提示"
End Sub

Private Sub mnCut_Click()
    MsgBox "选择了“剪切”菜单", , "提示"
End Sub

Private Sub mnExit_Click()
    Unload Me
End Sub

Private Sub mnFind_Click()
    MsgBox "选择了“取消”菜单", , "提示"
End Sub

Private Sub mnPaste_Click()
    MsgBox "选择了“粘贴菜单”", , "提示"
End Sub