Início
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