xpuimenu.cls

仿照windows XP的菜单控件,VB环境的,可以学习用

            
        Else
            blnFoundIT = OwnerMenu.IsItMe(hw)
        End If
        If blnFoundIT = False Then
            
        End If
    End If
    
End Sub

Private Sub pDrawBanner()
    Dim oRCBounds As Rect
    oRCBounds.Left = 1
    oRCBounds.Right = oRCBounds.Left + 24
    oRCBounds.Top = 2
    oRCBounds.Bottom = oRCBounds.Top + (oMenuCanvas.Height - 8)
    BoxRect3DDCex oMenuCanvas.HDC, oRCBounds, m_MenuImageBackColor, m_MenuImageBackColor, m_MenuImageBackColor  ' &HDEEDEF, &HDEEDEF, &HDEEDEF
End Sub

Friend Sub pCheckPos(Xpos As Long, Ypos As Long)
    Dim oRCItemRect As Rect
    Dim oMenuItem As MenuItem
    Dim lItemHeight As Long
    Dim iCount As Integer
    Dim iCurrentItem As Integer
    lItemHeight = (oMenuCanvas.TextHeight("gW") * 1.5)
    oRCItemRect.Top = 2
    oRCItemRect.Left = 1
    oRCItemRect.Right = lMenuWidth - 5
    oRCItemRect.Bottom = oRCItemRect.Top
    For Each oMenuItem In Me.MenuItems
        If oMenuItem.Seperator Then
            oRCItemRect.Top = oRCItemRect.Bottom + 2
            oRCItemRect.Bottom = oRCItemRect.Top + 1
            oRCItemRect.Left = 28
            'BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, &HB8C2C5, &HB8C2C5, &HB8C2C5
            oMenuItem.Top = oRCItemRect.Top
            oMenuItem.Left = oRCItemRect.Left
            oMenuItem.Right = oRCItemRect.Right
            oMenuItem.Bottom = oRCItemRect.Bottom
            Set oMenuItem.MenuObj = oMenuCanvas
            
            oRCItemRect.Bottom = oRCItemRect.Bottom + 2
            oRCItemRect.Left = 1
        Else
            oRCItemRect.Top = oRCItemRect.Bottom
            oRCItemRect.Bottom = oRCItemRect.Top + lItemHeight
            oRCItemRect.Left = 2
            oRCItemRect.Right = lMenuWidth - 6
            If Xpos > oRCItemRect.Left And Xpos < oRCItemRect.Right And Ypos > oRCItemRect.Top And Ypos < oRCItemRect.Bottom Then
                'BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, vbRed, vbRed, &HFFC0C0
                oMenuItem.Top = oRCItemRect.Top
                oMenuItem.Left = oRCItemRect.Left
                oMenuItem.Right = oRCItemRect.Right
                oMenuItem.Bottom = oRCItemRect.Bottom
                Set oMenuItem.MenuObj = oMenuCanvas
                iCurrentItem = oMenuItem.Item
                If oMenuItem.MouseOver <> True Then
                    oMenuItem.MouseOver = True
                End If
            Else
                oMenuItem.Top = oRCItemRect.Top
                oMenuItem.Left = oRCItemRect.Left
                oMenuItem.Right = oRCItemRect.Right
                oMenuItem.Bottom = oRCItemRect.Bottom
                Set oMenuItem.MenuObj = oMenuCanvas
                oRCItemRect.Right = oRCItemRect.Left + 23
                'BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, &HDEEDEF, &HDEEDEF, &HDEEDEF
                oRCItemRect.Left = oRCItemRect.Right
                oRCItemRect.Right = lMenuWidth - 6
                'BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, vbWhite, vbWhite, vbWhite
                oRCItemRect.Left = 2
                If oMenuItem.MouseOver <> False Then
                    oMenuItem.MouseOver = False
                End If
            End If
            oRCItemRect.Left = 1
            oRCItemRect.Right = lMenuWidth - 5
            oRCItemRect.Left = 29
            'DrawText oMenuCanvas.HDC, oMenuItem.Caption, Len(oMenuItem.Caption), oRCItemRect, 564
            oRCItemRect.Left = 1
        End If
    Next
    
End Sub

Private Sub pDrawItems()
    Dim oMenuItem As MenuItem
    For Each oMenuItem In MenuItems
        Set oMenuItem.ImageList = m_ImageList
        oMenuItem.pDrawItem
    Next
