|
Option Explicit
'在菜单上添加自绘图形的例子
'窗体上添加一个Picture1,一个Command1,一个至少带一个下级菜单的顶级菜单.
'BY 嗷嗷叫的老马
'http://www.m5home.com/
Private Declare Function GetSubMenu Lib "user32.dll" ( _
ByVal hMenu As Long, _
ByVal nPos As Long) As Long
Private Declare Function GetMenu Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32.dll" ( _
ByVal hMenu As Long, _
ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32.dll" ( _
ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long, _
ByVal hBitmapUnchecked As Long, _
ByVal hBitmapChecked As Long) As Long
Private Declare Function DrawIcon Lib "user32.dll" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal hIcon As Long) As Long
Private Const MF_BITMAP As Long = &H4&
Private Sub Command1_Click()
Dim hMenu As Long, hSubMenu As Long, hID As Long
'效果一:绘上当前窗体图标
' DrawIcon Picture1.hdc, -5, -5, Me.Icon.Handle
'效果二:画个小图....
Picture1.Line (1, 1)-(11, 11), vbBlue, B
Picture1.Line (1, 1)-(11, 11), vbRed
Picture1.Line (1, 11)-(11, 1), vbRed
Set Picture1.Picture = Picture1.Image '这一句是关键
hMenu = GetMenu(Me.hwnd)
hSubMenu = GetSubMenu(hMenu, 0)
hID = GetMenuItemID(hSubMenu, 0)
SetMenuItemBitmaps hMenu, hID, MF_BITMAP, Picture1.Picture, Picture1.Picture
End Sub
Private Sub Form_Load()
With Picture1
.Move .Left, .Top, 15 * 15, 15 * 15
.Appearance = 0
.AutoRedraw = True
.ScaleMode = vbPixels
End With
End Sub
|
