|
VB打造超酷個(gè)性化菜單（三）
現(xiàn)在到了最關(guān)鍵，最精彩，也是最復(fù)雜的部分了。我們最關(guān)心的就是怎樣“畫”菜單，怎樣處理菜單事件，在MenuWndProc這個(gè)處理消息的函數(shù)里，我們要處理如下消息：WM_COMMAND（單擊菜單項(xiàng)），WM_MEASUREITEM（處理菜單高度和寬度），WM_MENUSELECT（選擇菜單項(xiàng)），WM_DRAWITEM（繪制菜單項(xiàng)）。
打開上次建好的工程，添加一個(gè)標(biāo)準(zhǔn)模塊，并將其名稱設(shè)置為mMenu，代碼如下：
'**************************************************************************************************************
'* 本模塊配合 cMenu 菜單類模塊
'*
'* 版權(quán): LPP軟件工作室
'* 作者: 盧培培(goodname008)
'* (******* 復(fù)制請保留以上信息 *******)
'**************************************************************************************************************
Option Explicit
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 函數(shù)聲明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 常量聲明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Public Const GWL_WNDPROC = (-4) ' SetWindowLong 設(shè)置窗口函數(shù)入口地址
Public Const SM_CYMENU = 15 ' GetSystemMetrics 獲得系統(tǒng)菜單項(xiàng)高度
Public Const WM_COMMAND = &H111 ' 消息: 單擊菜單項(xiàng)
Public Const WM_DRAWITEM = &H2B ' 消息: 繪制菜單項(xiàng)
Public Const WM_EXITMENULOOP = &H212 ' 消息: 退出菜單消息循環(huán)
Public Const WM_MEASUREITEM = &H2C ' 消息: 處理菜單高度和寬度
Public Const WM_MENUSELECT = &H11F ' 消息: 選擇菜單項(xiàng)
' ODT
Public Const ODT_MENU = 1 ' 菜單
Public Const ODT_LISTBOX = 2 ' 列表框
Public Const ODT_COMBOBOX = 3 ' 組合框
Public Const ODT_BUTTON = 4 ' 按鈕
' ODS
Public Const ODS_SELECTED = &H1 ' 菜單被選擇
Public Const ODS_GRAYED = &H2 ' 灰色字
Public Const ODS_DISABLED = &H4 ' 禁用
Public Const ODS_CHECKED = &H8 ' 選中
Public Const ODS_FOCUS = &H10 ' 聚焦
' diFlags to DrawIconEx
Public Const DI_MASK = &H1 ' 繪圖時(shí)使用圖標(biāo)的MASK部分 (如單獨(dú)使用, 可獲得圖標(biāo)的掩模)
Public Const DI_IMAGE = &H2 ' 繪圖時(shí)使用圖標(biāo)的XOR部分 (即圖標(biāo)沒有透明區(qū)域)
Public Const DI_NORMAL = DI_MASK Or DI_IMAGE ' 用常規(guī)方式繪圖 (合并 DI_IMAGE 和 DI_MASK)
' nBkMode to SetBkMode
Public Const TRANSPARENT = 1 ' 透明處理, 即不作上述填充
Public Const OPAQUE = 2 ' 用當(dāng)前的背景色填充虛線畫筆、陰影刷子以及字符的空隙
Public Const NEWTRANSPARENT = 3 ' 在有顏色的菜單上畫透明文字
' MF 菜單相關(guān)常數(shù)
Public Const MF_BYCOMMAND = &H0& ' 菜單條目由菜單的命令I(lǐng)D指定
Public Const MF_BYPOSITION = &H400& ' 菜單條目由條目在菜單中的位置決定 (零代表菜單中的第一個(gè)條目)
Public Const MF_CHECKED = &H8& ' 檢查指定的菜單條目 (不能與VB的Checked屬性兼容)
Public Const MF_DISABLED = &H2& ' 禁止指定的菜單條目 (不與VB的Enabled屬性兼容)
Public Const MF_ENABLED = &H0& ' 允許指定的菜單條目 (不與VB的Enabled屬性兼容)
Public Const MF_GRAYED = &H1& ' 禁止指定的菜單條目, 并用淺灰色描述它. (不與VB的Enabled屬性兼容)
Public Const MF_HILITE = &H80&
Public Const MF_SEPARATOR = &H800& ' 在指定的條目處顯示一條分隔線
Public Const MF_STRING = &H0& ' 在指定的條目處放置一個(gè)字串 (不與VB的Caption屬性兼容)
Public Const MF_UNCHECKED = &H0& ' 檢查指定的條目 (不能與VB的Checked屬性兼容)
Public Const MF_UNHILITE = &H0&
Public Const MF_BITMAP = &H4& ' 菜單條目是一幅位圖. 一旦設(shè)入菜單, 這幅位圖就絕對不能刪除, 所以不應(yīng)該使用由VB的Image屬性返回的值.
Public Const MF_OWNERDRAW = &H100& ' 創(chuàng)建一個(gè)物主繪圖菜單 (由您設(shè)計(jì)的程序負(fù)責(zé)描繪每個(gè)菜單條目)
Public Const MF_USECHECKBITMAPS = &H200&
Public Const MF_MENUBARBREAK = &H20& ' 在彈出式菜單中, 將指定的條目放置于一個(gè)新列, 并用一條垂直線分隔不同的列.
Public Const MF_MENUBREAK = &H40& ' 在彈出式菜單中, 將指定的條目放置于一個(gè)新列. 在頂級菜單中, 將條目放置到一個(gè)新行.
Public Const MF_POPUP = &H10& ' 將一個(gè)彈出式菜單置于指定的條目, 可用于創(chuàng)建子菜單及彈出式菜單.
Public Const MF_HELP = &H4000&
Public Const MF_DEFAULT = &H1000
Public Const MF_RIGHTJUSTIFY = &H4000
' fMask To InsertMenuItem ' 指定 MENUITEMINFO 中哪些成員有效
Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_CHECKMARKS = &H8
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public Const MIIM_STRING = &H40
Public Const MIIM_BITMAP = &H80
Public Const MIIM_FTYPE = &H100
' fType To InsertMenuItem ' MENUITEMINFO 中菜單項(xiàng)類型
Public Const MFT_BITMAP = &H4&
Public Const MFT_MENUBARBREAK = &H20&
Public Const MFT_MENUBREAK = &H40&
Public Const MFT_OWNERDRAW = &H100&
Public Const MFT_SEPARATOR = &H800&
Public Const MFT_STRING = &H0&
' fState to InsertMenuItem ' MENUITEMINFO 中菜單項(xiàng)狀態(tài)
Public Const MFS_CHECKED = &H8&
Public Const MFS_DISABLED = &H2&
Public Const MFS_ENABLED = &H0&
Public Const MFS_GRAYED = &H1&
Public Const MFS_HILITE = &H80&
Public Const MFS_UNCHECKED = &H0&
Public Const MFS_UNHILITE = &H0&
' nFormat to DrawText
Public Const DT_LEFT = &H0 ' 水平左對齊
Public Const DT_CENTER = &H1 ' 水平居中對齊
Public Const DT_RIGHT = &H2 ' 水平右對齊
Public Const DT_SINGLELINE = &H20 ' 單行
Public Const DT_TOP = &H0 ' 垂直上對齊 (僅單行時(shí)有效)
Public Const DT_VCENTER = &H4 ' 垂直居中對齊 (僅單行時(shí)有效)
Public Const DT_BOTTOM = &H8 ' 垂直下對齊 (僅單行時(shí)有效)
Public Const DT_CALCRECT = &H400 ' 多行繪圖時(shí)矩形的底邊根據(jù)需要進(jìn)行延展, 以便容下所有文字; 單行繪圖時(shí), 延展矩形的右側(cè), 不描繪文字, 由lpRect參數(shù)指定的矩形會(huì)載入計(jì)算出來的值.
Public Const DT_WORDBREAK = &H10 ' 進(jìn)行自動(dòng)換行. 如用SetTextAlign函數(shù)設(shè)置了TA_UPDATECP標(biāo)志, 這里的設(shè)置則無效.
Public Const DT_NOCLIP = &H100 ' 描繪文字時(shí)不剪切到指定的矩形
Public Const DT_NOPREFIX = &H800 ' 通常, 函數(shù)認(rèn)為 & 字符表示應(yīng)為下一個(gè)字符加上下劃線, 該標(biāo)志禁止這種行為.
Public Const DT_EXPANDTABS = &H40 ' 描繪文字的時(shí)候, 對制表站進(jìn)行擴(kuò)展. 默認(rèn)的制表站間距是8個(gè)字符. 但是, 可用DT_TABSTOP標(biāo)志改變這項(xiàng)設(shè)定.
Public Const DT_TABSTOP = &H80 ' 指定新的制表站間距, 采用這個(gè)整數(shù)的高 8 位.
Public Const DT_EXTERNALLEADING = &H200 ' 計(jì)算文本行高度的時(shí)候, 使用當(dāng)前字體的外部間距屬性.
' nIndex to GetSysColor 標(biāo)準(zhǔn): 0--20
Public Const COLOR_ACTIVEBORDER = 10 ' 活動(dòng)窗口的邊框
Public Const COLOR_ACTIVECAPTION = 2 ' 活動(dòng)窗口的標(biāo)題
Public Const COLOR_APPWORKSPACE = 12 ' MDI桌面的背景
Public Const COLOR_BACKGROUND = 1 ' Windows 桌面
Public Const COLOR_BTNFACE = 15 ' 按鈕
Public Const COLOR_BTNHIGHLIGHT = 20 ' 按鈕的3D加亮區(qū)
Public Const COLOR_BTNSHADOW = 16 ' 按鈕的3D陰影
Public Const COLOR_BTNTEXT = 18 ' 按鈕文字
Public Const COLOR_CAPTIONTEXT = 9 ' 窗口標(biāo)題中的文字
Public Const COLOR_GRAYTEXT = 17 ' 灰色文字; 如使用了抖動(dòng)技術(shù)則為零
Public Const COLOR_HIGHLIGHT = 13 ' 選定的項(xiàng)目背景
Public Const COLOR_HIGHLIGHTTEXT = 14 ' 選定的項(xiàng)目文字
Public Const COLOR_INACTIVEBORDER = 11 ' 不活動(dòng)窗口的邊框
Public Const COLOR_INACTIVECAPTION = 3 ' 不活動(dòng)窗口的標(biāo)題
Public Const COLOR_INACTIVECAPTIONTEXT = 19 ' 不活動(dòng)窗口的文字
Public Const COLOR_MENU = 4 ' 菜單
Public Const COLOR_MENUTEXT = 7 ' 菜單文字
Public Const COLOR_SCROLLBAR = 0 ' 滾動(dòng)條
Public Const COLOR_WINDOW = 5 ' 窗口背景
Public Const COLOR_WINDOWFRAME = 6 ' 窗框
Public Const COLOR_WINDOWTEXT = 8 ' 窗口文字
' un to DrawState
Public Const DST_COMPLEX = &H0 ' 繪圖在由lpDrawStateProc參數(shù)指定的回調(diào)函數(shù)期間執(zhí)行, lParam和wParam會(huì)傳遞給回調(diào)事件.
Public Const DST_TEXT = &H1 ' lParam代表文字的地址(可使用一個(gè)字串別名),wParam代表字串的長度.
Public Const DST_PREFIXTEXT = &H2 ' 與DST_TEXT類似, 只是 & 字符指出為下各字符加上下劃線.
Public Const DST_ICON = &H3 ' lParam包括圖標(biāo)的句柄
Public Const DST_BITMAP = &H4 ' lParam包括位圖的句柄
Public Const DSS_NORMAL = &H0 ' 普通圖像
Public Const DSS_UNION = &H10 ' 圖像進(jìn)行抖動(dòng)處理
Public Const DSS_DISABLED = &H20 ' 圖象具有浮雕效果
Public Const DSS_MONO = &H80 ' 用hBrush描繪圖像
Public Const DSS_RIGHT = &H8000 ' 無任何作用
' edge to DrawEdge
Public Const BDR_RAISEDOUTER = &H1 ' 外層凸
Public Const BDR_SUNKENOUTER = &H2 ' 外層凹
Public Const BDR_RAISEDINNER = &H4 ' 內(nèi)層凸
Public Const BDR_SUNKENINNER = &H8 ' 內(nèi)層凹
Public Const BDR_OUTER = &H3
Public Const BDR_RAISED = &H5
Public Const BDR_SUNKEN = &HA
Public Const BDR_INNER = &HC
Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
' grfFlags to DrawEdge
Public Const BF_LEFT = &H1 ' 左邊緣
Public Const BF_TOP = &H2 ' 上邊緣
Public Const BF_RIGHT = &H4 ' 右邊緣
Public Const BF_BOTTOM = &H8 ' 下邊緣
Public Const BF_DIAGONAL = &H10 ' 對角線
Public Const BF_MIDDLE = &H800 ' 填充矩形內(nèi)部
Public Const BF_SOFT = &H1000 ' MSDN: Soft buttons instead of tiles.
Public Const BF_ADJUST = &H2000 ' 調(diào)整矩形, 預(yù)留客戶區(qū)
Public Const BF_FLAT = &H4000 ' 平面邊緣
Public Const BF_MONO = &H8000 ' 一維邊緣
Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
' nPenStyle to CreatePen
Public Const PS_DASH = 1 ' 畫筆類型:虛線 (nWidth必須是1) -------
Public Const PS_DASHDOT = 3 ' 畫筆類型:點(diǎn)劃線 (nWidth必須是1) _._._._
Public Const PS_DASHDOTDOT = 4 ' 畫筆類型:點(diǎn)-點(diǎn)-劃線 (nWidth必須是1) _.._.._
Public Const PS_DOT = 2 ' 畫筆類型:點(diǎn)線 (nWidth必須是1) .......
Public Const PS_SOLID = 0 ' 畫筆類型:實(shí)線 _______
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 類型聲明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type DRAWITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long
hdc As Long
rcItem As RECT
itemData As Long
End Type
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Public Type MEASUREITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemWidth As Long
itemHeight As Long
itemData As Long
End Type
Public Type Size
cx As Long
cy As Long
End Type
' 自定義菜單項(xiàng)數(shù)據(jù)結(jié)構(gòu)
Public Type MyMenuItemInfo
itemIcon As StdPicture
itemAlias As String
itemText As String
itemType As MenuItemType
itemState As MenuItemState
End Type
' 菜單相關(guān)結(jié)構(gòu)
Private MeasureInfo As MEASUREITEMSTRUCT
Private DrawInfo As DRAWITEMSTRUCT
Public hMenu As Long
Public preMenuWndProc As Long
Public MyItemInfo() As MyMenuItemInfo
' 菜單類屬性
Public BarWidth As Long ' 菜單附加條寬度
Public BarStyle As MenuLeftBarStyle ' 菜單附加條風(fēng)格
Public BarImage As StdPicture ' 菜單附加條圖像
Public BarStartColor As Long ' 菜單附加條過渡色起始顏色
Public BarEndColor As Long ' 菜單附加條過渡色終止顏色
Public SelectScope As MenuItemSelectScope ' 菜單項(xiàng)高亮條的范圍
Public TextEnabledColor As Long ' 菜單項(xiàng)可用時(shí)文字顏色
Public TextDisabledColor As Long ' 菜單項(xiàng)不可用時(shí)文字顏色
Public TextSelectColor As Long ' 菜單項(xiàng)選中時(shí)文字顏色
Public IconStyle As MenuItemIconStyle ' 菜單項(xiàng)圖標(biāo)風(fēng)格
Public EdgeStyle As MenuItemSelectEdgeStyle ' 菜單項(xiàng)邊框風(fēng)格
Public EdgeColor As Long ' 菜單項(xiàng)邊框顏色
Public FillStyle As MenuItemSelectFillStyle ' 菜單項(xiàng)背景填充風(fēng)格
Public FillStartColor As Long ' 菜單項(xiàng)過渡色起始顏色
Public FillEndColor As Long ' 菜單項(xiàng)過渡色終止顏色
Public BkColor As Long ' 菜單背景顏色
Public SepStyle As MenuSeparatorStyle ' 菜單分隔條風(fēng)格
Public SepColor As Long ' 菜單分隔條顏色
Public MenuStyle As MenuUserStyle ' 菜單總體風(fēng)格
' 攔截菜單消息 (frmMenu 窗口入口函數(shù))
Function MenuWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_COMMAND ' 單擊菜單項(xiàng)
If MyItemInfo(wParam).itemType = MIT_CHECKBOX Then
If MyItemInfo(wParam).itemState = MIS_CHECKED Then
MyItemInfo(wParam).itemState = MIS_UNCHECKED
Else
MyItemInfo(wParam).itemState = MIS_CHECKED
End If
End If
MenuItemSelected wParam
Case WM_EXITMENULOOP ' 退出菜單消息循環(huán)(保留)
Case WM_MEASUREITEM ' 處理菜單項(xiàng)高度和寬度
MeasureItem hwnd, lParam
Case WM_MENUSELECT ' 選擇菜單項(xiàng)
Dim itemID As Long
itemID = GetMenuItemID(lParam, wParam And &HFF)
If itemID <> -1 Then
MenuItemSelecting itemID
End If
Case WM_DRAWITEM ' 繪制菜單項(xiàng)
DrawItem lParam
End Select
MenuWndProc = CallWindowProc(preMenuWndProc, hwnd, Msg, wParam, lParam)
End Function
' 處理菜單高度和寬度
Private Sub MeasureItem(ByVal hwnd As Long, ByVal lParam As Long)
Dim TextSize As Size, hdc As Long
hdc = GetDC(hwnd)
CopyMemory MeasureInfo, ByVal lParam, Len(MeasureInfo)
If MeasureInfo.CtlType And ODT_MENU Then
MeasureInfo.itemWidth = lstrlen(MyItemInfo(MeasureInfo.itemID).itemText) * (GetSystemMetrics(SM_CYMENU) / 2.5) + BarWidth
If MyItemInfo(MeasureInfo.itemID).itemType <> MIT_SEPARATOR Then
MeasureInfo.itemHeight = GetSystemMetrics(SM_CYMENU)
Else
MeasureInfo.itemHeight = 6
End If
End If
CopyMemory ByVal lParam, MeasureInfo, Len(MeasureInfo)
ReleaseDC hwnd, hdc
End Sub
' 繪制菜單項(xiàng)
Private Sub DrawItem(ByVal lParam As Long)
Dim hPen As Long, hBrush As Long
Dim itemRect As RECT, barRect As RECT, iconRect As RECT, textRect As RECT
Dim i As Long
CopyMemory DrawInfo, ByVal lParam, Len(DrawInfo)
If DrawInfo.CtlType = ODT_MENU Then
SetBkMode DrawInfo.hdc, TRANSPARENT
' 初始化菜單項(xiàng)矩形, 圖標(biāo)矩形, 文字矩形
itemRect = DrawInfo.rcItem
iconRect = DrawInfo.rcItem
textRect = DrawInfo.rcItem
' 設(shè)置菜單附加條矩形
With barRect
.Left = 0
.Top = 0
.Right = BarWidth - 1
For i = 0 To GetMenuItemCount(hMenu) - 1
If MyItemInfo(i).itemType = MIT_SEPARATOR Then
.Bottom = .Bottom + 6
Else
.Bottom = .Bottom + MeasureInfo.itemHeight
End If
Next i
.Bottom = .Bottom - 1
End With
' 設(shè)置圖標(biāo)矩形, 文字矩形
If BarStyle <> LBS_NONE Then iconRect.Left = barRect.Right + 2
iconRect.Right = iconRect.Left + 20
textRect.Left = iconRect.Right + 3
With DrawInfo
' 畫菜單背景
itemRect.Left = barRect.Right
hBrush = CreateSolidBrush(BkColor)
FillRect .hdc, itemRect, hBrush
DeleteObject hBrush
' 畫菜單左邊的附加條
Dim RedArea As Long, GreenArea As Long, BlueArea As Long
Dim red As Long, green As Long, blue As Long
Select Case BarStyle
Case LBS_NONE ' 無附加條
Case LBS_SOLIDCOLOR ' 實(shí)色填充
hBrush = CreateSolidBrush(BarStartColor)
FillRect .hdc, barRect, hBrush
DeleteObject hBrush
Case LBS_HORIZONTALCOLOR ' 水平過渡色
BlueArea = Int(BarEndColor / &H10000) - Int(BarStartColor / &H10000)
GreenArea = (Int(BarEndColor / &H100) And &HFF) - (Int(BarStartColor / &H100) And &HFF)
RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)
For i = 0 To BarWidth - 1
red = Int(BarStartColor And &HFF) + Int(i / BarWidth * RedArea)
green = (Int(BarStartColor / &H100) And &HFF) + Int(i / BarWidth * GreenArea)
blue = Int(BarStartColor / &H10000) + Int(i / BarWidth * BlueArea)
hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))
Call SelectObject(.hdc, hPen)
Call MoveToEx(.hdc, i, 0, 0)
Call LineTo(.hdc, i, barRect.Bottom)
Call DeleteObject(hPen)
Next i
Case LBS_VERTICALCOLOR ' 垂直過渡色
BlueArea = Int(BarEndColor / &H10000) - Int(BarStartColor / &H10000)
GreenArea = (Int(BarEndColor / &H100) And &HFF) - (Int(BarStartColor / &H100) And &HFF)
RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)
For i = 0 To barRect.Bottom
red = Int(BarStartColor And &HFF) + Int(i / (barRect.Bottom + 1) * RedArea)
green = (Int(BarStartColor / &H100) And &HFF) + Int(i / (barRect.Bottom + 1) * GreenArea)
blue = Int(BarStartColor / &H10000) + Int(i / (barRect.Bottom + 1) * BlueArea)
hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))
Call SelectObject(.hdc, hPen)
Call MoveToEx(.hdc, 0, i, 0)
Call LineTo(.hdc, barRect.Right, i)
Call DeleteObject(hPen)
Next i
Case LBS_IMAGE ' 圖像
If BarImage.Handle <> 0 Then
Dim barhDC As Long
barhDC = CreateCompatibleDC(GetDC(0))
SelectObject barhDC, BarImage.Handle
BitBlt .hdc, 0, 0, BarWidth, barRect.Bottom - barRect.Top + 1, barhDC, 0, 0, vbSrcCopy
DeleteDC barhDC
End If
End Select
' 畫菜單項(xiàng)
If MyItemInfo(.itemID).itemType = MIT_SEPARATOR Then
' 畫菜單分隔條(MIT_SEPARATOR)
If MyItemInfo(.itemID).itemType = MIT_SEPARATOR Then
itemRect.Top = itemRect.Top + 2
itemRect.Bottom = itemRect.Top + 1
itemRect.Left = barRect.Right + 5
Select Case SepStyle
Case MSS_NONE ' 無分隔條
Case MSS_DEFAULT ' 默認(rèn)樣式
DrawEdge .hdc, itemRect, EDGE_ETCHED, BF_TOP
Case Else ' 其它
hPen = CreatePen(SepStyle, 0, SepColor)
hBrush = CreateSolidBrush(BkColor)
SelectObject .hdc, hPen
SelectObject .hdc, hBrush
Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom
DeleteObject hPen
DeleteObject hBrush
End Select
End If
Else
If Not CBool(MyItemInfo(.itemID).itemState And MIS_DISABLED) Then ' 當(dāng)菜單項(xiàng)可用時(shí)
If .itemState And ODS_SELECTED Then ' 當(dāng)鼠標(biāo)移動(dòng)到菜單項(xiàng)時(shí)
' 設(shè)置菜單項(xiàng)高亮范圍
If SelectScope And ISS_ICON_TEXT Then
itemRect.Left = iconRect.Left
ElseIf SelectScope And ISS_TEXT Then
itemRect.Left = textRect.Left - 2
Else
itemRect.Left = .rcItem.Left
End If
' 處理菜單項(xiàng)無圖標(biāo)或?yàn)镃HECKBOX時(shí)的情況
If (MyItemInfo(.itemID).itemType = MIT_CHECKBOX Or MyItemInfo(.itemID).itemIcon = 0) And SelectScope <> ISS_LEFTBAR_ICON_TEXT Then
itemRect.Left = iconRect.Left
End If
' 畫菜單項(xiàng)邊框
Select Case EdgeStyle
Case ISES_NONE ' 無邊框
Case ISES_SUNKEN ' 凹進(jìn)
DrawEdge .hdc, itemRect, BDR_SUNKENOUTER, BF_RECT
Case ISES_RAISED ' 凸起
DrawEdge .hdc, itemRect, BDR_RAISEDINNER, BF_RECT
Case Else ' 其它
hPen = CreatePen(EdgeStyle, 0, EdgeColor)
hBrush = CreateSolidBrush(BkColor)
SelectObject .hdc, hPen
SelectObject .hdc, hBrush
Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom
DeleteObject hPen
DeleteObject hBrush
End Select
' 畫菜單項(xiàng)背景
InflateRect itemRect, -1, -1
Select Case FillStyle
Case ISFS_NONE ' 無背景
Case ISFS_HORIZONTALCOLOR ' 水平漸變色
BlueArea = Int(FillEndColor / &H10000) - Int(FillStartColor / &H10000)
GreenArea = (Int(FillEndColor / &H100) And &HFF) - (Int(FillStartColor / &H100) And &HFF)
RedArea = (FillEndColor And &HFF) - (FillStartColor And &HFF)
For i = itemRect.Left To itemRect.Right - 1
red = Int(FillStartColor And &HFF) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * RedArea)
green = (Int(FillStartColor / &H100) And &HFF) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * GreenArea)
blue = Int(FillStartColor / &H10000) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * BlueArea)
hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))
Call SelectObject(.hdc, hPen)
Call MoveToEx(.hdc, i, itemRect.Top, 0)
Call LineTo(.hdc, i, itemRect.Bottom)
Call DeleteObject(hPen)
Next i
Case ISFS_VERTICALCOLOR ' 垂直漸變色
BlueArea = Int(FillEndColor / &H10000) - Int(FillStartColor / &H10000)
GreenArea = (Int(FillEndColor / &H100) And &HFF) - (Int(FillStartColor / &H100) And &HFF)
RedArea = (FillEndColor And &HFF) - (FillStartColor And &HFF)
For i = itemRect.Top To itemRect.Bottom - 1
red = Int(FillStartColor And &HFF) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * RedArea)
green = (Int(FillStartColor / &H100) And &HFF) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * GreenArea)
blue = Int(FillStartColor / &H10000) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * BlueArea)
hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))
Call SelectObject(.hdc, hPen)
Call MoveToEx(.hdc, itemRect.Left, i, 0)
Call LineTo(.hdc, itemRect.Right, i)
Call DeleteObject(hPen)
Next i
Case ISFS_SOLIDCOLOR ' 實(shí)色填充
hPen = CreatePen(PS_SOLID, 0, FillStartColor)
hBrush = CreateSolidBrush(FillStartColor)
SelectObject .hdc, hPen
SelectObject .hdc, hBrush
Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom
DeleteObject hPen
DeleteObject hBrush
End Select
' 畫菜單項(xiàng)文字
SetTextColor .hdc, TextSelectColor
DrawText .hdc, MyItemInfo(.itemID).itemText, -1, textRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
' 畫菜單項(xiàng)圖標(biāo)
If MyItemInfo(.itemID).itemType <> MIT_CHECKBOX Then
DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
Select Case IconStyle
Case IIS_NONE ' 無效果
Case IIS_SUNKEN ' 凹進(jìn)
If MyItemInfo(.itemID).itemIcon <> 0 Then
DrawEdge .hdc, iconRect, BDR_SUNKENOUTER, BF_RECT
End If
Case IIS_RAISED ' 凸起
If MyItemInfo(.itemID).itemIcon <> 0 Then
DrawEdge .hdc, iconRect, BDR_RAISEDINNER, BF_RECT
End If
Case IIS_SHADOW ' 陰影
hBrush = CreateSolidBrush(RGB(128, 128, 128))
DrawState .hdc, hBrush, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 3, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2 + 1, 0, 0, DST_ICON Or DSS_MONO
DeleteObject hBrush
DrawIconEx .hdc, iconRect.Left + 1, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2 - 1, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
End Select
Else
' CHECKBOX型菜單項(xiàng)圖標(biāo)效果
If MyItemInfo(.itemID).itemState And MIS_CHECKED Then
DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
End If
End If
Else ' 當(dāng)鼠標(biāo)移開菜單項(xiàng)時(shí)
' 畫菜單項(xiàng)邊框和背景(清除)
If BarStyle <> LBS_NONE Then
itemRect.Left = barRect.Right + 1
Else
itemRect.Left = 0
End If
hBrush = CreateSolidBrush(BkColor)
FillRect .hdc, itemRect, hBrush
DeleteObject hBrush
' 畫菜單項(xiàng)文字
SetTextColor .hdc, TextEnabledColor
DrawText .hdc, MyItemInfo(.itemID).itemText, -1, textRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
' 畫菜單項(xiàng)圖標(biāo)
If MyItemInfo(.itemID).itemType <> MIT_CHECKBOX Then
DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
Else
If MyItemInfo(.itemID).itemState And MIS_CHECKED Then
DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
End If
End If
End If
Else ' 當(dāng)菜單項(xiàng)不可用時(shí)
' 畫菜單項(xiàng)文字
SetTextColor .hdc, TextDisabledColor
DrawText .hdc, MyItemInfo(.itemID).itemText, -1, textRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
' 畫菜單項(xiàng)圖標(biāo)
If MyItemInfo(.itemID).itemType <> MIT_CHECKBOX Then
DrawState .hdc, 0, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, 0, 0, DST_ICON Or DSS_DISABLED
Else
If MyItemInfo(.itemID).itemState And MIS_CHECKED Then
DrawState .hdc, 0, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, 0, 0, DST_ICON Or DSS_DISABLED
End If
End If
End If
End If
End With
End If
End Sub
' 菜單項(xiàng)事件響應(yīng)(單擊菜單項(xiàng))
Private Sub MenuItemSelected(ByVal itemID As Long)
Debug.Print "鼠標(biāo)單擊了：" & MyItemInfo(itemID).itemText
Select Case MyItemInfo(itemID).itemAlias
Case "exit"
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Select
End Sub
' 菜單項(xiàng)事件響應(yīng)(選擇菜單項(xiàng))
Private Sub MenuItemSelecting(ByVal itemID As Long)
Debug.Print "鼠標(biāo)移動(dòng)到：" & MyItemInfo(itemID).itemText
End Sub
OK，到此為止，我們就徹底完成了菜單類的編寫，而且還包括一個(gè)測試窗體�，F(xiàn)在，完整的工程里應(yīng)該包括兩個(gè)窗體：frmMain和frmMenu；一個(gè)標(biāo)準(zhǔn)模塊：mMenu；一個(gè)類模塊：cMenu。按F5編譯運(yùn)行一下，在窗體空白處單擊鼠標(biāo)右鍵。怎么樣，出現(xiàn)彈出式菜單了嗎？換個(gè)風(fēng)格再試試。
在看完這個(gè)系列的文章后，我想你應(yīng)該已經(jīng)對采用物主繪圖技術(shù)的自繪菜單有一定的了解了，回過頭來再看看MS Office 2003的菜單，其實(shí)也沒什么難的嘛。以后，我們就可以在自己的任何程序中調(diào)用這個(gè)寫好的菜單類，為自己的程序添光加彩了。 :)
該程序在Windows XP、VB6下調(diào)試通過。
源代碼下載地址：http://y365.com/ses518/soft/samplecsdn.zip
|
