home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch12 / menubmp / menubmp.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-20  |  5.0 KB  |  135 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Menu with Bitmap Graphics"
  4.    ClientHeight    =   2070
  5.    ClientLeft      =   165
  6.    ClientTop       =   735
  7.    ClientWidth     =   4680
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   2070
  10.    ScaleWidth      =   4680
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.PictureBox Picture1 
  13.       AutoRedraw      =   -1  'True
  14.       AutoSize        =   -1  'True
  15.       BorderStyle     =   0  'None
  16.       Height          =   735
  17.       Left            =   480
  18.       ScaleHeight     =   735
  19.       ScaleWidth      =   975
  20.       TabIndex        =   0
  21.       Top             =   1080
  22.       Visible         =   0   'False
  23.       Width           =   975
  24.    End
  25.    Begin VB.Label Label1 
  26.       Caption         =   "This menu has both graphics and text."
  27.       Height          =   375
  28.       Left            =   840
  29.       TabIndex        =   1
  30.       Top             =   600
  31.       Width           =   3015
  32.    End
  33.    Begin VB.Menu Bitmaps 
  34.       Caption         =   "Bitmaps"
  35.       Begin VB.Menu MyMenu 
  36.          Caption         =   "Menu1"
  37.          Index           =   0
  38.       End
  39.       Begin VB.Menu MyMenu 
  40.          Caption         =   "Menu2"
  41.          Index           =   1
  42.       End
  43.       Begin VB.Menu Exit 
  44.          Caption         =   "Exit"
  45.          Index           =   1
  46.       End
  47.    End
  48. Attribute VB_Name = "Form1"
  49. Attribute VB_GlobalNameSpace = False
  50. Attribute VB_Creatable = False
  51. Attribute VB_PredeclaredId = True
  52. Attribute VB_Exposed = False
  53. Option Explicit
  54. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  55. Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, _
  56.     ByVal nPos As Long) As Long
  57. Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, _
  58.     ByVal nPos As Long) As Long
  59. Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
  60.     (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
  61.     ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
  62. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  63. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
  64.     ByVal nWidth As Long, ByVal nHeight As Long) As Long
  65. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
  66.     ByVal hObject As Long) As Long
  67. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
  68.     ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
  69.     ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) _
  70.     As Long
  71. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  72. Const SRCCOPY = &HCC0020
  73. Const MF_BYPOSITION = &H400&
  74. Const MF_BITMAP = &H4&
  75. Private Sub Exit_Click(Index As Integer)
  76.     Unload Me
  77. End Sub
  78. Private Sub Form_Load()
  79.     Dim Width As Integer
  80.     Dim Height As Integer
  81.     Dim hTmpDC As Long
  82.     Dim hMenuID As Long
  83.     Dim hBitmap As Long
  84.     Dim retValue As Long
  85.     Dim tmpID As Long
  86.     Dim fileName As String
  87.     Dim menuPos As Integer
  88.     Dim menuID As Long
  89.     'Set menu position and file name
  90.     menuPos = 0
  91.     fileName = App.Path & "\face03.ico"
  92.     Picture1.Picture = LoadPicture(fileName)
  93.     Width = Picture1.Width / Screen.TwipsPerPixelX
  94.     Height = Picture1.Height / Screen.TwipsPerPixelY
  95.     'Get handle to menu
  96.     hMenuID = GetSubMenu(GetMenu(Me.hwnd), menuPos)
  97.     'Create device context to store bitmap
  98.     hTmpDC = CreateCompatibleDC(Picture1.hdc)
  99.         
  100.     'Create the bitmap for the picture
  101.     hBitmap = CreateCompatibleBitmap(Picture1.hdc, Width, Height)
  102.                     
  103.     'Select bitmap into temporary dc
  104.     tmpID = SelectObject(hTmpDC, hBitmap)
  105.     'Copy contents from picture control to DC
  106.     retValue = BitBlt(hTmpDC, 0, 0, Width, Height, Picture1.hdc, _
  107.                         0, 0, SRCCOPY)
  108.                         
  109.     'Deselect bitmap
  110.     tmpID = SelectObject(hTmpDC, tmpID)
  111.     'Modify the menu
  112.     menuID = GetMenuItemID(hMenuID, menuPos)
  113.     retValue = ModifyMenu(hMenuID, menuPos, MF_BYPOSITION Or MF_BITMAP, _
  114.                             menuID, hBitmap)
  115.     'Second menu item
  116.     menuPos = 1
  117.     fileName = App.Path & "\donuts.ico"
  118.     Picture1.Picture = LoadPicture(fileName)
  119.      'Create the bitmap for the picture
  120.     hBitmap = CreateCompatibleBitmap(Picture1.hdc, Width, Height)
  121.                     
  122.     'Select bitmap into temporary dc
  123.     tmpID = SelectObject(hTmpDC, hBitmap)
  124.     retValue = BitBlt(hTmpDC, 0, 0, Width, Height, Picture1.hdc, _
  125.                         0, 0, SRCCOPY)
  126.                         
  127.     tmpID = SelectObject(hTmpDC, tmpID)
  128.     menuID = GetMenuItemID(hMenuID, menuPos)
  129.     retValue = ModifyMenu(hMenuID, menuPos, MF_BYPOSITION Or MF_BITMAP, _
  130.                             menuID, hBitmap)
  131.                             
  132.     'Clean up
  133.     retValue = DeleteDC(hTmpDC)
  134. End Sub
  135.