How to let InputBox support Unicode ?

[dreammanor]

VB6's InputBox doesn't support Unicode. Is there any way to make VB6's InputBox support Unicode?

I searched the VBForums and found that the MessageBoxIndirectW API could make a Unicode-MsgBox.
(the link: http://www.vbforums.com/showthread.p...sage-box-class)

I don't know whether there is an API method could create a Unicode-InputBox ?

Thanks in advance.

[fafalone]

There's not, but it's easy enough to roll your own. Just use one of the many Unicode textboxes.

[dreammanor]

There's not, but it's easy enough to roll your own. Just use one of the many Unicode textboxes.

Thanks for your reply.

I've seen some source codes of CommonControls (Replacement of the MS common controls) and PhotoDemon, which include Unicode-TextBox all:
http://www.vbforums.com/showthread.p...mmon-controls)
https://github.com/tannerhelland/PhotoDemon

The above source code about Unicode-TextBox are excellent, they're just a little more complicated. if there is a API similar to MessageBoxIndirectW could create a Unicode-InputBox directly, it would be great.

[dreammanor]

Is there a simple way to make VB6's InputBox support Unicode?

[Arnoutdv]

Since you asked for it I did multiple searches on multiple terms, but found nada zip nothing
All other discussions/questions on other forums/stackoverflow, programming websites, all come to the same answer, not possible with the VB InputBox. You have to create one yourself.

[dreammanor]

Since you asked for it I did multiple searches on multiple terms, but found nada zip nothing
All other discussions/questions on other forums/stackoverflow, programming websites, all come to the same answer, not possible with the VB InputBox. You have to create one yourself.

Thank you for the reply. Well, I suppose there is no other choice.

[VanGoghGaming]

Is there a simple way to make VB6's InputBox support Unicode?

Although this reply comes a bit late , I don't think it can get any simpler than this: VB6 - Original InputBox function reloaded with full Unicode and Password Char support

[xiaoyao]

MFC InputBox 输入框
https://www.ngui.cc/el/1426656.html?action=onClick
CAN USE API MAKE A INPUT WINDOW

[VanGoghGaming]

Amazing! Now why didn't I think of using MFC to create dialog boxes? Sometimes I wonder why do you even bother posting just for PostCount++ (MFC style)!

[HackerVlad]

I haven't actually found a way to make this work in VB6 through your MFC

[HackerVlad]

Although this reply comes a bit late , I don't think it can get any simpler than this: VB6 - Original InputBox function reloaded with full Unicode and Password Char support

There is an easier way! To do this, just call the DialogBoxParam function. And at the same time, no hooks are needed.

[Dry Bone]

I think this is a cool way to get Unicode InputBox:

Public Function InputBoxW(Prompt, title, Optional Default = "") As String
Dim sc
Dim s
Dim p As String
Dim v As String
Set sc = CreateObject("MSScriptControl.ScriptControl")
sc.Language = "VBScript"
p = Prompt: GoSub jConcat
p = title: GoSub jConcat
p = Default: GoSub jConcat
s = sc.Eval("InputBox(" & v & ")")
If IsEmpty(s) Then s = vbNullString Else If Len(s) = 0 Then s = ""
InputBoxW = s
Exit Function

jConcat:
If v <> "" Then v = v & ","
If InStr(1, p, """") Then p = Replace(p, """", """""")
If InStr(1, p, vbCrLf) Then p = Replace(p, vbCrLf, """ & vbNewLine & """)
If InStr(1, p, vbLf) Then p = Replace(p, vbLf, """ & vbNewLine & """)
v = v & ("""" & p & """")
Return
End Function

[HackerVlad]

Yes, it's great, but the dialog is not called by the modal. And also the icon in the window title is annoying.

[HackerVlad]

https://www.vbforums.com/showthread....=1#post5623219

[Dry Bone]

I didn't realize it's not modal.
But I can fix it in 2 seconds.
Just throw in this line:

If ObjPtr(Screen.ActiveForm) Then sc.SitehWnd = Screen.ActiveForm.hwnd

[HackerVlad]

I didn't realize it's not modal.
But I can fix it in 2 seconds.
Just throw in this line:

If ObjPtr(Screen.ActiveForm) Then sc.SitehWnd = Screen.ActiveForm.hwnd

Thanks a lot, but how to remove the icon? Or change it to your own?

[HackerVlad]

Option Explicit
'////////////////////////////////////////////
'// Module for calling Unicode InputBox    //
'// Copyright (c) 2024-02-01 by HackerVlad //
'// e-mail: [email protected]     //
'// Version 2.5                            //
'////////////////////////////////////////////

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamW" (ByVal hInstance As Long, ByVal lpTemplate As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageW" (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 SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As Long) As Long
Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextW" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextW" (ByVal hwnd As Long, ByVal lpString As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function WinHelp Lib "user32" Alias "WinHelpW" (ByVal hwnd As Long, ByVal lpHelpFile As Long, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpW" (ByVal hwndCaller As Long, ByVal pszFile As Long, ByVal uCommand As Long, ByVal dwData As Long) As Long

Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const ID_EDIT = 4900
Private Const ID_STATIC = 4901
Private Const ID_HELP = 4902
Private Const WM_COMMAND = &H111
Private Const WM_INITDIALOG = &H110
Private Const WM_HELP = &H53
Private Const WM_DESTROY = &H2

Private Const SW_HIDE = 0
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const WM_GETTEXTLENGTH As Long = &HE
Private Const EM_SETSEL = &HB1
Private Const SPI_GETWORKAREA = 48
Private Const HH_DISPLAY_TOPIC = &H0
Private Const HH_HELP_CONTEXT = &HF
Private Const HELP_CONTEXT = &H1
Private Const HELP_INDEX = &H3
Private Const HELP_QUIT = &H2

Private Type RECT
    iLeft As Long
    iTop As Long
    iRight As Long
    iBottom As Long
End Type

Dim sInputText As String
Dim sTitleText As String
Dim sDefaultText As String
Dim CenterOnWorkspace As Boolean ' Analog of DS_CENTER
Dim iXPos As Integer
Dim iYPos As Integer
Dim sHelpFile As String
Dim lContext As Long
Dim IsWinHelpRunning As Boolean

' Call InputBox from msvbvm60.dll with unicode support
Public Function InputBoxW(ByVal hParent As Long, ByVal strPrompt As String, Optional ByVal strTitle As String, Optional ByVal strDefault As String, Optional intXPos As Integer, Optional intYPos As Integer, Optional strHelpFile As String, Optional intContext As Long, Optional CenterOnMonitorWorkspace As Boolean) As String
    Dim msvbvm60 As Long
    
    msvbvm60 = LoadLibrary(StrPtr("msvbvm60.dll"))
    
    If msvbvm60 <> 0 Then
        sTitleText = strTitle
        sDefaultText = strDefault
        CenterOnWorkspace = CenterOnMonitorWorkspace
        iXPos = intXPos
        iYPos = intYPos
        sHelpFile = strHelpFile
        lContext = intContext
        IsWinHelpRunning = False
        
        DialogBoxParam msvbvm60, 4031, hParent, AddressOf DlgProc, StrPtr(strPrompt) ' The very cherished code that calls InputBox
    End If
    
    InputBoxW = sInputText
    sInputText = vbNullString
    sTitleText = vbNullString
    sDefaultText = vbNullString
    sHelpFile = vbNullString
End Function

' Dialog box message processing function
Private Function DlgProc(ByVal hwndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim NotifyCode As Long
    Dim ItemID As Long
    Dim wndRect As RECT
    Dim rcWork As RECT
    Dim TextLen As Long
    Dim lLeft As Long
    Dim lTop As Long
    
    Select Case uMsg
        Case WM_INITDIALOG
            If Len(sTitleText) = 0 Then sTitleText = App.Title
            SetWindowText hwndDlg, StrPtr(sTitleText)
            
            If Len(sHelpFile) = 0 Then
                ShowWindow GetDlgItem(hwndDlg, ID_HELP), SW_HIDE
            End If
            
            SetDlgItemText hwndDlg, ID_STATIC, lParam
            
            ' Determining the size of the window
            GetWindowRect hwndDlg, wndRect
            
            ' Determine the size of the working area of the screen
            SystemParametersInfo SPI_GETWORKAREA, 0, rcWork, 0
            
            If CenterOnWorkspace = False Then ' Standard alignment
                If (iXPos Or iYPos) = 0 Then
                    ' Absolutely perfect dialog box alignment code, exactly like the original InputBox function does
                    lLeft = rcWork.iLeft + (rcWork.iRight - rcWork.iLeft - (wndRect.iRight - wndRect.iLeft)) \ 2
                    lTop = rcWork.iTop + (rcWork.iBottom - rcWork.iTop - (wndRect.iBottom - wndRect.iTop)) \ 3
                Else
                    lLeft = iXPos
                    lTop = iYPos
                End If
            Else ' Centering on the working area of the screen (analogous to the DS_CENTER style)
                lLeft = ((rcWork.iRight - rcWork.iLeft) - (wndRect.iRight - wndRect.iLeft)) / 2
                lTop = ((rcWork.iBottom - rcWork.iTop) - (wndRect.iBottom - wndRect.iTop)) / 2
            End If
            
            SetWindowPos hwndDlg, 0, lLeft, lTop, 0, 0, SWP_NOSIZE Or SWP_NOZORDER ' Alignment of the dialog box
            
            If Len(sDefaultText) > 0 Then
                SetDlgItemText hwndDlg, ID_EDIT, StrPtr(sDefaultText)
                SendDlgItemMessage hwndDlg, ID_EDIT, EM_SETSEL, 0, -1
            End If
            
            DlgProc = 1
            Exit Function
        
        Case WM_COMMAND
            NotifyCode = wParam \ 65536
            ItemID = wParam And 65535
            
            If ItemID = IDOK Then
                TextLen = SendDlgItemMessage(hwndDlg, ID_EDIT, WM_GETTEXTLENGTH, 0, 0)
                sInputText = Space$(TextLen)
                GetDlgItemText hwndDlg, ID_EDIT, StrPtr(sInputText), TextLen + 1
                
                EndDialog hwndDlg, 0
                DlgProc = 1
                Exit Function
            End If
            
            If ItemID = IDCANCEL Then
                EndDialog hwndDlg, 0
                DlgProc = 1
                Exit Function
            End If
            
            If ItemID = ID_HELP Then
                RunHelp hwndDlg
                DlgProc = 1
                Exit Function
            End If
        
        Case WM_HELP
            RunHelp hwndDlg
            DlgProc = 1
            Exit Function
        
        Case WM_DESTROY
            If IsWinHelpRunning = True Then
                WinHelp hwndDlg, 0, HELP_QUIT, 0 ' Close the HLP window
            End If
            
            DlgProc = 1
            Exit Function
    End Select
    
    DlgProc = 0
End Function

Private Sub RunHelp(ByVal hwnd As Long)
    If Len(sHelpFile) > 0 Then
        If Right$(sHelpFile, 4) = ".hlp" Then
            If lContext = 0 Then
                WinHelp hwnd, StrPtr(sHelpFile), HELP_INDEX, 0
            Else
                WinHelp hwnd, StrPtr(sHelpFile), HELP_CONTEXT, lContext
            End If
            IsWinHelpRunning = True
        Else ' CHM
            If lContext = 0 Then
                HtmlHelp hwnd, StrPtr(sHelpFile), HH_DISPLAY_TOPIC, 0
            Else
                HtmlHelp hwnd, StrPtr(sHelpFile), HH_HELP_CONTEXT, lContext
            End If
        End If
    End If
End Sub

[fafalone]

Very interesting approach, I like it.

[HackerVlad]

fafalone, I spent a lot of time to write this code, I even had to resort to disassembler, but it was worth it

[xiaoyao]

Option Explicit

    Select Case uMsg
        Case WM_INITDIALOG
            If Len(sTitleText) = 0 Then sTitleText = App.Title
            SetWindowText hwndDlg, StrPtr(sTitleText)
            
            If Len(sHelpFile) = 0 Then
                ShowWindow GetDlgItem(hwndDlg, ID_HELP), SW_HIDE
            End If
            
            SetDlgItemText hwndDlg, ID_STATIC, lParam
            
            ' Determining the size of the window
            GetWindowRect hwndDlg, wndRect
            
            ' Determine the size of the working area of the screen
            SystemParametersInfo SPI_GETWORKAREA, 0, rcWork, 0
            
            
            SetWindowPos hwndDlg, 0, lLeft, lTop, 0, 0, SWP_NOSIZE Or SWP_NOZORDER ' Alignment of the dialog box
            
            If Len(sDefaultText) > 0 Then
                SetDlgItemText hwndDlg, ID_EDIT, StrPtr(sDefaultText)
                SendDlgItemMessage hwndDlg, ID_EDIT, EM_SETSEL, 0, -1
            End If

how to change to more lines?
and set window height to max?

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const ES_MULTILINE = &H4
Private Const WS_VSCROLL = &H200000

Sub SetMoreLines(hWnd As Long, Optional ID_EDITa As Long)
    Dim hEdit As Long
    

    hEdit = GetDlgItem(hWnd, ID_EDIT)

    SetWindowLong hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) Or ES_MULTILINE Or WS_VSCROLL
    
    'SetWindowPos hEdit, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED
    
    Dim wndRect As RECT
    Dim rcWork As RECT
GetWindowRect hWnd, wndRect
GetWindowRect hEdit, rcWork

             SetWindowPos hEdit, 0, -1, -1, wndRect.iRight - wndRect.iLeft, (rcWork.iBottom - rcWork.iTop) * 3, SWP_NOZORDER Or SWP_FRAMECHANGED

[xiaoyao]

Why didn't it work? How to set text box wrap and WordWrap=true with API

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 Const EM_GETOLEINTERFACE = &H400 + 60
Private Const EM_SETOLECALLBACK = &H400 + 61
Private Const EM_GETOLEINTERFACE = &H400 + 60
Private Const EM_SETTARGETDEVICE = &H400 + 72
Private Const EM_SETWORDWRAPMODE = &H400 + 77

Private Sub Form_Load()
Dim hEdit As Long

'Gets a handle to ID_EDIT
hEdit = GetDlgItem(Me.hWnd, ID_EDIT)

'Set ID_EDIT to be displayed in multiple lines with a vertical scroll bar
SetWindowLong hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) Or ES_MULTILINE Or WS_VSCROLL

'Sets the WordWrap property to True
SendMessage hEdit, EM_SETWORDWRAPMODE, True, 0
End Sub

[xiaoyao]

Setting the background color of the text box is too difficult, and it becomes opaque when you enter the text with vbcrlf in the text box
("a" & vbcrlf & "bb" & vbcrlf)

 Function EditWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
ElseIf uMsg = WM_ERASEBKGND Then
Debug.Print "EditWndProc=" & Now
'MsgBox "WM_ERASEBKGND"
        'SetBkMode wParam, vbYellow 'TRANSPARENT
         GetClientRect hwnd, aRect
         Dim aBrush As Long
         aBrush = CreateSolidBrush(vbYellow)
           SetBkMode wParam, TRANSPARENT
        FillRect wParam, aRect, aBrush
        DeleteObject aBrush
        EditWndProc = 1             
        Exit Function

[HackerVlad]

Why the SetWindowLong trick doesn't work, I still haven't figured it out myself. I worked for two hours and didn't understand anything. But if you recreate the EDIT window, then everything works.

[HackerVlad]

Option Explicit
'////////////////////////////////////////////
'// Module for calling Unicode InputBox    //
'// Copyright (c) 2024-02-01 by HackerVlad //
'// e-mail: [email protected]     //
'// Version 2.55 (MultiLine Input)         //
'////////////////////////////////////////////

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamW" (ByVal hInstance As Long, ByVal lpTemplate As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageW" (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 SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As Long) As Long
Private Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextW" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextW" (ByVal hwnd As Long, ByVal lpString As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function WinHelp Lib "user32" Alias "WinHelpW" (ByVal hwnd As Long, ByVal lpHelpFile As Long, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpW" (ByVal hwndCaller As Long, ByVal pszFile As Long, ByVal uCommand As Long, ByVal dwData As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Long) As Long

Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const ID_EDIT = 4900
Private Const ID_STATIC = 4901
Private Const ID_HELP = 4902
Private Const WM_COMMAND = &H111
Private Const WM_INITDIALOG = &H110
Private Const WM_HELP = &H53
Private Const WM_DESTROY = &H2

Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_USER = &H400
Private Const EM_SETWORDWRAPMODE As Long = (WM_USER + 102)
Private Const ES_MULTILINE = &H4&
Private Const ES_WANTRETURN = &H1000&
Private Const WS_VSCROLL = &H200000
Private Const ES_UPPERCASE = &H8&
Private Const SWP_NOMOVE = &H2
Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Const ES_AUTOVSCROLL = &H40&
Private Const WS_VISIBLE        As Long = &H10000000
Private Const WS_EX_CLIENTEDGE  As Long = &H200&
Private Const WS_CHILD          As Long = &H40000000
Private Const ES_AUTOHSCROLL = &H80&
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WM_SETFONT = &H30
Private Const WM_GETFONT = &H31
Private Const WS_TABSTOP = &H10000

Private Const SW_HIDE = 0
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const WM_GETTEXTLENGTH As Long = &HE
Private Const EM_SETSEL = &HB1
Private Const SPI_GETWORKAREA = 48
Private Const HH_DISPLAY_TOPIC = &H0
Private Const HH_HELP_CONTEXT = &HF
Private Const HELP_CONTEXT = &H1
Private Const HELP_INDEX = &H3
Private Const HELP_QUIT = &H2

Private Type RECT
    iLeft As Long
    iTop As Long
    iRight As Long
    iBottom As Long
End Type

Dim sInputText As String
Dim sTitleText As String
Dim sDefaultText As String
Dim CenterOnWorkspace As Boolean ' Analog of DS_CENTER
Dim iXPos As Integer
Dim iYPos As Integer
Dim sHelpFile As String
Dim lContext As Long
Dim IsWinHelpRunning As Boolean

' Call InputBox from msvbvm60.dll with unicode support
Public Function InputBoxW(ByVal hParent As Long, ByVal strPrompt As String, Optional ByVal strTitle As String, Optional ByVal strDefault As String, Optional intXPos As Integer, Optional intYPos As Integer, Optional strHelpFile As String, Optional intContext As Long, Optional CenterOnMonitorWorkspace As Boolean) As String
    Dim msvbvm60 As Long
    
    msvbvm60 = LoadLibrary(StrPtr("msvbvm60.dll"))
    
    If msvbvm60 <> 0 Then
        sTitleText = strTitle
        sDefaultText = strDefault
        CenterOnWorkspace = CenterOnMonitorWorkspace
        iXPos = intXPos
        iYPos = intYPos
        sHelpFile = strHelpFile
        lContext = intContext
        IsWinHelpRunning = False
        
        DialogBoxParam msvbvm60, 4031, hParent, AddressOf DlgProc, StrPtr(strPrompt) ' The very cherished code that calls InputBox
    End If
    
    InputBoxW = sInputText
    sInputText = vbNullString
    sTitleText = vbNullString
    sDefaultText = vbNullString
    sHelpFile = vbNullString
End Function

' Dialog box message processing function
Private Function DlgProc(ByVal hwndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim NotifyCode As Long
    Dim ItemID As Long
    Dim wndRect As RECT
    Dim rcWork As RECT
    Dim rcEdit As RECT
    Dim TextLen As Long
    Dim lLeft As Long
    Dim lTop As Long
    Dim hEdit As Long
    Dim hFont As Long
    
    Select Case uMsg
        Case WM_INITDIALOG
            If Len(sTitleText) = 0 Then sTitleText = App.Title
            SetWindowText hwndDlg, StrPtr(sTitleText)
            
            If Len(sHelpFile) = 0 Then
                ShowWindow GetDlgItem(hwndDlg, ID_HELP), SW_HIDE
            End If
            
            SetDlgItemText hwndDlg, ID_STATIC, lParam
            
            ' Determining the size of the window
            GetWindowRect hwndDlg, wndRect
            
            ' Determine the size of the working area of the screen
            SystemParametersInfo SPI_GETWORKAREA, 0, rcWork, 0
            
            If CenterOnWorkspace = False Then ' Standard alignment
                If (iXPos Or iYPos) = 0 Then
                    ' Absolutely perfect dialog box alignment code, exactly like the original InputBox function does
                    lLeft = rcWork.iLeft + (rcWork.iRight - rcWork.iLeft - (wndRect.iRight - wndRect.iLeft)) \ 2
                    lTop = rcWork.iTop + (rcWork.iBottom - rcWork.iTop - (wndRect.iBottom - wndRect.iTop)) \ 3
                Else
                    lLeft = iXPos
                    lTop = iYPos
                End If
            Else ' Centering on the working area of the screen (analogous to the DS_CENTER style)
                lLeft = ((rcWork.iRight - rcWork.iLeft) - (wndRect.iRight - wndRect.iLeft)) / 2
                lTop = ((rcWork.iBottom - rcWork.iTop) - (wndRect.iBottom - wndRect.iTop)) / 2
            End If
            
            SetWindowPos hwndDlg, 0, lLeft, lTop, 0, 0, SWP_NOSIZE Or SWP_NOZORDER ' Alignment of the dialog box
            
            ' Gets a handle to ID_EDIT
            hEdit = GetDlgItem(hwndDlg, ID_EDIT)
            
            ' Set ID_EDIT to be displayed in multiple lines with a vertical scroll bar
            'SetWindowLong hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) - ES_AUTOHSCROLL - WS_MAXIMIZEBOX
            'SetWindowLong hEdit, GWL_STYLE, GetWindowLong(hEdit, GWL_STYLE) Or ES_MULTILINE Or WS_VSCROLL Or ES_AUTOVSCROLL Or ES_WANTRETURN
            
            'SetWindowLong hEdit, GWL_STYLE, 1342181444
            'SetWindowLong hEdit, GWL_EXSTYLE, 512
            
            'SetWindowPos hEdit, 0, 0, 0, 350, 50, SWP_NOZORDER Or SWP_NOMOVE Or SWP_FRAMECHANGED
            
            ' Sets the WordWrap property to True
            'SendMessage hEdit, EM_SETWORDWRAPMODE, 1, 0
            
            ' SetWindowLong does not help, so we will recreate the window
            ' using the DestroyWindow and CreateWindowEx functions
            
            ' Note:
            ' If you remove ES_WANTRETURN, the line break will be only through the Ctrl+Enter keys
            
            GetWindowRect hEdit, rcEdit
            hFont = SendMessage(hEdit, WM_GETFONT, 0, 0)
            
            DestroyWindow hEdit
            hEdit = CreateWindowEx(WS_EX_CLIENTEDGE, StrPtr("Edit"), ByVal 0&, WS_CHILD Or WS_VISIBLE Or ES_MULTILINE Or WS_TABSTOP Or _
            ES_AUTOVSCROLL Or ES_WANTRETURN, 10, 75, rcEdit.iRight - rcEdit.iLeft, (rcEdit.iBottom - rcEdit.iTop) * 2, hwndDlg, ID_EDIT, 0&, ByVal 0&)
            
            SendMessage hEdit, WM_SETFONT, hFont, ByVal 0&
            
            If Len(sDefaultText) > 0 Then
                SetDlgItemText hwndDlg, ID_EDIT, StrPtr(sDefaultText)
                SendDlgItemMessage hwndDlg, ID_EDIT, EM_SETSEL, 0, -1
            End If
            
            DlgProc = 1
            Exit Function
        
        Case WM_COMMAND
            NotifyCode = wParam \ 65536
            ItemID = wParam And 65535
            
            If ItemID = IDOK Then
                TextLen = SendDlgItemMessage(hwndDlg, ID_EDIT, WM_GETTEXTLENGTH, 0, 0)
                sInputText = Space$(TextLen)
                GetDlgItemText hwndDlg, ID_EDIT, StrPtr(sInputText), TextLen + 1
                
                EndDialog hwndDlg, 0
                DlgProc = 1
                Exit Function
            End If
            
            If ItemID = IDCANCEL Then
                EndDialog hwndDlg, 0
                DlgProc = 1
                Exit Function
            End If
            
            If ItemID = ID_HELP Then
                RunHelp hwndDlg
                DlgProc = 1
                Exit Function
            End If
        
        Case WM_HELP
            RunHelp hwndDlg
            DlgProc = 1
            Exit Function
        
        Case WM_DESTROY
            If IsWinHelpRunning = True Then
                WinHelp hwndDlg, 0, HELP_QUIT, 0 ' Close the HLP window
            End If
            
            DlgProc = 1
            Exit Function
    End Select
    
    DlgProc = 0
End Function

Private Sub RunHelp(ByVal hwnd As Long)
    If Len(sHelpFile) > 0 Then
        If Right$(sHelpFile, 4) = ".hlp" Then
            If lContext = 0 Then
                WinHelp hwnd, StrPtr(sHelpFile), HELP_INDEX, 0
            Else
                WinHelp hwnd, StrPtr(sHelpFile), HELP_CONTEXT, lContext
            End If
            IsWinHelpRunning = True
        Else ' CHM
            If lContext = 0 Then
                HtmlHelp hwnd, StrPtr(sHelpFile), HH_DISPLAY_TOPIC, 0
            Else
                HtmlHelp hwnd, StrPtr(sHelpFile), HH_HELP_CONTEXT, lContext
            End If
        End If
    End If
End Sub

I spent three hours writing this code. Now a lot of lines in the text field are working.

[xiaoyao]

Yes, I used this method myself later.
For example, you can set the height of the text box to. Four lines of text. The height of the window is also increased by three lines of text.

How to set the background color of this text box, or set a background image for it, finally I can't handle it.

[HackerVlad]

Well, I don't have time to help you further with these issues. So I made a multi-line input for you.

[HackerVlad]

xiaoyao, please take a look here: https://www.vbforums.com/showthread....=1#post5631495
There is an opportunity to change the color of the label

[xiaoyao]

Maybe the text box is transparent. What we need now is to set a background image or a background color for the background of the inputbox dialog box.For example, I forcibly delete the action in the background of the text box and set the background color to draw it, but if there is too much text, there may be two screens and three screens of content.You just need to scroll. The page button pulls down the scroll bar.
In this case, the background color will not be displayed completely.

So the simplest thing is to draw the background in the dialog box. Draw a part of the background color behind the text box.

The same technology. It can be modified. Properties of the VB6 IDE. Then he can enter the Unicode text.for make usercontrol ocx textw