iconmenu.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3510
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   ScaleHeight     =   3510
   ScaleWidth      =   5490
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   3
      Left            =   2760
      Picture         =   "IconMenu.frx":0000
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   3
      Top             =   1800
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   2
      Left            =   2040
      Picture         =   "IconMenu.frx":030A
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   2
      Top             =   1800
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   1
      Left            =   1320
      Picture         =   "IconMenu.frx":074C
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   1
      Top             =   1800
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   0
      Left            =   600
      Picture         =   "IconMenu.frx":0B8E
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   0
      Top             =   1800
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu mnuFace 
      Caption         =   "脸谱(&A)"
      Begin VB.Menu mnuFaceSel 
         Caption         =   "正常(N)"
         Index           =   0
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "微笑(&S)"
         Index           =   1
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "大笑(&L)"
         Index           =   2
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "悲伤(&O)"
         Index           =   3
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    Dim nLoopCtr As Integer
    Dim lResult As Long
    Dim hTempDC As Long
    Dim nWidth As Integer
    Dim nHeight As Integer
    Dim lTempID As Long
    Dim hMenuID As Long
    Dim lItemCount As Long
    Dim hBitmap As Long
    
    nWidth = Picture1(nLoopCtr).Width \ Screen.TwipsPerPixelX
    nHeight = Picture1(nLoopCtr).Height \ Screen.TwipsPerPixelY
    hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1)
    
    hTempDC = CreateCompatibleDC(Picture1(nLoopCtr).hdc)
    
    For nLoopCtr = 0 To 3
        hBitmap = CreateCompatibleBitmap(Picture1(nLoopCtr).hdc, nWidth, nHeight)
        lTempID = SelectObject(hTempDC, hBitmap)
        lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, (Picture1(nLoopCtr).hdc), _
                  0, 0, SRCCOPY)
        lTempID = SelectObject(hTempDC, lTempID)
        mnuFaceSel(nLoopCtr).Caption = ""
        lResult = ModifyMenu(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_BITMAP, _
                  GetMenuItemID(hMenuID, nLoopCtr), hBitmap)
    Next nLoopCtr
    
    lResult = DeleteDC(hTempDC)
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub