VB6 - Original InputBox function reloaded with full Unicode support & new Edit Styles

[VanGoghGaming]

Every time I've searched the internet on how to make the InputBox function support Unicode, the answers were to make your own InputBox using a form, a couple of buttons and a TextBox that supports Unicode. But this seems like a waste of a perfectly fine InputBox that you already have!

The original InputBox from VB6 is actually a simple, run-of-the-mill Windows Dialog and as such it is perfectly capable of displaying Unicode characters on its own if it weren't for VB6 messing things up in the background. It turns out the solution is rather short and sweet so I've put together a small "cIB" class to wrap up the InputBox.

As a bonus I've also included the possibility to use a "Password Char" to mask user input (same as a regular TextBox). Another improvement over the original InputBox is that now you can tell whether the user selected "OK" or "Cancel" without entering any text. Unicode characters can be used everywhere (in the Titlebar, Prompt and Edit box). Here's what it looks like:



UPDATE: The Unicode InputBox class has been enhanced with additional properties:

• Centered - You can center the InputBox on the current monitor or on its owner window.
• EnablePasswordChar - You can specify an optional character to mask the password with. If omitted then the standard asterisk will be displayed.
• InputFontColor - Select a different text and/or background color for the "Input" text
• OnlyNumericInput - Force the InputBox to accept only Numeric Input.
• OnlyUppercase - Force the InputBox to display only "UPPERCASE" characters.
• OnlyLowercase - Force the InputBox to display only "lowercase" characters.
• MaxLength - Limit the InputBox text to the specified number of characters.
• PromptFontColor - Select a different text and/or background color for the "Prompt" text
• RequireInput - The user MUST type something in the InputBox but can still press "Cancel" if desired.

UPDATE: In this update I have added the SetFont method which allows the possibility to select a font for the InputBox prompt. You can specify either the Font object of an existing control as a parameter or you can manually specify a font name, size and a combination of bold, italic and underline attributes. Optionally you can preserve the selected font between successive calls of the InputBox:



UPDATE: The InpuBox size is calculated automatically in case your "Prompt" text doesn't fit in the default size. Some new features have been added as well:

Now you can customize the text and/or background color of the "Prompt" and "Input" text fields (in addition to their font and size attributes). The edit box has been enhanced with a "placeholder text" (also known as "cue banner") that provides visual cues in case the user is required to type something in the InputBox.

The placeholder text goes away automatically when you click in the edit box or begin to type. Also now you can make the InputBox mandatory by removing the possibility to cancel or close it until the user types something (this option is not recommended though as it makes for an overall poor user experience):



The main "InputBoxW" property is marked as "Default" to keep the syntax as short as possible. The "cIB" class is also "Predeclared" so it can be used "as is" without declaring new instances:

cIB.cls

Implements ISubclass

Private sInputText As String, sPrompt As String, sTitle As String, wPasswordChar As Integer, m_bOkayClicked As Boolean, m_bEnablePasswordChar As Boolean, m_sCueBanner As String, _
        m_objFontStatic As IFont, m_objFontEdit As IFont, m_lMaxLength As Long, m_bOnlyNumericInput As Boolean, m_bOnlyUppercase As Boolean, m_bOnlyLowercase As Boolean, m_bPreserveFont As Boolean, _
        m_bPreserveStyle As Boolean, m_PromptFontColor, m_InputFontColor, m_PromptBackColor, m_InputBackColor, m_lInputBoxStyle As Long, m_bRequireInput As Boolean, m_bAllowCancel As Boolean, _
        m_bCentered As Boolean, hWndEdit As Long, hWndStatic As Long, rcInputBox As RECT, wpStatic As WINDOWPLACEMENT, wpEdit As WINDOWPLACEMENT, hBrushStatic As Long, hBrushEdit As Long, _
        rcOwner As RECT, lAdjustStaticHeight As Long, lAdjustEditHeight As Long, lScreenHeight As Long, lOwnerWidth As Long, lOwnerHeight As Long

