Menús contextuales

Podemos usar la siguiente documentación Crear un menú contextual para un formulario, un control de formulario o un informe.

Para ver los distintos idMso, podemos mirar en Office 2016 Help Files: Office Fluent User Interface Control Identifiers.

En el archivo subcontextbars.bas podemos ver las rutinas básicas para crear menús contextuales para las columnas, las filas y las celdas.

Normalmente colocaremos los menús contextuales en los formularios para listados ya que están en modo datasheet view. Si usamos la versión runtime de Access los menús contextuales estándares tampoco están disponibles por lo que tenemos que emularlos.

La primera aproximación es generar un menú y mostrarlo en el evento MouseUp del formulario. Sin embargo, los menús variarán dependiendo de si hemos pulsado sobre una columna, una fila o una celda.

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = acRightButton Then DatasheetPopups Me
End Sub

Para distinguir cómo hemos pulsado se usa la función DatasheetPopups. Esta función lanzará el menú correspondiente.

También se puede llamar a la función con un parámetro opcional para forzar una barra especial para fechas, números y texto en lugar de la estándar, sólo en el caso de las celdas. Estos menús se pueden mostrar llamándolas desde el evento MouseUp de cada campo, por ejemplo:

Private Sub Fecha_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = acRightButton Then DatasheetPopups Me, "ctxBarFecha"
End Sub

Private Sub Lectura_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = acRightButton Then DatasheetPopups Me, "ctxBarNumero"
End Sub

Este acercamiento no es muy eficiente, ya que hay que crear un evento para cada campo. Es mas práctico asignar la misma función a todos los controles. Esto se hace en:

Private Sub Form_Open(Cancel As Integer)
    SetControlEvents Me
End Sub

La función SetControlEvents recorre todos los controles del formulario, y de momento sólo a los que son de tipo acTextBox (normalmente todos en este tipo de formularios), se le asigna la macro MouseUp al evento OnMouseUp.

Hay que indicar que forzosamente hay que crear la macro MouseUp del tipo EjecutarCódigo y que a su vez llama a la función (debe ser una función), MouseUp. Es un poco farragoso, pero en Access se tiene que hacer así.

De manera general se usan los menús ctxBarColumna, ctxBarFila y ctxBarCelda, que se crean en las funciones CrearCtxBarColumna, CrearCtxBarFila y CrearCtxBarCelda respectivamente. Estas funciones se suelen invocar al iniciar la BD, por ejemplo en algún módulo que se ejecute en el AutoExec.

Se han hecho además los tres menús ctxBarFecha y ctxBarTexto que se crean con las funciones CrearCtxBarFecha, CrearCtxBarTexto y CrearCtxBarNumero respectivamente. Estos menús añaden mas opciones de búsqueda al menú ctxBarCelda dependiendo del tipo del campo que sea, que es lo mismo que hace Access de manera estándar.

Función MouseUp()

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Function MouseUp()
    Dim ctlCurrentControl As control
    Dim frmCurrentForm As Form
    Dim strMenu As String
    
    On Error Resume Next
    
    'Se chequea sie se ha pulsado el botón derecho, pero hay que hacerlo con una función del API
    If GetAsyncKeyState(2) Then
        Set frmCurrentForm = Screen.ActiveForm
        Set ctlCurrentControl = Screen.ActiveControl
        strMenu = ctlCurrentControl.Tag
        DatasheetPopups frmCurrentForm, strMenu
    End If
End Function

Esta función se usa para llamar a la función DatasheetPopups al pulsar sobre un control, se chequea si es el botón derecho para hacerlo sólo en este caso.

Función DatasheetPopups()

Public Sub DatasheetPopups(frm As Form, Optional ctxMenu As String)
    Dim strMenu As String
    
    If (frm.SelHeight = 0) And (frm.SelWidth = 0) Then
        If ctxMenu = vbNullString Then
            strMenu = "ctxBarCelda"
        Else
            strMenu = ctxMenu
        End If
    End If
    If (frm.SelHeight >= frm.RecordsetClone.RecordCount) And (frm.SelWidth = 1) Then
        strMenu = "ctxBarColumna"
    End If
    If (frm.SelHeight = 1) And (frm.SelWidth > 0) Then
        strMenu = "ctxBarFila"
    End If

    If Len(strMenu) > 0 Then
        CommandBars(strMenu).ShowPopup
    End If
End Sub

Esta función se usa para activar el menú contextual dependiendo de si hemos pulsado en el botón de columna, el de fila, o en una celda. En este último caso, se pasa el parámetro opcional ctxMenu para lanzar los menús mas especializados para texto, número y fecha.

Función SetControlEvents()