'    Dim oRCItemRect As Rect
'    Dim oMenuItem As MenuItem
'    Dim lItemHeight As Long
'    Dim iCount As Integer
'    Dim iCurrentItem As Integer
'    lItemHeight = (oMenuCanvas.TextHeight("gW") * 1.5)
'    oRCItemRect.Top = 2
'    oRCItemRect.Left = 1
'    oRCItemRect.Right = lMenuWidth - 5
'    oRCItemRect.Bottom = oRCItemRect.Top
'    For Each oMenuItem In Me.MenuItems
'        If oMenuItem.Seperator Then
'            oRCItemRect.Top = oRCItemRect.Bottom + 2
'            oRCItemRect.Bottom = oRCItemRect.Top + 1
'            oRCItemRect.Left = 28
'            BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, &HB8C2C5, &HB8C2C5, &HB8C2C5
'            oRCItemRect.Bottom = oRCItemRect.Bottom + 2
'            oRCItemRect.Left = 1
'        Else
'            oRCItemRect.Top = oRCItemRect.Bottom
'            oRCItemRect.Bottom = oRCItemRect.Top + lItemHeight
'            oRCItemRect.Left = 2
'            oRCItemRect.Right = lMenuWidth - 6
'            If oMenuItem.MouseOver Then
'                BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, vbRed, vbRed, &HFFC0C0
'                iCurrentItem = oMenuItem.Item
'                oMenuItem.MouseOver = True
'            Else
'                oRCItemRect.Right = oRCItemRect.Left + 23
'                BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, &HDEEDEF, &HDEEDEF, &HDEEDEF
'                oRCItemRect.Left = oRCItemRect.Right
'                oRCItemRect.Right = lMenuWidth - 6
'                BoxRect3DDCex oMenuCanvas.HDC, oRCItemRect, vbWhite, vbWhite, vbWhite
'                oRCItemRect.Left = 2
'                oMenuItem.MouseOver = False
'            End If
'            oRCItemRect.Left = 1
'            oRCItemRect.Right = lMenuWidth - 5
'            oRCItemRect.Left = 29
'            DrawText oMenuCanvas.HDC, oMenuItem.Caption, Len(oMenuItem.Caption), oRCItemRect, 564
'            oRCItemRect.Left = 1
'        End If
'    Next
'    If iCurrentItem > 0 Then
'        If MenuItems(iCurrentItem).XPUIMenu.MenuItems.Count = 0 Then
'            Set oActivePopup = Nothing
'        Else
'            Dim oWinPos As Rect
'            GetWindowRect oMenuCanvas.HWND, oWinPos
'            Set oActivePopup = Nothing
'            Set oActivePopup = New XPUIMenu
'            Set oActivePopup.MenuItems = Me.MenuItems(iCurrentItem).XPUIMenu.MenuItems
'            oActivePopup.ShowMenu oWinPos.Right - 4, oWinPos.Top + (lItemHeight * iCurrentItem)
'        End If
'    Else
'        Set oActivePopup = Nothing
'    End If

End Sub