Public Property Get InputBoxW(Optional Prompt As String, Optional Title As String, Optional Default As String, Optional bInputCanceled As Boolean, Optional xPos, Optional yPos) As String
    If InputBoxHook(Me) Then ' Hook the DialogBoxParamA API function used to create the InputBox Dialog, subclass it and initialize the parameters
        sPrompt = Prompt: sTitle = Title: sInputText = Default
        InputBox sPrompt, , , xPos, yPos ' Display the classic VB6 InputBox Dialog
        bInputCanceled = Not m_bOkayClicked ' Return user's choice
        If m_bOkayClicked Then InputBoxW = sInputText
        If Not m_bPreserveFont Then Set m_objFontStatic = Nothing: Set m_objFontEdit = Nothing
        If Not m_bPreserveStyle Then m_lInputBoxStyle = 0
    End If
End Property

Public Property Let InputBoxW(Optional Prompt As String, Optional Title As String, Optional Default As String, Optional bInputCanceled As Boolean, Optional xPos, Optional yPos, InputBoxW As String)
    ' Property Let doesn't do anything but it's required to mark this property as "Default" for our class.
End Property

Friend Property Get Centered(Optional hWndOwner As Long) As Boolean
    Centered = m_bCentered
End Property

Friend Property Let Centered(Optional hWndOwner As Long, bCentered As Boolean)
    m_bCentered = bCentered
    If m_bCentered Then
        With rcOwner
            If hWndOwner Then
                GetWindowRect hWndOwner, VarPtr(rcOwner)
                lOwnerWidth = .Right - .Left: lOwnerHeight = .Bottom - .Top
            Else
                .Left = 0: .Top = 0: .Right = 0: .Bottom = 0: lOwnerWidth = 0: lOwnerHeight = 0
            End If
        End With
    End If
End Property

Friend Property Get EnablePasswordChar(Optional PasswordChar As String) As Boolean
    PasswordChar = ChrW$(wPasswordChar): EnablePasswordChar = m_bEnablePasswordChar
End Property

Friend Property Let EnablePasswordChar(Optional PasswordChar As String = "*", bEnablePasswordChar As Boolean)
    m_bEnablePasswordChar = bEnablePasswordChar
    If m_bEnablePasswordChar Then wPasswordChar = AscW(PasswordChar) Else wPasswordChar = 0
End Property

Friend Property Get InputFontColor(Optional clrBackColor As ColorConstants) As ColorConstants
    clrBackColor = m_InputBackColor: InputFontColor = m_InputFontColor
End Property

Friend Property Let InputFontColor(Optional clrBackColor As ColorConstants = -1, clrFontColor As ColorConstants)
    If clrBackColor >= 0 Then m_InputBackColor = clrBackColor Else m_InputBackColor = Empty
    m_InputFontColor = clrFontColor
End Property

Friend Property Get PromptFontColor(Optional clrBackColor As ColorConstants) As ColorConstants
    clrBackColor = m_PromptBackColor: PromptFontColor = m_PromptFontColor
End Property

Friend Property Let PromptFontColor(Optional clrBackColor As ColorConstants = -1, clrFontColor As ColorConstants)
    If clrBackColor >= 0 Then m_PromptBackColor = clrBackColor Else m_PromptBackColor = Empty
    m_PromptFontColor = clrFontColor
End Property

Friend Property Get MaxLength() As Long
    MaxLength = m_lMaxLength
End Property

Friend Property Let MaxLength(lMaxLength As Long)
    m_lMaxLength = lMaxLength
End Property

Friend Property Get OnlyNumericInput(Optional bPreserveStyle As Boolean) As Boolean
     bPreserveStyle = m_bPreserveStyle: OnlyNumericInput = m_bOnlyNumericInput
End Property

Friend Property Let OnlyNumericInput(Optional bPreserveStyle As Boolean = True, bOnlyNumericInput As Boolean)
    m_bPreserveStyle = bPreserveStyle: m_bOnlyNumericInput = bOnlyNumericInput
    If m_bOnlyNumericInput Then m_lInputBoxStyle = m_lInputBoxStyle Or ES_NUMBER Else m_lInputBoxStyle = m_lInputBoxStyle And Not ES_NUMBER
End Property

Friend Property Get OnlyUppercase(Optional bPreserveStyle As Boolean) As Boolean
    bPreserveStyle = m_bPreserveStyle: OnlyUppercase = m_bOnlyUppercase
