菜单的掠过式提示

’ 1. 建立工程, 窗体名: Form1 ==> Label控件, 名称: lblStatus
’                            ==> 建立菜单若干

’ 2. 加入一个模块

’窗体中代码:

Private Sub Form_Load()
    origWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf AppWndProc)
End Sub

Private Sub Form_Resize()
    lblstatus.Move 0, ScaleHeight - lblstatus.Height, ScaleWidth
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong hwnd, GWL_WNDPROC, origWndProc
End Sub

’模块中代码:

Option Explicit

’NOTE: This code MUST go in a standard module.

Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Public Declare Function CallWindowProc Lib "user32" Alias _
    "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                       ByVal hwnd As Long, ByVal Msg As Long, _
                       ByVal wParam As Long, _
                       ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias _
            "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
                             ByVal cbCopy As Long)

Public Declare Function GetMenuItemInfo Lib "user32" Alias _
        "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
                            ByVal b As Boolean, lpMenuItemInfo As _
                            MENUITEMINFO) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
            "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As _
                              Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_SYSMENU = &H2000&
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public origWndProc As Long


Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg _
        As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim iHi As Integer, iLo As Integer

Select Case Msg
    Case WM_MENUSELECT
        form1.lblstatus.Caption = ""
        CopyMemory iLo, wParam, 2
        CopyMemory iHi, ByVal VarPtr(wParam) + 2, 2
        If (iHi And MF_SYSMENU) = 0 Then
            Dim m As MENUITEMINFO, aCap As String
            m.dwTypeData = Space$(64)
            m.cbSize = Len(m)
            m.cch = 64
            m.fMask = MIIM_DATA Or MIIM_TYPE
            If GetMenuItemInfo(lParam, CLng(iLo), False, m) Then
                aCap = m.dwTypeData & Chr$(0)
                aCap = Left$(aCap, _
                InStr(aCap, Chr$(0)) - 1)
                form1.lblstatus.Caption = CStr(aCap)

’Select Case aCap

’Case "&Open": _
’form1.lblstatus.Caption = _
’"Open a file"
’Case "&Save": _
’form1.lblstatus.Caption = _
’"Save a file"
’End Select
             End If
        End If
    End Select
AppWndProc = CallWindowProc(origWndProc, hwnd, Msg, wParam, lParam)

End Function
 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值