ctxhookmenu.ctl

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

    pvGetMeasures
    '--- subclass form
    With m_oSubclass
#If WEAK_REF_ME Then
        .Subclass m_hFormHwnd, Me, True, True
#Else
        .Subclass m_hFormHwnd, Me, False, True
#End If
        .AddBeforeMsgs WM_INITMENUPOPUP, WM_MEASUREITEM, WM_DRAWITEM, _
                       WM_MDISETMENU, WM_NCCALCSIZE, WM_MENUSELECT, _
                       WM_SYSCOLORCHANGE, WM_NCDESTROY, pvInitMenuMsg, _
                       WM_ENTERMENULOOP, WM_EXITMENULOOP, WM_MENUCHAR

    End With
    '--- special case: subclass MDI client
    hClient = FindWindowEx(hwnd, 0, STR_CLIENT_CLASS, vbNullString)
    If hClient <> 0 Then
        With m_oClientSubclass
#If WEAK_REF_ME Then
            .Subclass hClient, Me, True, True
#Else
            .Subclass hClient, Me, False, True
#End If
            .AddBeforeMsgs WM_MDISETMENU
        End With
    End If

End Sub

Private Property Get IsNT() As Boolean

  Static lPlatform    As Long
  Dim uVer            As OSVERSIONINFO

    If lPlatform = 0 Then
        uVer.dwOSVersionInfoSize = Len(uVer)
        If GetVersionEx(uVer) Then
            lPlatform = uVer.dwPlatformId
        End If
    End If
    IsNT = (lPlatform = VER_PLATFORM_WIN32_NT)

End Property