End Property

Friend Property Let OnlyUppercase(Optional bPreserveStyle As Boolean = True, bOnlyUppercase As Boolean)
    m_bPreserveStyle = bPreserveStyle: m_bOnlyUppercase = bOnlyUppercase
    If m_bOnlyUppercase Then m_lInputBoxStyle = m_lInputBoxStyle Or ES_UPPERCASE Else m_lInputBoxStyle = m_lInputBoxStyle And Not ES_UPPERCASE
End Property

Friend Property Get OnlyLowercase(Optional bPreserveStyle As Boolean) As Boolean
    bPreserveStyle = m_bPreserveStyle: OnlyLowercase = m_bOnlyLowercase
End Property

Friend Property Let OnlyLowercase(Optional bPreserveStyle As Boolean = True, bOnlyLowercase As Boolean)
    m_bPreserveStyle = bPreserveStyle: m_bOnlyLowercase = bOnlyLowercase
    If m_bOnlyLowercase Then m_lInputBoxStyle = m_lInputBoxStyle Or ES_LOWERCASE Else m_lInputBoxStyle = m_lInputBoxStyle And Not ES_LOWERCASE
End Property

Friend Property Get RequireInput(Optional sCueBanner As String, Optional bAllowCancel As Boolean) As Boolean
    sCueBanner = m_sCueBanner: bAllowCancel = m_bAllowCancel: RequireInput = m_bRequireInput
End Property

Friend Property Let RequireInput(Optional sCueBanner As String, Optional bAllowCancel As Boolean = True, bRequireInput As Boolean)
    m_bAllowCancel = bAllowCancel: m_bRequireInput = bRequireInput
    If m_bRequireInput Then m_sCueBanner = sCueBanner Else m_sCueBanner = vbNullString
End Property

Friend Sub SetFont(Optional eSelectFont As SELECT_FONTS = ePromptFont, Optional ByVal objFont As IFont, Optional sFontFace As String, Optional cyFontSize As Currency, Optional CFS_FONTSTYLE As CFS_FONTSTYLES = CFS_FONTSTYLENONE, Optional bPreserveFont As Boolean = True)
Dim fdFontDesc As FONTDESC, IID_FONT(0 To 1) As Currency
    m_bPreserveFont = bPreserveFont
    If objFont Is Nothing Then
        With fdFontDesc
            .cbSizeofstruct = LenB(fdFontDesc): .lpstrName = StrPtr(sFontFace): .cySize = cyFontSize
            If (CFS_FONTSTYLE And CFE_BOLD) = CFE_BOLD Then .sWeight = FW_BOLD Else .sWeight = FW_REGULAR
            .fItalic = (CFS_FONTSTYLE And CFE_ITALIC) = CFE_ITALIC: .fUnderline = (CFS_FONTSTYLE And CFE_UNDERLINE) = CFE_UNDERLINE
        End With
        IID_FONT(1) = IID_IUnknown1: OleCreateFontIndirect VarPtr(fdFontDesc), VarPtr(IID_FONT(0)), objFont
    End If
    Select Case eSelectFont
        Case ePromptFont: Set m_objFontStatic = objFont
        Case eInputFont: Set m_objFontEdit = objFont
    End Select
End Sub

Private Sub Class_Initialize()
    wpStatic.Length = LenB(wpStatic): wpEdit.Length = LenB(wpEdit)
End Sub

Private Sub CenterInputBox(hWnd As Long)
    GetWindowRect hWnd, VarPtr(rcInputBox)
    With rcInputBox
        If lOwnerHeight Then
            SetWindowPos hWnd, 0, rcOwner.Left + (lOwnerWidth - .Right + .Left) \ 2, rcOwner.Top + (lOwnerHeight - .Bottom + .Top) \ 2, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
        Else
            SetWindowPos hWnd, 0, .Left, (lScreenHeight - .Bottom + .Top) \ 2, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
        End If
    End With
End Sub

