'******************************************************
'
' InputBoxEx
'
' Función que amplía el InputBox de VBA, confiriéndole
' diferentes estilos (contenidos en la enumeración
' StyleInputBox). También, en su último argumento (MaxChar)
' podemos limitar el número de caracteres que se podrán
' introducir.
'
' Uso:
'
'   Function InputBoxEx( _
'            Prompt, _      véase en la ayuda InputBox
'            [Title], _             "       "
'            [Default], _           "       "
'            [XPos], _              "       "
'            [YPos], _              "       "
'            [HelpFile], _          "       "
'            [Context] _            "       "
'            [Style] _ ------> cualquiera de los valores de la enumeración StyleInputBox
'            [MaxChar])------> si su valor es diferente de 0 marca el límite de
'                              caracteres admitidos por el InputBox
'
' Ejemplo: (muestra un InputBox para introducir contraseñas, con el límite de
'           10 caracteres)
'
'  Contraseña = InputBoxEx("Mensaje", "Titulo", , , , , , SPassword, 10)'
' Autor: Juan M. Afan de Ribera
'        Abril 2004
'
' Saludos :-)
' happy
'*********************************************************************

' estilos del InputBoxEx
Public Enum StyleInputBox
    SNone       ' InputBox normal
    SPassword   ' máscara oculta
    SNumber     ' sólo números
    SLowerCase  ' sólo minúsculas
    SUpperCase  ' sólo mayúsculas
End Enum

' ***************** Para ocultar el botón cancelar ********************
' he añadido esta función para poder usarla y ocultar el botón cancelar
Private Declare Function ShowWindow Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nCmdShow As Long) As Long
' *********************************************************************

Private Declare Function FindWindowEx Lib "user32" _
                Alias "FindWindowExA" _
                (ByVal hWnd1 As Long, _
                ByVal hWnd2 As Long, _
                ByVal lpsz1 As String, _
                ByVal lpsz2 As String) As Long
                
Private Declare Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
                (ByVal hwnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long) As Long
                
Private Declare Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
                (ByVal hwnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long
                
Private Declare Function SetTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long, _
                ByVal uElapse As Long, _
                ByVal lpTimerFunc As Long) As Long
                
Private Declare Function KillTimer Lib "user32" _
                (ByVal hwnd As Long, _
                ByVal nIDEvent As Long) As Long

Private Const GWL_STYLE = (-16)

' constantes con los estilos de
' controles 'EDIT'
Private Const ES_UPPERCASE = &H8
Private Const ES_LOWERCASE = &H10
Private Const ES_PASSWORD = &H20
Private Const ES_NUMBER = &H2000

' mensaje para establecer el caracter que se mostrará
' como máscara para el InputBoxEx tipo contraseña
Private Const EM_SETPASSWORDCHAR = &HCC
' constante que contiene el carácter que se mostrará
' (este valor puede ser cualquier otro, en este caso
' he escogido el típico asterisco)
Private Const KEY_MASK = 42& ' "*"
' mensaje para establecer el número máximo de
' caracteres permitidos
Private Const EM_LIMITTEXT = &HC5

Private SInputBox As StyleInputBox
Private hInputBox As Long
Private cChar As Long
Private Const SW_HIDE = 0&

Public Function InputBoxEx( _
                Prompt, _
                Optional Title, _
                Optional Default, _
                Optional XPos, _
                Optional YPos, _
                Optional HelpFile, _
                Optional Context, _
                Optional Style As StyleInputBox = SNone, _
                Optional MaxChar As Long) As String
              
    ' si no hay ningún otro InputBoxEx abierto...
    If hInputBox = 0 Then
       ' Creamos un timer que se ejecutará a la décima de segundo
       Call SetTimer(Access.hWndAccessApp, 0&, 100, AddressOf TimerProc)
    
       SInputBox = Style
       cChar = MaxChar
       ' llamamos al InputBox de manera normal
       On Error GoTo AnularTimer
       InputBoxEx = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    End If
    
    Exit Function
    
AnularTimer:
    ' si ha habido algún error, se cancela la operación
    Call KillTimer(Access.hWndAccessApp, 0&)
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    
End Function

Private Sub TimerProc( _
                     ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)
Dim hEdit As Long
Dim hButton As Long
Dim CurStyle As Long
    
    ' localizamos el manipulador de la ventana activa
    ' (se supone que es la ventana del InputBox)
    hInputBox = GetForegroundWindow
    ' localizamos el manipulador de la caja de texto
    ' del InputBox
    hEdit = FindWindowEx(hInputBox, 0&, "EDIT", vbNullString)

    ' **** esto ocultará el botón cancelar ******************
    ' localizamos la ventana del botón cancelar
    hButton = FindWindowEx(hInputBox, 0&, "Button", "Cancelar")
    ' y la ocultamos
    Call ShowWindow(hButton, SW_HIDE)
    ' *******************************************************

    ' obtenemos los estilos de la caja de texto ...
    CurStyle = GetWindowLong(hEdit, GWL_STYLE)
    
    Select Case SInputBox
        Case SPassword ' tipo password
            ' le decimos a la caja de texto cuál será el carácter
            ' que aparecerá en vez de lo que teclee el usuario
            Call SendMessage(hEdit, EM_SETPASSWORDCHAR, KEY_MASK, 0&)
            ' y le añadimos el estilo de introducción de contraseñas
            CurStyle = CurStyle Or ES_PASSWORD
        Case SNumber ' tipo número
            CurStyle = CurStyle Or ES_NUMBER
        Case SLowerCase ' tipo minúsculas
            CurStyle = CurStyle Or ES_LOWERCASE
        Case SUpperCase ' tipo mayúsculas
            CurStyle = CurStyle Or ES_UPPERCASE
    End Select
    
    If cChar > 0 Then
        Call SendMessage(hEdit, EM_LIMITTEXT, cChar, 0&)
    End If
    ' cambiamos el estilo
    Call SetWindowLong(hEdit, GWL_STYLE, CurStyle)
    ' desactivamos el timer para que sólo se ejecute esta vez
    Call KillTimer(Access.hWndAccessApp, 0&)
    hInputBox = 0
    
End Sub