Private Sub ISubclassingSink_After(lReturn As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

End Sub

'==============================================================================
' ISubclassingSink interface
'==============================================================================

Private Sub ISubclassingSink_Before(bHandled As Boolean, lReturn As Long, hwnd As Long, uMsg As Long, wParam As Long, lParam As Long)

  Static bDelayed  As Boolean
  Static lsHwnd       As Long
  Dim hDC             As Long
  Dim rc              As RECT
  Dim wp              As WINDOWPOS
  Dim pt              As POINTAPI
  Dim oSub            As cSubclassingThunk
  Dim hMdiChild       As Long
  Dim hPrevMenuWnd    As Long
  Dim mii             As MENUITEMINFO
  Dim sBuffer         As String
  Dim hCurMenu        As Long
  Dim lType           As Long
  Dim bMainMenu       As Boolean
  Dim bMenuFound      As Boolean
  Dim lId             As Long
  Dim lIdx            As Long
  Dim lPos            As Integer
  Dim Ret             As Long

    If m_oSubclass Is Nothing Or m_oClientSubclass Is Nothing Then
        Exit Sub
    End If
    If hwnd = m_hFormHwnd Or hwnd = m_oClientSubclass.hwnd Then
        Select Case uMsg
          Case WM_INITMENUPOPUP
            '--- first, give WindowList menu a chance to fill visible MDI children
            lReturn = m_oSubclass.CallOrigWndProc(uMsg, wParam, lParam)
            bHandled = True
            '--- then, change type to ownerdrawn
            Call pvInitMenu(wParam, False)
          Case WM_MEASUREITEM
            If wParam = 0 Then
                '--- first, forward to child MDI window
                hMdiChild = pvGetMdiChild
                If hMdiChild <> 0 Then
                    If SendMessage(hMdiChild, uMsg, wParam, lParam) <> 0 Then
                        bHandled = True
                        lReturn = 1
                        Exit Sub
                    End If
                End If
                '--- then, process locally
                If pvMeasureItem(lParam) Then
                    bHandled = True
                    lReturn = 1
                End If
            End If
          Case WM_DRAWITEM
            If wParam = 0 Then
                '--- first, forward to child MDI window
                hMdiChild = pvGetMdiChild
                If hMdiChild <> 0 Then
                    If SendMessage(hMdiChild, uMsg, wParam, lParam) <> 0 Then
                        bHandled = True
                        lReturn = 1
                        Exit Sub
                    End If
                End If
                '--- then, process locally
                If pvDrawItem(lParam) Then
                    bHandled = True
                    lReturn = 1
                End If
            End If
          Case WM_NCCALCSIZE
            If m_hFormMenu = 0 Then
                m_hFormMenu = GetMenu(m_hFormHwnd)
                If m_hFormMenu <> 0 Then
                    '--- set main menu ownerdrawn
                    Call pvInitMenu(m_hFormMenu, True)
                End If
            End If
          Case WM_MENUSELECT
            If m_cMenuSubclass.Count > 0 Then
                hPrevMenuWnd = m_cMenuSubclass(m_cMenuSubclass.Count).hwnd
                '--- win9x: if not positioned yet -> delay message
                If IsWindowVisible(hPrevMenuWnd) = 0 And Not bDelayed Then
                    bDelayed = True
                    PostMessage hwnd, uMsg, wParam, lParam
                    lReturn = 0
                    bHandled = True
                    Exit Sub
                End If
            End If
            bDelayed = False
            m_hLastMenu = GetSubMenu(lParam, wParam And &HFFFF&)
            If m_hLastMenu = 0 Then
                m_hLastMenu = lParam
            End If
            '--- if system menu -> dont position at all
            If (wParam And (MF_SYSMENU * &H10000)) <> 0 Then
                m_hLastSelMenu = 0
              Else
                GetMenuItemRect IIf(lParam = m_hFormMenu, _
                                IIf((wParam And &H2000000) <> 0, _
                                m_hParentHwnd, _
                                m_hFormHwnd), _
                                hPrevMenuWnd), lParam, wParam And &HFFFF&, m_rcLastSelMenu
                '--- get item info
                With mii
                    If OsVersion >= &H40A Then '--- &H40A = win98 and later
                        .cbSize = Len(mii)
                        .fMask = MIIM_FTYPE
                      Else
                        .cbSize = Len(mii) - 4
                        .fMask = MIIM_TYPE
                        sBuffer = String(1024, 0)
                        .dwTypeData = StrPtr(sBuffer)
                        .cch = Len(sBuffer)
                    End If
                End With
                Call GetMenuItemInfo(lParam, wParam And &HFFFF&, 1, mii)
                m_bLastSelMenuRightAlign = (mii.fType And MFT_RIGHTJUSTIFY) <> 0
                m_hLastSelMenu = lParam
            End If
            '--- if MDI child -> flag and forward
            hMdiChild = pvGetMdiChild
            If hMdiChild <> 0 Then
                SendMessage hMdiChild, WM_MENUSELECT, &H2000000 Or (wParam And &H2000FFFF), lParam
            End If

            '--- menuchar function added for NT operating systems
            '--- added by NR 05/11/2003
            '--- improved and fixed by Vlad 17/11/2003
          Case WM_MENUCHAR
            '--- first, forward to child MDI  window
            Debug.Print "wm_menuchar2"
            hMdiChild = pvGetMdiChild

            If hMdiChild <> 0 Then
                lReturn = SendMessage(hMdiChild, pvInitMenuMsg, ucsIniMenuChar + (wParam And &HFFFF&) * &H10000, lParam)
                If lReturn <> 0 Then
                    bHandled = True
                    Exit Sub
                End If
            End If

            '---  then process  locally
            bHandled = pvHandleMenuChar(lParam, wParam And &HFFFF&, lReturn)

          Case WM_SYSCOLORCHANGE
            pvGetMeasures
          Case WM_NCDESTROY
            Call pvRestoreMenus(0)
            Do While m_cMenuSubclass.Count > 0
                m_cMenuSubclass.Remove 1
            Loop

            Do While m_cBmps.Count > 0
                m_cBmps.Remove 1
            Loop
            Do While m_cMemDC.Count > 0
                m_cMemDC.Remove 1
            Loop
            '--- release circular references (ISubclassingSink interface of Me)
            m_oSubclass.Unsubclass
            m_oClientSubclass.Unsubclass
#If WEAK_REF_CURRENTMENU Then
            CopyMemory VarPtr(g_oCurrentMenu), VarPtr(0), 4
#Else
            Set g_oCurrentMenu = Nothing
#End If

          Case WM_MDISETMENU
            If m_hFormMenu <> wParam Then
                Call pvRestoreMenus(0)
                m_hFormMenu = wParam
                '--- set main menu ownerdrawn
                Call pvInitMenu(m_hFormMenu, True)
            End If
          Case pvInitMenuMsg
            bHandled = True
            lReturn = 1
            Select Case (wParam And &HFFFF&)
              Case ucsIniMenu
                Call pvInitMenu(lParam, False)
              Case ucsIniMainMenu
                Call pvInitMenu(lParam, True)
              Case ucsIniExitMenuLoop
                m_bExpectingPopup = False
              Case ucsIniEnterMenuLoop
                m_bExpectingPopup = True
                m_hFormMenu = lParam
              Case ucsIniParentForm
                m_hParentHwnd = lParam
              Case ucsIniMenuChar
                Debug.Print "ucsinimenuchar"
                pvHandleMenuChar lParam, wParam \ &H10000, lReturn
            End Select
          Case WM_ENTERMENULOOP
            '--- first, forward to child MDI window
            hMdiChild = pvGetMdiChild
            If hMdiChild <> 0 Then
                If SendMessage(hMdiChild, pvInitMenuMsg, ucsIniEnterMenuLoop, m_hFormMenu) = 1 Then
                    Call SendMessage(hMdiChild, pvInitMenuMsg, ucsIniParentForm, m_hFormHwnd)
                    bHandled = True
                    lReturn = 1
                    Exit Sub
                End If
            End If
            '--- then process locally
            m_bExpectingPopup = True
          Case WM_EXITMENULOOP
            '--- first, forward to child MDI window
            hMdiChild = pvGetMdiChild
            If hMdiChild <> 0 Then
                If SendMessage(hMdiChild, pvInitMenuMsg, ucsIniExitMenuLoop, 0) = 1 Then
                    bHandled = True
                    lReturn = 1
                    RaiseEvent Highlight("")
                    Exit Sub
                End If
            End If
            '--- then process locally
            m_bExpectingPopup = False
            '-- Raise Highlight Event To Display Nothing As The Menu is Being Destroyed
            RaiseEvent Highlight("")
        End Select
      Else '--- popup menus
        Select Case uMsg
          Case WM_ERASEBKGND
            lsHwnd = hwnd
            m_blnFirstMenuInitialize = False
            pvGetBackground(hwnd).BitBlt wParam, -1, -2
            bHandled = True
            lReturn = 1
          Case WM_NCCALCSIZE
            m_blnFirstMenuInitialize = False
            CopyMemory VarPtr(rc), lParam, Len(rc)
            With rc
                .Left = .Left + 1
                .Top = .Top + 2
                .Right = .Right - 4
                .Bottom = .Bottom - 2
            End With