Private Function GetTextHeight(hWnd As Long, hDC As Long) As Long
Dim rcText As RECT, lpSize As POINTAPI, sText As String, lOldFont As Long
    Select Case hWnd
        Case hWndStatic
            If Len(sPrompt) Then sText = sPrompt Else sText = Space$(1)
            rcText = wpStatic.rcNormalPosition
            DrawTextW hDC, StrPtr(sText), Len(sText), VarPtr(rcText), DT_CALCRECT Or DT_EDITCONTROL Or DT_WORDBREAK Or DT_NOPREFIX ' Calculate the height of the "Prompt" text
            GetTextHeight = rcText.Bottom - rcText.Top
        Case hWndEdit
            If Len(sInputText) Then sText = sInputText Else sText = Space$(1)
            lOldFont = SelectObject(hDC, SendMessageW(hWnd, WM_GETFONT, 0&, 0&))
            GetTextExtentPoint32W hDC, StrPtr(sText), Len(sText), VarPtr(lpSize) ' Calculate the height of the "Input" text
            GetTextHeight = lpSize.Y: SelectObject hDC, lOldFont
    End Select
End Function

Private Function ISubclass_WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal dwRefData As Long, bDiscardMessage As Boolean) As Long
Dim lTextLen As Long, rcEdit As RECT, hDC As Long
    Select Case uMsg
        Case WM_INITDIALOG
            hDC = GetDC(hWnd): lScreenHeight = GetDeviceCaps(hDC, VERTRES): ReleaseDC hWnd, hDC
            hWndStatic = GetDlgItem(hWnd, ID_STATIC): hWndEdit = GetDlgItem(hWnd, ID_EDIT)
            If m_bRequireInput And Not m_bAllowCancel Then ShowWindow GetDlgItem(hWnd, IDCANCEL), SW_HIDE: SetWindowLongW hWnd, GWL_STYLE, GetWindowLongW(hWnd, GWL_STYLE) And Not WS_SYSMENU
            If m_lInputBoxStyle Then SetWindowLongW hWndEdit, GWL_STYLE, GetWindowLongW(hWndEdit, GWL_STYLE) Or m_lInputBoxStyle
        Case WM_SHOWWINDOW ' The InputBox Dialog is about to be displayed and ready to be modified
            GetWindowRect hWnd, VarPtr(rcInputBox): GetWindowPlacement hWndStatic, VarPtr(wpStatic): GetWindowPlacement hWndEdit, VarPtr(wpEdit)
            If Not (m_objFontStatic Is Nothing) Then
                lAdjustStaticHeight = wpStatic.rcNormalPosition.Bottom - wpStatic.rcNormalPosition.Top: SendMessageW hWndStatic, WM_SETFONT, m_objFontStatic.hFont, APITRUE
            End If
            If Not (m_objFontEdit Is Nothing) Then
                GetClientRect hWndEdit, VarPtr(rcEdit): lAdjustEditHeight = rcEdit.Bottom - rcEdit.Top: SendMessageW hWndEdit, WM_SETFONT, m_objFontEdit.hFont, APITRUE
            End If
            If Len(sTitle) Then SetWindowTextW hWnd, StrPtr(sTitle) ' Set the titlebar text
            If Len(sPrompt) Then SendMessageW hWndStatic, WM_SETTEXT, 0&, StrPtr(sPrompt) ' Set the "Prompt" text
            If wPasswordChar Then SendMessageW hWndEdit, EM_SETPASSWORDCHAR, CLng(wPasswordChar), 0& ' Optional password char to mask user input
            If Len(m_sCueBanner) Then SendMessageW hWndEdit, EM_SETCUEBANNER, APITRUE, StrPtr(m_sCueBanner) ' Optional cue banner to explain why input is required
            If m_lMaxLength > 0 Then SendMessageW hWndEdit, EM_SETLIMITTEXT, m_lMaxLength, 0&: sInputText = Left$(sInputText, m_lMaxLength)
            If Len(sInputText) Then SendMessageW hWndEdit, WM_SETTEXT, 0&, StrPtr(sInputText): SendMessageW hWndEdit, EM_SETSEL, 0&, -1& ' Set and select "Default" text
            If m_bCentered Then CenterInputBox hWnd
        Case WM_COMMAND
            Select Case wParam
                Case IDOK ' User clicked the "OK" button or pressed Enter to close the InputBox Dialog
                    lTextLen = SendMessageW(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&) ' Get the text length
                    sInputText = String$(lTextLen, vbNullChar)
                    lTextLen = GetWindowTextW(hWndEdit, StrPtr(sInputText), lTextLen + 1) ' Read the actual text entered by the user
                    If lTextLen Then
                        m_bOkayClicked = True
                    Else
                        If m_bRequireInput Then
                            m_bOkayClicked = False: bDiscardMessage = True ' If input is required then the user must type something in the InputBox Dialog but can still press Cancel if desired
                        Else
                            m_bOkayClicked = True
                        End If
                    End If
                Case IDCANCEL
                    m_bOkayClicked = False
                    If m_bRequireInput And Not m_bAllowCancel Then bDiscardMessage = True ' The user cannot cancel the InputBox when this option is active (not recommended, poor user experience)
            End Select
        Case WM_CTLCOLORSTATIC
            If lAdjustStaticHeight > 0 Then
                lAdjustStaticHeight = GetTextHeight(hWndStatic, wParam) - lAdjustStaticHeight
                If lAdjustStaticHeight > 0 Then ' We need to enlarge the InputBox window to accommodate a larger size for the "Prompt" text
                    With rcInputBox
                        .Bottom = .Bottom + lAdjustStaticHeight
                        SetWindowPos hWnd, 0, 0, 0, .Right - .Left, .Bottom - .Top, SWP_NOMOVE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
                    End With
                    With wpStatic.rcNormalPosition
                        SetWindowPos hWndStatic, 0, 0, 0, .Right - .Left, .Bottom - .Top + lAdjustStaticHeight, SWP_NOMOVE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
                    End With
                    With wpEdit.rcNormalPosition
                        SetWindowPos hWndEdit, 0, .Left, .Top + lAdjustStaticHeight, 0, 0, SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
                    End With
                    lAdjustStaticHeight = 0
                End If
            End If
            If Not IsEmpty(m_PromptFontColor) Or Not IsEmpty(m_PromptBackColor) Then
                SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_PromptFontColor ' Set the text color of the "Prompt" text
                If hBrushStatic = 0 Then hBrushStatic = CreateSolidBrush(IIf(IsEmpty(m_PromptBackColor), GetSysColor(COLOR_BTNFACE), m_PromptBackColor)) ' Set the background color of the "Prompt" text
                bDiscardMessage = True: ISubclass_WndProc = hBrushStatic
            End If
        Case WM_CTLCOLOREDIT
            If lAdjustEditHeight > 0 Then
                lAdjustEditHeight = GetTextHeight(hWndEdit, wParam) - lAdjustEditHeight
                If lAdjustEditHeight > 0 Then ' We need to enlarge the "Edit" control to accommodate a larger font size for the "Input" text
                    With rcInputBox
                        SetWindowPos hWnd, 0, 0, 0, .Right - .Left, .Bottom - .Top + lAdjustEditHeight + 3, SWP_NOMOVE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
                    End With
                    With wpEdit.rcNormalPosition
                        SetWindowPos hWndEdit, 0, 0, 0, .Right - .Left, .Bottom - .Top + lAdjustEditHeight + 3, SWP_NOMOVE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
                    End With
                    lAdjustEditHeight = 0
                End If
            End If
            If Not IsEmpty(m_InputFontColor) Or Not IsEmpty(m_InputBackColor) Then
                SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_InputFontColor ' Set the text color of the "Input" text
                If hBrushEdit = 0 Then hBrushEdit = CreateSolidBrush(IIf(IsEmpty(m_InputBackColor), vbWhite, m_InputBackColor)) ' Set the background color of the "Input" text
                bDiscardMessage = True: ISubclass_WndProc = hBrushEdit
            End If
        Case WM_SIZE
            If m_bCentered Then CenterInputBox hWnd
        Case WM_DESTROY
            If hBrushStatic Then If DeleteObject(hBrushStatic) Then hBrushStatic = 0
            If hBrushEdit Then If DeleteObject(hBrushEdit) Then hBrushEdit = 0
            If lAdjustStaticHeight Then lAdjustStaticHeight = 0: If lAdjustEditHeight Then lAdjustEditHeight = 0
    End Select
