打印本文 打印本文 关闭窗口 关闭窗口
VB打造超酷个性化菜单(三)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数9898  更新时间:2009/4/23 15:44:34  文章录入:mintao  责任编辑:mintao
          '''' 菜单分隔条风格

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]  ...  下一页 >> 

打印本文 打印本文 关闭窗口 关闭窗口