'''' 菜单分隔条风格 Public SepColor As Long '''' 菜单分隔条颜色 Public MenuStyle As MenuUserStyle '''' 菜单总体风格 '''' 拦截菜单消息 (frmMenu 窗口入口函数) 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 '''' 单击菜单项 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 '''' 退出菜单消息循环(保留) Case WM_MEASUREITEM '''' 处理菜单项高度和宽度 MeasureItem hwnd, lParam Case WM_MENUSELECT '''' 选择菜单项 Dim itemID As Long itemID = GetMenuItemID(lParam, wParam And &HFF) If itemID <> -1 Then MenuItemSelecting itemID End If Case WM_DRAWITEM '''' 绘制菜单项 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 '''' 绘制菜单项 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上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] ... 下一页 >> 没有相关教程
|