End Function

Basically the whole idea is to hook the "DialogBoxParamA" API function used to create the InputBox Dialog and then subclass it:

mdlInputBox.bas

Private m_lSubclassInputBox As Long, hWndInputBox As Long, lpDialogBoxParamA As Long, lpOriginalDlgProc As Long, baOriginalDialogBoxParamA(0 To 5) As Byte, baTrampoline(0 To 5) As Byte

Public Function InputBoxHook(SubclassInputBox As ISubclass) As Boolean
    m_lSubclassInputBox = ObjPtr(SubclassInputBox): hWndInputBox = 0 ' Save a reference to our cIB object for subclassing and reset the InputBox window handle
    If lpDialogBoxParamA = 0 Then
        lpDialogBoxParamA = GetProcAddress(GetModuleHandleW(StrPtr("user32")), "DialogBoxParamA") ' Get the address of the "DialogBoxParamA" function
        ReadProcessMemory -1&, lpDialogBoxParamA, VarPtr(baOriginalDialogBoxParamA(0)), 6&, 0& ' Save the first 6 bytes (the size of the trampoline) to be restored later
        baTrampoline(0) = &H68 ' push
        PutMem4 baTrampoline(1), AddressOf HookedDialogBoxParamA ' Set up the trampoline jump to our custom "HookedDialogBoxParamA" function
        baTrampoline(5) = &HC3 ' ret
    End If
    InputBoxHook = WriteProcessMemory(-1&, lpDialogBoxParamA, VarPtr(baTrampoline(0)), 6&, 0&) ' Now the InputBox function will call our custom "HookedDialogBoxParamA" function instead
