图形菜单.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "图形菜单"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   NegotiateMenus  =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Image imgPaste 
      Height          =   240
      Left            =   1860
      Picture         =   "图形菜单.frx":0000
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgCut 
      Height          =   240
      Left            =   1500
      Picture         =   "图形菜单.frx":0102
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgCopy 
      Height          =   240
      Left            =   1080
      Picture         =   "图形菜单.frx":0204
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgSave 
      Height          =   240
      Left            =   780
      Picture         =   "图形菜单.frx":0306
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgOpen 
      Height          =   240
      Left            =   420
      Picture         =   "图形菜单.frx":0408
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Image imgNew 
      Height          =   240
      Left            =   60
      Picture         =   "图形菜单.frx":050A
      Stretch         =   -1  'True
      Top             =   2940
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuNew 
         Caption         =   "&New"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "&Save"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuCopy 
         Caption         =   "&Copy"
      End
      Begin VB.Menu mnuCut 
         Caption         =   "C&ut"
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "&Paste"
      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 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 Const myFlag = &H400&

Private Sub Form_Load()
    Dim mHandle As Long, lRet As Long, sHandle As Long
    
    mHandle = GetMenu(hwnd)
    sHandle = GetSubMenu(mHandle, 0)
    lRet = SetMenuItemBitmaps(sHandle, 0, myFlag, imgNew.Picture, imgNew.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 1, myFlag, imgOpen.Picture, imgOpen.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 2, myFlag, imgSave.Picture, imgSave.Picture)
    sHandle = GetSubMenu(mHandle, 1)
    lRet = SetMenuItemBitmaps(sHandle, 0, myFlag, imgCopy.Picture, imgCopy.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 1, myFlag, imgCut.Picture, imgCut.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 2, myFlag, imgPaste.Picture, imgPaste.Picture)
    
End Sub