MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    Nova InputBox

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3845
    Registrado : 22/11/2016

    Nova InputBox Empty Nova InputBox

    Mensagem  DamascenoJr. 7/11/2020, 02:25

    Aproveitando o gancho desse tópico, lembrando que participei desse tópico, e seguindo a lógica empregada no código desse tópico, deixo uma função que junta a inputbox normal e a mascarada em uma só função.

    Código:
    #If VBA7 Then

        Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
        Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
        Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
       
        Private hHook As LongPtr

        Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
           
            Dim strClassName As String
       
            If lngCode < 0 Then
                NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
                Exit Function
            End If
       
            strClassName = String$(256, " ")
       
            If lngCode = 5 Then
                If left$(strClassName, GetClassName(wParam, strClassName, 255)) = "#32770" Then
                    Call SendDlgItemMessage(wParam, &H1324, &HCC, Asc("*"), &H0)
                End If
            End If
       
            Call CallNextHookEx(hHook, lngCode, wParam, lParam)
       
        End Function
       
    #Else

        Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
        Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
        Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
        Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
        Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
       
        Private hHook As Long

        Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
           
            Dim strClassName As String
       
            If lngCode < 0 Then
                NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
                Exit Function
            End If
       
            strClassName = String$(256, " ")
       
            If lngCode = 5 Then
                If left$(strClassName, GetClassName(wParam, strClassName, 255)) = "#32770" Then
                    Call SendDlgItemMessage(wParam, &H1324, &HCC, Asc("*"), &H0)
                End If
            End If
       
            Call CallNextHookEx(hHook, lngCode, wParam, lParam)
       
        End Function
       
    #End If

    Public Function fncInputBox(ByVal strTexto As String, _
                                Optional ByVal strTitulo As String, _
                                Optional ByVal strValorPadrao As String, _
                                Optional ByVal booUsarMascara As Boolean = False, _
                                Optional ByVal intPosHorizontal, _
                                Optional ByVal intPosVertical) _
                                As String
    ' ----------------------------------------------------------------
    ' Propósito : Capturar uma entrada do usuário (com ou sem máscara).
    ' ----------------------------------------------------------------

        If booUsarMascara Then
            hHook = SetWindowsHookEx(5, AddressOf NewProc, GetModuleHandle(""), GetCurrentThreadId)
            fncInputBox = InputBox(strTexto, strTitulo, strValorPadrao, intPosHorizontal, intPosVertical)
            Call UnhookWindowsHookEx(hHook)
        Else
            fncInputBox = InputBox(strTexto, strTitulo, strValorPadrao, intPosHorizontal, intPosVertical)
        End If

    End Function


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

    Lelio Guedes e Holanda gostam desta mensagem


      Data/hora atual: 7/11/2024, 21:33