Private Sub oTimer_Timer()
    On Error GoTo ErrHandle
    If blnFirstInit = False Then
        pCheckPos 0, 0
        pDrawItems
        blnFirstInit = True
    End If
    
    Dim PT As POINTAPI
    GetCursorPos PT
    
    Dim hw As Long
    hw = WindowFromPoint(PT.x, PT.y)
    
    If hw <> oMenuCanvas.HWND Then
        pCheckPos 0, 0
        m_MouseOver = False
    Else
        m_MouseOver = True
    End If
    Dim oPT As POINTAPI
    ClientToScreen oMenuCanvas.HWND, oPT
    Dim oMenuItems As MenuItem
    For Each oMenuItems In MenuItems
        If oMenuItems.XPUIMenu.MenuItems.Count > 0 And oMenuItems.MouseOver = True And oMenuItems.Disabled = False Then
            If oPopupMenu Is Nothing Then
                Set oPopupMenu = oMenuItems.XPUIMenu
                Set oPopupMenu.ImageList = m_ImageList
                Set oPopupMenu.OwnerMenu = Me
                oPopupMenu.CallingItem = oMenuItems.Item
                oPopupMenu.MenuBorderColor = m_MenuBorderColor
                oPopupMenu.MenuBackColor = m_MenuBackColor
                oPopupMenu.MenuImageBackColor = m_MenuImageBackColor
                oPopupMenu.separatorcolor = m_separatorcolor
                oPopupMenu.MenuItemHotColor = m_MenuItemHotColor
                oPopupMenu.MenuItemBorderColor = m_MenuItemBorderColor
                oMenuItems.Popped = True
                oPopupMenu.ShowMenu oPT.x + ((oMenuItems.Right - oMenuItems.Left) + 3), oPT.y + oMenuItems.Top
                
            Else
                
                If (oPopupMenu.Xpos <> oPT.x + ((oMenuItems.Right - oMenuItems.Left) + 3) Or oPopupMenu.Ypos <> oPT.y + oMenuItems.Top) Then
                    oPopupMenu.Hide
                    MenuItems(oPopupMenu.CallingItem).Popped = False
                    MenuItems(oPopupMenu.CallingItem).pDrawItem
                    DoEvents
                    Set oPopupMenu = Nothing
                    Set oPopupMenu = oMenuItems.XPUIMenu
                    Set oPopupMenu.ImageList = m_ImageList
                    oPopupMenu.MenuBorderColor = m_MenuBorderColor
                    oPopupMenu.MenuImageBackColor = m_MenuImageBackColor
                    oPopupMenu.MenuItemHotColor = m_MenuItemHotColor
                    oPopupMenu.separatorcolor = m_separatorcolor
                    oPopupMenu.MenuItemBorderColor = m_MenuItemBorderColor
                    Set oPopupMenu.OwnerMenu = Me
                    oPopupMenu.MenuBackColor = m_MenuBackColor
                    oMenuItems.Popped = True
                    'oMenuItems.pDrawItem
                    oPopupMenu.CallingItem = oMenuItems.Item
                    oPopupMenu.ShowMenu oPT.x + ((oMenuItems.Right - oMenuItems.Left) + 3), oPT.y + oMenuItems.Top
                Else
                
                End If
            End If
        ElseIf oMenuItems.XPUIMenu.MenuItems.Count > 0 And oMenuItems.MouseOver = False And oMenuItems.Disabled = False Then
            'If (oPopupMenu.Xpos <> oPT.x + ((oMenuItems.Right - oMenuItems.Left) + 3) Or oPopupMenu.Ypos <> oPT.Y + oMenuItems.Top) Then
                'oMenuItems.Popped = False
            'Else
                If oMenuItems.XPUIMenu.Shown Then
                    oMenuItems.Popped = True
                Else
                    oMenuItems.Popped = False
                End If
            'End If
        ElseIf oMenuItems.MouseOver = True Then
            If oPopupMenu Is Nothing Then
            
            Else
                
                oPopupMenu.Hide
                MenuItems(oPopupMenu.CallingItem).Popped = False
                MenuItems(oPopupMenu.CallingItem).pDrawItem
                Set oPopupMenu = Nothing
            End If
            
        Else
            oMenuItems.Popped = False
            'oMenuItems.pDrawItem
        End If
    Next
'    If GetAsyncKeyState(&H1) Then
'        Term
'    End If

Exit Sub
ErrHandle:


End Sub

Friend Sub Term()
    If OwnerMenu Is Nothing Then
        oMenu.Destroy
        
        Set oPopupMenu = Nothing
        Set oMenu = Nothing
        Set oMenuCanvas = Nothing
        Set oCanvasParent = Nothing
    Else
        oMenu.Destroy
        OwnerMenu.Term
        
    End If

End Sub

Friend Function IsItMe(Handle As Long) As Boolean
    On Error Resume Next
    If Handle = oMenuCanvas.HWND Then
        IsItMe = True
        SetCapture oMenuCanvas.HWND
    Else
        If OwnerMenu Is Nothing Then ' I must be first menu
            IsItMe = False
        Else
            IsItMe = OwnerMenu.IsItMe(Handle)
        End If
    End If
End Function

Friend Sub Hide()
    If oPopupMenu Is Nothing Then
    
    Else
        oPopupMenu.Hide
    End If
    Me.Shown = False
    oMenu.Destroy
End Sub

Friend Sub Clicked()
    If oPopupMenu Is Nothing Then
        Term
    Else
        oPopupMenu.Clicked
    End If
End Sub

Friend Sub PassClick(Menu As XPUIMenu, MenuItem As MenuItem)
    If OwnerMenu Is Nothing Then
        
        Clicked
        RaiseEvent Click(Menu, MenuItem)
    Else
        OwnerMenu.PassClick Menu, MenuItem
    End If
End Sub