iconmenu.frm

来自「很好的教程原代码！」· FRM 代码 · 共 137 行

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  'Windows Default
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   240
      Index           =   3
      Left            =   2760
      Picture         =   "IconMenu.frx":0000
      ScaleHeight     =   240
      ScaleWidth      =   240
      TabIndex        =   3
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   240
      Index           =   2
      Left            =   2040
      Picture         =   "IconMenu.frx":0102
      ScaleHeight     =   240
      ScaleWidth      =   240
      TabIndex        =   2
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   240
      Index           =   1
      Left            =   1320
      Picture         =   "IconMenu.frx":024C
      ScaleHeight     =   240
      ScaleWidth      =   240
      TabIndex        =   1
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   240
      Index           =   0
      Left            =   720
      Picture         =   "IconMenu.frx":0396
      ScaleHeight     =   240
      ScaleWidth      =   240
      TabIndex        =   0
      Top             =   1800
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFaceSel 
         Caption         =   "新建(N)"
         Index           =   0
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "打开(&O)"
         Index           =   1
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "保存(&S)"
         Index           =   2
      End
      Begin VB.Menu mnuFaceSel 
         Caption         =   "关闭(&C)"
         Index           =   3
      End
      Begin VB.Menu mnuSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&E)"
      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)), 0)
    
    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)
        lResult = SetMenuItemBitmaps(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_STRING, _
                  hBitmap, hBitmap)
    Next nLoopCtr
    
    lResult = DeleteDC(hTempDC)
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub