API MenuPopUp (Facil)

Option Compare Database
Option Explicit

'***************************************************************
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&               Jefferson Jimenez (JJJT)                     &*
'&                 Cabimas - Venezuela                        &*
'&                     Mayo - 2010                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'***************************************************************
'&
http://sites.google.com/site/jjjt1973/ejemplos-access      &*
'& Crear un Menu PopUp recurriendo al API de Windows          &*
'& Referencia Alessandro Baraldi                              &*
'***************************************************************

'Constantes del Menu
Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&
Private Type POINTAPI
    X As Long
    Y As Long
End Type
'Declaraciones al API de WINDOWS
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal HWnd As Long, ByVal lptpm As Any) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Variables de Uso
Dim hMenu As Long
Dim Sel As Boolean
Sub MenuPopUp(frm As Form)
    Dim Pt As POINTAPI
    Dim ret As Long
    hMenu = CreatePopupMenu()
    AppendMenu hMenu, TPM_LEFTALIGN, 1, "Hola ..!"
    AppendMenu hMenu, MF_GRAYED, 2, "Protegido"
    AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
    If Sel = False Then
    AppendMenu hMenu, MF_CHECKED, 4, "Desactivar"
    Else
    AppendMenu hMenu, MF_STRING, 4, "Activar"
    End If
    AppendMenu hMenu, MF_STRING, 5, "Salir...?"
    GetCursorPos Pt
    ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or _
                            TPM_RETURNCMD Or _
                            TPM_RIGHTBUTTON, _
                            Pt.X, Pt.Y, frm.HWnd, ByVal 0&)
   
    Select Case ret
    Case 1
        MsgBox "Hola Programador", vbExclamation, "Menu PopUp"
    Case 4
        If Sel Then
          Sel = False
           Else
          Sel = True
        End If
    Case 5
        MsgBox "Salimos de Access" & vbCr & "Adios....!", vbExclamation, "Menu PopUp"
        DoCmd.Quit
    End Select
   
    DestroyMenu hMenu
End Sub

SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descargue El Ejemplo  21 kb v. 3 27 may. 2010 16:31 Jefferson Jimenez
Comments