有 BitMap 之Menu

来源:cww

在Window API中，有一些名词要先清楚，假设有一功能表如下：

档案   编辑	选项  --> hMenu    (功能表)
      +-------+
      |复制   |---------> hSubMenu (子功能表)
      |贴上   |
      |减下 -------------> MenuID   (功能表项目)
      |       |
      +-------+

如果，我们使用vb的功能表编辑器做出上面的Menu，那 hMenu的取得使用GetMenu() API
，而hSubMenu 的取得是 GetSubMenu，而GetSubMenu()的第二个叁数指的是功能表的第
几个子功能表，以上例来说，编辑子功能表是第1个子功能表(以0为基准)，所以编辑子
功能表的取得应用以下的呼叫 ：

hMenu = GetMenu(Me.hwnd)
hSubMenu = GetSubMenu(hMenu, 1) '取得编辑子功能表的hSubMenu

而功能表项目则由以下的呼叫取得，第二叁数指的是该子功能表的第几个项目(以0
开始)，故复制 功能表项目 = 0  减下 = 2

MenuId = GetMenuItemID(hSubMenu, 0) '取得复制 的hMenuId

接着便是以ModifyMenu来更动MenuId成BitMap的方式

Set Pic1 = LoadPicture("E:\cli.bmp")
ModifyMenu hSubMenu, 0, MF_BITMAP Or MF_BYPOSITION, MenuId, pic1.Handle

ModifyMenu 第二个叁数  表示更动hSubMenu所指的子功能表中第几个功能表项目
	   第三个叁数  MF_BITMAP 表示用BitMap的方式显示
		       MF_STRING 表示用字串方式显示
		       MF_BYPOSITION 表示第二个叁数的值代表是依位置来算
	   第四个叁数  MenuId
	   第五个叁数  显示图的hBitMap

另外，如何做到MenuItem的左方有一小Bitmap，右方仍是字串呢，使用以下的API

 SetMenuItemBitmaps(

    hSubMenu as Long ,	   // handle of 子功能表
    uItem    as Long ,	   // 更动第几个Menu Item
    fuFlags as Long,	   // menu item flags
    hbmUnchecked as Long,  // handle of unchecked bitmap
    hbmChecked as Long	   // handle of checked bitmap
   )

Set Pic2 = LoadPicture("e:\cli2.BitMap")

Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION,pic2.Handle, Pic2.Handle)

这里有一个地方要特别注意，到底hbmUnchecked/hbmchecked 所指的BitMap图有多大呢，
如果pic2所放入的BitMap太大，那不会出现我们想要的图，那得自己想办法缩图；而使
用以下的API可以取得Menu Item左边Bitmap图的大小(By Pixels)

i = GetMenuCheckMarkDimensions
wd5 = i Mod 2 ^ 16  '宽
hi5 = i / 2 ^ 16    '高

而我们Load进来的图之宽 Me.ScaleX(pic2.Width, vbHimetric, vbPixels)
		    高 Me.ScaleY(pic2.Height, vbHimetric, vbPixels)

於是呢，我写了一个GetBitMapHandle 来取得hbmUnchecked/hbmchecked所需的BitMap
Handle，而且该hBitMap所指的图，大小刚好是系统内定的大小，而不必在乎原始的图
有多大，当然了，一定要使用BitMap图，不可使用icon/gif等之类的图，这是什麽原
因呢，这是因为我使用StdPicture物件来开启图形档，如果图形档是BitMap图，那麽，
stdPicture物件的Handle属性便是hBitmap。
而要看得懂我GetBitMapHandle的程式，首先请先查阅我另一篇文章Memory Dc与hBitmap

'以下在.bas
Option Explicit

Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const MF_BITMAP = &H4&
Public Const MF_STRING = &H0&

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
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
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
Declare Function GetMenuCheckMarkDimensions Lib "user32" () As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
	 ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
	 ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long


 Const SRCCOPY = &HCC0020
 Public TheForm As Form
 Public Function GetBitMapHandle(ByVal FileName As String)
 Dim dstWidth As Long, dstHeight As Long
 Dim srcWidth As Long, srcHeight As Long
 Dim x As Long, y As Long
 Dim pic As New StdPicture
 Dim hDc5 As Long, i As Long
 Dim hBitmap As Long
 Dim hDstDc As Long

 Set pic = LoadPicture(FileName) '读取图形档
 hDc5 = CreateCompatibleDC(0) '建立Memory DC
 i = SelectObject(hDc5, pic.Handle) '在该memoryDC上放上bitmap图

 i = GetMenuCheckMarkDimensions '取得SetMenuItemBitmaps 所需Bitmap大小
 dstWidth = i Mod 2 ^ 16
 dstHeight = i / 2 ^ 16

 '建一个大小为dstWidh * dstHeight大小的Bitmap
 hBitmap = CreateCompatibleBitmap(TheForm.hdc, dstWidth, dstHeight)
 hDstDc = CreateCompatibleDC(TheForm.hdc) '建memory dc
 '设该memory dc的绘图区大小=该bitmap大小，且在该memory dc上的绘图便是在
 '该bitmap图上画图
 SelectObject hDstDc, hBitmap

 srcHeight = TheForm.ScaleY(pic.Height, vbHimetric, vbPixels)
 srcWidth = TheForm.ScaleX(pic.Width, vbHimetric, vbPixels)

 Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
 GetBitMapHandle = hBitmap
 Call DeleteDC(hDc5)
 Call DeleteDC(hDstDc)
 End Function

'以下在Form
Option Explicit
Private hMenu As Long
Private hSubMenu As Long
Private MenuId As Long
Private pic1 As New StdPicture
Private pic2 As New StdPicture
Dim hBitmap As Long

Private Sub Form_Load()
Set TheForm = Me
Set pic1 = LoadPicture("e:\cli.bmp")
hMenu = GetMenu(Me.hwnd)
hSubMenu = GetSubMenu(hMenu, 1)
MenuId = GetMenuItemID(hSubMenu, 1)
ModifyMenu hSubMenu, 0, MF_BITMAP Or MF_BYPOSITION, MenuId, pic1.Handle
hBitmap = GetBitMapHandle("e:\cli.bmp")
Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, hBitmap, hBitmap)
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteObject hBitmap
End Sub