End Function

Private Function HookedDialogBoxParamA(ByVal hInstance As Long, ByVal lpTemplateName As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Long
    lpOriginalDlgProc = lpDialogFunc ' Save the address of the original DLGPROC callback function (we need to call this later)
    WriteProcessMemory -1&, lpDialogBoxParamA, VarPtr(baOriginalDialogBoxParamA(0)), 6&, 0& ' Restore the original "DialogBoxParamA" API function
    HookedDialogBoxParamA = DialogBoxParamW(hInstance, lpTemplateName, hWndParent, AddressOf DlgProc, dwInitParam) ' Call "DialogBoxParamW" using our custom "DlgProc" instead
End Function

Private Function DlgProc(ByVal hWndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If hWndInputBox = 0 Then hWndInputBox = hWndDlg: SubclassWnd hWndInputBox, m_lSubclassInputBox ' This is the hWnd of the InputBox Dialog window so we can finally subclass it!
    DlgProc = CallWindowProcW(lpOriginalDlgProc, hWndDlg, uMsg, wParam, lParam) ' Call the original DLGPROC callback function to process the rest of messages
End Function

Private Function IsWndSubclassed(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long) As Boolean
    IsWndSubclassed = GetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
End Function

Public Function SubclassWnd(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long, Optional bUpdateRefData As Boolean) As Boolean
Dim lOldRefData As Long
    If uIdSubclass Then
        If Not IsWndSubclassed(hWnd, uIdSubclass, lOldRefData) Then
            SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
        Else
            If bUpdateRefData Then If lOldRefData <> dwRefData Then SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
        End If
    End If
End Function

Private Function UnSubclassWnd(hWnd As Long, uIdSubclass As Long) As Boolean
    If IsWndSubclassed(hWnd, uIdSubclass) Then UnSubclassWnd = RemoveWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass)
End Function

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Subclass As ISubclass, ByVal dwRefData As Long) As Long
Dim bDiscardMessage As Boolean
    Select Case uMsg
        Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
            UnSubclassWnd hWnd, ObjPtr(Subclass)
        Case Else
            WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam, dwRefData, bDiscardMessage)
    End Select
    If Not bDiscardMessage Then WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

And of course the ubiquitous ISubclass stub (to use with Implements):

ISubclass.cls

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal dwRefData As Long, bDiscardMessage As Boolean) As Long

End Function

That's all there is to it. Here's a small demo program with the InputBox showing some Japanese haikus as well as the password char in action:

UnicodeInputBoxNew.zip (Updated)