在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.HandleModifyMenu 第二個三數 表示更動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。
以下在.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