VB打造超酷个性化菜单（六）

接上篇） 

' 阻挡菜单动静 (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, hdcend 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    copymemory drawinfo, byval lparam, len(drawinfo)    if drawinfo.ctltype = odt_menu then        setbkmode drawinfo.hdc, transparent                ' 初始化菜单项矩形, 图标矩形, 笔墨矩形        itemrect = drawinfo.rcitem        iconrect = drawinfo.rcitem        textrect = drawinfo.rcitem                ' 树立菜单附加条矩形        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                ' 树立图标矩形, 笔墨矩形        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                                     ' 实色弥补

                    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                                    ' 画菜单项            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                                    ' 默许款式                            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   ' 当菜单项可用时                    if .itemstate and ods_selected then                         ' 当鼠标挪动到菜单项时                                            ' 树立菜单项高亮范畴                        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                                                                        ' 处置菜单项无图标或为checkbox时的情景                        if (myiteminfo(.itemid).itemtype = mit_checkbox or myiteminfo(.itemid).itemicon = 0) and selectscope <> iss_leftbar_icon_text then                            itemrect.left = iconrect.left                        end if                                                                        ' 画菜单项边框                        select case edgestyle                            case ises_none                                          ' 广博框                                                        case ises_sunken                                        ' 凹进                                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                                                                        ' 画菜单项后台                        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                            ' 实色弥补                                                                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                                                                        ' 画菜单项笔墨                        settextcolor .hdc, textselectcolor                        drawtext .hdc, myiteminfo(.itemid).itemtext, -1, textrect, dt_singleline or dt_left or dt_vcenter                                                                        ' 画菜单项图标                        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                                             ' 凹进                                    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型菜单项图标功效                            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                                                        ' 当鼠标移开菜单项时                                                ' 画菜单项边框和后台(废除)                        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                                                                        ' 画菜单项笔墨                        settextcolor .hdc, textenabledcolor                        drawtext .hdc, myiteminfo(.itemid).itemtext, -1, textrect, dt_singleline or dt_left or dt_vcenter                                                                        ' 画菜单项图标                        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                                                                 ' 当菜单项不行用时                                        ' 画菜单项笔墨                    settextcolor .hdc, textdisabledcolor                    drawtext .hdc, myiteminfo(.itemid).itemtext, -1, textrect, dt_singleline or dt_left or dt_vcenter                                        ' 画菜单项图标                    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 ifend sub

' 菜单项事变相应(单击菜单项)private sub menuitemselected(byval itemid as long)    debug.print "鼠标单击了：" & myiteminfo(itemid).itemtext    select case myiteminfo(itemid).itemalias        case "exit"            dim frm as form            for each frm in forms                unload frm            next    end selectend sub

' 菜单项事变相应(采用菜单项)private sub menuitemselecting(byval itemid as long)    debug.print "鼠标挪动到：" & myiteminfo(itemid).itemtextend sub

    到此为止，咱们就实行了菜单类的编写，且还囊括一个尝试窗体。此刻，完备的工程里该当囊括两个窗体：frmmain和frmmenu；一个规范模块：mmenu；一个类模块：cmenu。按f5编写翻译运转一下，在窗体空缺处单击鼠标右键。如何样，展示弹出式菜单了吗？换个作风再试试。    看完这个系列的作品后，我想你该当仍旧对沿用主人画图本领的自绘菜单有了确定的领会，再看看ms office 2003的菜单，本来也没什么难的嘛。    该步调在windows xp、vb6下调节和测试经过。