有 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