pre>在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)
於是呢，我 艘桓鯣etBitMapHandle 来取得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
 |
频道声明：本频道的文章除部分特别声明禁止转载的专稿外，可以自由转载.但请务必注明出出处和原始作者 文章版权归本频道与文章作者所有.对于被频道转载文章的个人和网站,我们表示深深的谢意。
| 原始作者:佚名 |
录入时间:2007-1-23 1:20:07 |
| 信息来源:不详 |
投稿信箱:itqoo@126.com |
|
|
 |
|
用户登录 
新用户注册 
网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！） 