在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