ctxhookmenu.ctl

人事管理系统vb版,用于一般中小企业

                oFnt.Size = Font.Size
                oFnt.Bold = oFnt.Bold Or Font.Bold
                oFnt.Italic = oFnt.Italic Or Font.Italic
                oFnt.Underline = oFnt.Underline Or Font.Underline
                oFnt.Strikethrough = oFnt.Strikethrough Or Font.Strikethrough

                '-- Added Gary Noble - 5-11-2003
                '-- Raise The CustomDrawItemFont Event
                vSplit = Split(sText, vbTab)
                If Me.DrawStyle = MS_自定义 Then
                    If UBound(vSplit) >= 0 Then
                        '-- Raise Our Custom Draw Item Event
                        RaiseEvent CustomDrawItemFont(oFnt, CStr(Replace(IIf(Left$(vSplit(0), 1) = "&", Right(vSplit(0), Len(vSplit(0)) - 1), vSplit(0)), "&&", "&")), oldColor)
                    End If
                End If
                Set .Font = oFnt
            End If

            '--- check if drawing main menu item
            If bMainMenu Then
                '--- fill background
                .FillRect dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right + 3, dis.rcItem.Bottom, IIf(bCustom, m_clrMenuBarBack, m_UserTopMenuBackColour)
                If Not bCustom And m_UserUseTopMenuGradient Then .FillGradient dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right + 4, dis.rcItem.Bottom, m_UserGradientOne, m_UserGradientTwo, True
                If (lState And MF_GRAYED) = 0 Then
                    '.ForeColor = m_clrMenuFore
                    .ForeColor = oldColor
                    If (dis.itemState And ODS_SELECTED) <> 0 Then
                        .Rectangle dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right, dis.rcItem.Bottom, IIf(bCustom, m_clrMenuBack, m_UserTopMenuSelectedColour), , IIf(bCustom, m_clrMenuBorder, m_UserMenuBorderColour)
                        If Not bCustom And m_UserUseTopMenuGradient Then .FillGradient dis.rcItem.Left + 1, dis.rcItem.Top + 1, dis.rcItem.Right - 1, dis.rcItem.Bottom - 1, m_UserGradientOne, m_UserGradientTwo, True
                        .ForeColor = IIf(bCustom, m_clrSelMenuFore, m_UserSelectedItemForeColour)
                      ElseIf (dis.itemState And ODS_HOTLIGHT) <> 0 Then
                        .Rectangle dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right, dis.rcItem.Bottom, IIf(bCustom, m_clrSelMenuBack, m_UserTopMenuHotColour), , IIf(bCustom, m_clrSelMenuBorder, m_UserTopMenuHotBorderColour)
                        If Not bCustom And m_UserUseTopMenuGradient Then .FillGradient dis.rcItem.Left + 1, dis.rcItem.Top + 1, dis.rcItem.Right - 1, dis.rcItem.Bottom - 1, m_UserGradientTwo, m_UserGradientOne, True
                        .ForeColor = IIf(bCustom, m_clrSelMenuFore, m_UserSelectedItemForeColour)
                    End If
                  Else
                    .ForeColor = m_clrDisabledMenuFore
                End If
                '--- draw text
                .DrawText sText, dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right, dis.rcItem.Bottom, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER
                '--- draw main menu shadow
                If Me.DisplayShadow Then
                    If (dis.itemState And ODS_SELECTED) <> 0 Then
                        If m_bConstrainedColors Then
                            .FillRect dis.rcItem.Right, dis.rcItem.Top + 3, dis.rcItem.Right + 2, dis.rcItem.Bottom, vbButtonShadow
                          Else
                            For lJ = 0 To 2
                                For lK = 3 To dis.rcItem.Bottom - dis.rcItem.Top - 1
                                    .SetPixel dis.rcItem.Right + lJ, dis.rcItem.Top + lK, pvAlphaBlend(vbBlack, .GetPixel(dis.rcItem.Right + lJ, dis.rcItem.Top + lK), &H40 - lJ * (&H40 / 3))
                                Next lK
                            Next lJ
                        End If
                    End If
                End If
              Else
                If (lType And MFT_SEPARATOR) = 0 Then
                    vSplit = Split(sText, vbTab)
                    If UBound(vSplit) >= 0 Then
                        '--- figure out current bitmap appearance
                        vPic = pvFindIconInfo(vSplit(0))
                        If IsArray(vPic) Then
                            If Not vPic(0) Is Nothing Then
                                If (lState And MF_DISABLED) <> 0 Then
                                    Set oPicMemDC = pvGetBitmapDisabled(vPic(0), vPic(1), pvGetLuminance(m_clrMenuBack))
                                  ElseIf (lState And MF_CHECKED) <> 0 Then
                                    Set oPicMemDC = pvGetBitmapNormal(vPic(0), vPic(1))
                                  ElseIf (dis.itemState And ODS_SELECTED) <> 0 Then
                                    Set oPicMemDC = pvGetBitmapRaised(vPic(0), vPic(1))
                                  Else
                                    Set oPicMemDC = pvGetBitmapDimmed(vPic(0), vPic(1))
                                End If
                            End If
                        End If
                    End If
                End If
                '--- fill background
                If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                    If Not bCustom And m_UserUseGradient Then
                        .FillGradient dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Left + m_lMenuHeight + 3, dis.rcItem.Bottom, m_UserGradientOne, m_UserGradientTwo
                      Else
                        .FillRect dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Left + m_lMenuHeight + 3, dis.rcItem.Bottom, IIf(bCustom, m_clrMenuBack, m_UserSideBarColour)
                    End If
                  Else
                    If Not bCustom And m_UserUseGradient Then
                        .FillGradient dis.rcItem.Right - m_lMenuHeight - 4, dis.rcItem.Top, dis.rcItem.Right - 1, dis.rcItem.Bottom, m_UserGradientOne, m_UserGradientTwo
                      Else
                        .FillRect dis.rcItem.Right - m_lMenuHeight - 4, dis.rcItem.Top, dis.rcItem.Right - 1, dis.rcItem.Bottom, IIf(bCustom, m_clrMenuBack, m_UserSideBarColour)
                    End If
                End If
                '--- get ID of last menu item in current (popup) menu
                mii.cbSize = Len(mii) - IIf(OsVersion >= &H40A, 0, 4)
                mii.fMask = MIIM_ID
                Call GetMenuItemInfo(hMenu, GetMenuItemCount(hMenu) - 1, 1, mii)

                '--- if current item is the last one in the popup menu -> paint a white line at the bottom
                If mii.wID = lId Then
                    .FillRect dis.rcItem.Left, dis.rcItem.Bottom - 1, dis.rcItem.Right - 1, dis.rcItem.Bottom, m_clrMenuPopupBack
                End If

                If OsVersion >= &H40A Then '--- &H40A = win98 and later
                    mii.cbSize = Len(mii)
                    mii.fMask = MIIM_ID Or MIIM_FTYPE Or MIIM_DATA Or MIIM_STRING
                  Else
                    mii.cbSize = Len(mii) - 4
                    mii.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_DATA
                End If

                Call GetMenuItemInfo(hMenu, dis.itemID + 1, 0, mii)

                If (mii.fType And MF_MENUBREAK) <> 0 Then
                    .FillRect dis.rcItem.Left, dis.rcItem.Bottom - 1, dis.rcItem.Right - 1, dis.rcItem.Bottom, m_clrMenuPopupBack
                End If

                If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                    .FillRect dis.rcItem.Left + m_lMenuHeight + 3, dis.rcItem.Top, dis.rcItem.Right - 1, dis.rcItem.Bottom, m_clrMenuPopupBack
                  Else
                    .FillRect dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right - m_lMenuHeight - 4, dis.rcItem.Bottom, m_clrMenuPopupBack
                End If

                '-- Ammended - Gary Noble
                If AutoColumn > 0 Then .FillRect dis.rcItem.Right - 1, dis.rcItem.Top, dis.rcItem.Right, dis.rcItem.Bottom, IIf(bCustom, m_clrMenuBorder, m_UserMenuBorderColour)

                If (lType And MFT_SEPARATOR) = MFT_SEPARATOR Then
                    '--- draw separator line
                    If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                        .FillRect dis.rcItem.Left + m_lMenuHeight + 10, (dis.rcItem.Top + dis.rcItem.Bottom) \ 2 - 1, dis.rcItem.Right, (dis.rcItem.Top + dis.rcItem.Bottom) \ 2, IIf(Not bCustom, m_UserMenuBorderColour, m_clrMenuBorder)
                      Else
                        .FillRect dis.rcItem.Left, (dis.rcItem.Top + dis.rcItem.Bottom) \ 2 - 1, dis.rcItem.Right - 1 - m_lMenuHeight - 10, (dis.rcItem.Top + dis.rcItem.Bottom) \ 2, IIf(Not bCustom, m_UserMenuBorderColour, m_clrMenuBorder)
                    End If
                  Else
                    '--- if selected -> item background rect (enabled or disabled)
                    If (lState And MF_GRAYED) = 0 Then
                        If (dis.itemState And ODS_SELECTED) <> 0 Then
                            If Me.DrawStyle = MS_自定义 And Not Me.UseSystemFont Then
                                '-- Raise Our Custom Draw Item Event
                                oldColorHoverBack = IIf(bCustom, m_clrSelMenuBack, m_UserSelectedMenuBackColour)
                                oldColorHoverBorder = IIf(bCustom, m_clrSelMenuBorder, m_UserSelectedMenuBorderColour)
                                RaiseEvent CustomDrawItemHoverFont(oFnt, CStr(Replace(IIf(Left$(vSplit(0), 1) = "&", Right(vSplit(0), Len(vSplit(0)) - 1), vSplit(0)), "&&", "&")), oldColor, oldColorHoverBack, oldColorHoverBorder)
                                Set .Font = oFnt
                                .ForeColor = oldColor
                                .Rectangle dis.rcItem.Left + 1, dis.rcItem.Top, dis.rcItem.Right - 2, dis.rcItem.Bottom - 1, oldColorHoverBack, , oldColorHoverBorder
                              Else
                                .ForeColor = IIf(bCustom, m_clrSelMenuFore, m_UserSelectedItemForeColour)
                                .Rectangle dis.rcItem.Left + 1, dis.rcItem.Top, dis.rcItem.Right - 2, dis.rcItem.Bottom - 1, IIf(bCustom, m_clrSelMenuBack, m_UserSelectedMenuBackColour), , IIf(bCustom, m_clrSelMenuBorder, m_UserSelectedMenuBorderColour)
                            End If
                            '.FillGradient dis.rcItem.Left + 2, dis.rcItem.Top + 1, dis.rcItem.Right - 3, dis.rcItem.Bottom - 2, m_UserGradienttwo, m_UserSelectedMenuBackColour, True
                            If UBound(vSplit) >= 0 Then RaiseEvent Highlight(CStr(Replace(IIf(Left$(vSplit(0), 1) = "&", Right(vSplit(0), Len(vSplit(0)) - 1), vSplit(0)), "&&", "&")))
                          Else
                            .ForeColor = oldColor
                            '.ForeColor = m_clrMenuFore
                        End If
                      Else
                        .ForeColor = m_clrDisabledMenuFore
                        If (dis.itemState And ODS_SELECTED) <> 0 And SelectDisabled Then
                            .Rectangle dis.rcItem.Left + 1, dis.rcItem.Top, dis.rcItem.Right - 2, dis.rcItem.Bottom - 1, m_clrDisabledMenuBack, , m_clrDisabledMenuBorder
                        End If
                    End If
                    '--- draw check square background and border
                    If (lState And MF_CHECKED) <> 0 Then
                        lI = (m_lMenuHeight - BitmapSize - 1) \ 2
                        lJ = (m_lMenuHeight - BitmapSize - 5) \ 2
                        If (lState And MF_DISABLED) <> 0 Then
                            clrBack = m_clrDisabledMenuBack
                            clrBorder = m_clrDisabledMenuBorder
                          ElseIf (dis.itemState And ODS_SELECTED) <> 0 Then
                            clrBack = m_clrSelCheckBack
                            clrBorder = m_clrSelMenuBorder
                          Else
                            clrBack = m_clrCheckBack
                            clrBorder = m_clrSelMenuBorder
                        End If
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            .Rectangle dis.rcItem.Left + lI, dis.rcItem.Top + lJ, dis.rcItem.Left + lI + BitmapSize + 4, dis.rcItem.Top + lJ + BitmapSize + 4, IIf(bCustom, clrBack, m_UserCheckBackColour), , IIf(bCustom, clrBorder, m_UserCheckBorderColour)
                          Else
                            .Rectangle dis.rcItem.Right - 4 - m_lMenuHeight + lI, dis.rcItem.Top + lJ, dis.rcItem.Right - 4 - m_lMenuHeight + lI + BitmapSize + 4, dis.rcItem.Top + lJ + BitmapSize + 4, IIf(bCustom, clrBack, m_UserCheckBackColour), , IIf(bCustom, clrBorder, m_UserCheckBorderColour)
                        End If
                    End If

                    '--- draw bitmap or check
                    If Not oPicMemDC Is Nothing Then
                        lI = (m_lMenuHeight - BitmapSize - 1) \ 2 - 1
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            oPicMemDC.TransBlt .hDC, dis.rcItem.Left + lI + 2, dis.rcItem.Top + lI, BitmapSize + 2, BitmapSize + 2, clrMask:=MASK_COLOR
                          Else
                            oPicMemDC.TransBlt .hDC, dis.rcItem.Right - 4 - m_lMenuHeight + lI + 2, dis.rcItem.Top + lI, BitmapSize + 2, BitmapSize + 2, clrMask:=MASK_COLOR
                        End If
                      ElseIf (lState And MF_CHECKED) <> 0 Then
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            lI = dis.rcItem.Left + m_lMenuHeight \ 2 - 2
                          Else
                            lI = dis.rcItem.Right - 4 - m_lMenuHeight \ 2 - 2
                        End If
                        For lJ = 0 To 2
                            .DrawLine lI + lJ, dis.rcItem.Top + m_lMenuHeight \ 2 - 2 + lJ + 1, lI + lJ, dis.rcItem.Top + m_lMenuHeight \ 2 + lJ + 1, m_clrCheckFore
                        Next lJ
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            lI = dis.rcItem.Left + m_lMenuHeight \ 2
                          Else
                            lI = dis.rcItem.Right - 4 - m_lMenuHeight \ 2
                        End If
                        For lJ = 1 To 4
                            .DrawLine lI + lJ, dis.rcItem.Top + m_lMenuHeight \ 2 - lJ + 1, lI + lJ, dis.rcItem.Top + m_lMenuHeight \ 2 - lJ + 3, m_clrCheckFore
                        Next lJ
                    End If

                    If UBound(vSplit) >= 0 Then
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            .DrawText vSplit(0), dis.rcItem.Left + m_lMenuHeight + 10, dis.rcItem.Top, dis.rcItem.Right - m_lMenuHeight, dis.rcItem.Bottom - 1, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER
                          Else
                            .DrawText vSplit(0), dis.rcItem.Left + m_lMenuHeight, dis.rcItem.Top, dis.rcItem.Right - 1 - m_lMenuHeight - 10, dis.rcItem.Bottom - 1, DT_RIGHT Or DT_SINGLELINE Or DT_VCENTER
                        End If
                    End If

                    If UBound(vSplit) > 0 Then
                        '--- draw shortcut keys
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            .DrawText vSplit(1), dis.rcItem.Left + m_lMenuHeight + 10, dis.rcItem.Top, dis.rcItem.Right - m_lMenuHeight, dis.rcItem.Bottom - 1, DT_RIGHT Or DT_SINGLELINE Or DT_VCENTER
                          Else
                            .DrawText vSplit(1), dis.rcItem.Left + m_lMenuHeight, dis.rcItem.Top, dis.rcItem.Right - 1 - m_lMenuHeight - 10, dis.rcItem.Bottom - 1, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER
                        End If

                    End If

                    '--- draw submenu arrow (if necessary)
                    bExclude = False
                    If (lState And MF_POPUP) <> 0 Then
                        bExclude = True
                        lI = (dis.rcItem.Top + dis.rcItem.Bottom - 1) \ 2
                        If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                            lJ = dis.rcItem.Right - m_lMenuHeight \ 3 - 4
                          Else
                            lJ = dis.rcItem.Left + m_lMenuHeight * 2 \ 3 - 4
                        End If
                        For lK = (m_lTextHeight + 3) \ 8 To 0 Step -1
                            If Not RightToLeft And (lType And MFT_RIGHTJUSTIFY) = 0 Then
                                .DrawLine lJ - lK, lI - lK, lJ - lK, lI + lK + 1, .ForeColor
                              Else
                                .DrawLine lJ + lK, lI - lK, lJ + lK, lI + lK + 1, .ForeColor
                            End If
                        Next lK
                    End If
                End If
            End If
            If .IsMemoryDC Then
                SetViewportOrgEx .hDC, 0, 0, 0
                .BitBlt dis.hDC, dis.rcItem.Left, dis.rcItem.Top
            End If
        End With
        '--- prevent further drawing (esp sub-menu arrow) and reduce flicker
        If bExclude Then
            ExcludeClipRect dis.hDC, dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Right, dis.rcItem.Bottom
        End If

        m_clrMenuFore = oldColor
        '--- handled
        pvDrawItem = True
    End If

End Function

Private Function pvFindIconInfo(ByVal sCaption As String) As Variant

  '--- ToDo: better handling
  
  Dim oCtl            As Object

    On Error Resume Next
        For Each oCtl In ParentControls
            If TypeOf oCtl Is Menu Then
                If Split(oCtl.Caption, vbTab)(0) <> sCaption Then
                  Else
                    pvFindIconInfo = m_cBmps("#" & pvGetCtlName(oCtl))
                    Exit Function
                End If
            End If
        Next oCtl
    On Error GoTo 0

End Function

Private Function pvGetBackground(ByVal hwnd As Long) As cMemDC

  Dim oMemDC          As cMemDC
  Dim rc              As RECT
  Dim rcItem          As RECT
  Dim rcPopup         As RECT
  Dim rcPopupBtm      As RECT
  Dim lI