Gwiazdki w InputBox-e

Czytając dzisiaj posty na forum dyskusyjnym goldenline.pl natrafiłem na bardzo elegancki sposób realizacji tytułowych gwiazdek w InputBox-e. Rozwiązanie opiera się o API Windows i wygląda następująco:

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 Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook  As Long



Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String
    Dim lngBuffer As Long
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
    strClassName = String$(256, " ")
    lngBuffer = 255
    If lngCode = HCBT_ACTIVATE Then
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function



Public Function InputBoxDK(Prompt, _
                           Optional Title, _
                           Optional Default, _
                           Optional XPos, _
                           Optional YPos, _
                           Optional HelpFile, _
                           Optional Context) As String
    Dim lngModHwnd As Long
    Dim lngThreadID As Long
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    On Error Resume Next
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
End Function

Sub PasswordBox()

    If InputBoxDK("Proszą wprowadzić hasło", "Wymagane hasło") <> "ania" Then
        MsgBox "Niestety, to nie było prawidłowe hasło."
    Else
        MsgBox "Hasło prawidłowe! Zapraszamy."
    End If

End Sub

Moim skromnym zdaniem rozwiązanie jest świetne gdyż nie musimy korzystać z dedykowanego userforma, co w wielu przypadkach jest idealnym rozwiązaniem.