Public Sub SetControlEvents(frm As Form)
    Dim ctrl As Access.control
    Dim tipoCampo As Integer
    Dim strMenu As String
    
    For Each ctrl In frm.Controls
        If ctrl.ControlType = acTextBox Then
            tipoCampo = CurrentDb.TableDefs(frm.RecordSource).Fields(ctrl.ControlSource).type
            Select Case tipoCampo
                Case dbDate, dbTime
                    strMenu = "ctxBarFecha"
                Case dbBigInt, dbByte, dbCurrency, dbDecimal, dbDouble, dbFloat, dbInteger, dbLong, dbNumeric
                    strMenu = "ctxBarNumero"
                Case dbChar, dbText
                    strMenu = "ctxBarTexto"
                Case Else
                    strMenu = vbNullString
            End Select
            
            ctrl.Tag = strMenu
            ctrl.OnMouseUp = "MouseUp"
        End If
    Next
End Sub

Esta función se usa para recorrer todos los controles del formulario en modo datasheet view en el que queremos activar los menús contextuales. Si no ponemos ningún evento asociado a los controles no podemos capturar el evento y lanzar los correspondientes menús. Como hacer ésto es muy farragoso y depende de los campos de cada tabla, recorremos todos los controles, vemos de que tipo son y le asignamos la barra correspondiente usando el campo Tag. Por último le asignamos la macro MouseUp en el evento OnMouseUp. Se comprueba el tipo de datos en este momento para qu luego sea mas rápido mostrar los menús.

Normalmente se llamará en el evento Open del formulario lista, aunque se podría hacer en Load o en Activate, pero así los tenemos separados.

Public Sub CrearCtxBarCelda()
    Dim cmbRightClick As CommandBar
    Dim cmbControl As CommandBarControl
    
    On Error Resume Next
    CommandBars("ctxBarCelda").Delete
    On Error GoTo 0
    
    'Create the shortcut menu.
    Set cmbRightClick = CommandBars.Add("ctxBarCelda", msoBarPopup, False, True)

    With cmbRightClick
        ' Add the Cut command.
        Set cmbControl = .Controls.Add(msoControlButton, 21, , , True)

        ' Add the Copy command.
        Set cmbControl = .Controls.Add(msoControlButton, 19, , , True)

        ' Add the Paste command.
        Set cmbControl = .Controls.Add(msoControlButton, 22, , , True)
        
        ' Add the SortUp command.
        Set cmbControl = .Controls.Add(msoControlButton, 210, , , True)
        ' Start a new group.
        cmbControl.BeginGroup = True

        ' Add the SortDown command.
        Set cmbControl = .Controls.Add(msoControlButton, 211, , , True)

        ' Add the FilterClearAllFilters command.
        Set cmbControl = .Controls.Add(msoControlButton, 605, , , True)
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        ' Add the FilterEqualsSelection command.
        Set cmbControl = .Controls.Add(msoControlButton, 10068, , , True)
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        ' Add the FilterNotEqualsSelection command.
        Set cmbControl = .Controls.Add(msoControlButton, 10071, , , True)
    End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
End Sub

Public Sub CrearCtxBarFila()
...
End Sub

Public Sub CrearCtxBarColumna()
...
End Sub

Estas funciones se usan para crear los menúes genéricos. A modo de ejemplo sólo se muestra el menú para las celdas. Se usan los comandos idMso estándares de Access para reproducir los menús estándares de Access. Las imágenes serán también las estándares del Access que tengamos instalado (normal o runtime), así que podría ser que querramos poner otros para mantener la estética, se verá más adelante.

            ' Add custom command.
            Set cmbButton = .Controls.Add(msoControlButton)
            ' Start a new group.
            cmbButton.BeginGroup = True
            cmbButton.OnAction = "AccionArribaT"
            cmbButton.Picture = getIconFromTable("symbol_upload.bmp")
            cmbButton.Mask = getIconFromTable("symbol_upload_mask.bmp")
            cmbButton.Caption = "Mover al principio"
        
            ' Add custom command.
            Set cmbButton = .Controls.Add(msoControlButton)
            cmbButton.OnAction = "AccionArriba"
            cmbButton.Picture = getIconFromTable("symbol_arrow_up.bmp")
            cmbButton.Mask = getIconFromTable("symbol_arrow_up_mask.bmp")
            cmbButton.Caption = "Mover arriba"

Se usa la función getIconFromTable que está en el módulo basRibbonCallbacks para obtener las imágenes de la tabla tblBinary.

También se podría haber usado la función getImageFromTable que está en el módulo subContextBars para obtener las imágenes de la tabla tblImages, aunque todavía no se ha probado.

En cualquier caso, no podemos cargar directamente un archivo PNG con canal alfa, sino que tenemos que cargar dos archivos BMP, uno para la imagen y otro para la máscara en blanco y negro, siendo el blanco las zonas transparentes de la imagen. Para obtener estas imágenes podemos usar el programa Axialis IconWorkshop.