-
5 Attachment(s)
VB6 - Original InputBox function reloaded with full Unicode support & new Edit Styles
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! :D
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:
Attachment 187147
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.
Attachment 190332
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:
Attachment 187581
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):
Attachment 190333
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
Code:
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
Code:
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
Code:
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:
Attachment 192748 (Updated)
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
Your work is very great, applaud. Give VB6 life, help it more perfect and easier to use.
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
a question.
I try to move your code to a dll.
But it only works if I put the resource file in the main program and not in the dll.
It is not possible for the dll to use its own resource file.
Regards, thanks
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
Mate the resource file contains only the manifest for the modern theme, otherwise the interface would look like it came straight from the last century. Only executables need manifests, you don't need it for the dll!
-
1 Attachment(s)
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
UPDATE: The Unicode InputBox class has been enhanced with additional properties:
- EnablePasswordChar - Can specify an optional character to mask the password with. If omitted then the standard Windows Password Character will be displayed (NOT an asterisk)!
- 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.
- RequireInput - The user MUST type something in the InputBox but can still press "Cancel" if desired.
Attachment 188444
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
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:
Attachment 187581
-
2 Attachment(s)
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
This update includes two new properties and one new method for the InputBox:
- MaxLength - Limit the InputBox text to the specified number of characters.
- RequireInput - The InputBox cannot be empty, the user MUST type something in the InputBox but can still press "Cancel" if desired.
Attachment 188445
The AdjustHeight method allows you to enlarge the InputBox height by a specified percentage in case your "Prompt" text doesn't fit in the default InputBox size. In this screenshot the InputBox height has been increased by 25% and now all text fits nicely:
Attachment 188446
As usual you can download this latest update from the first post above.
-
Re: VB6 - Original InputBox function reloaded with full Unicode and Password Char sup
Quote:
Originally Posted by
VanGoghGaming
As usual you can download this latest update from the first post above.
Great work! However, it shows the haiku as ??? strings in the IDE, but perfect Japanese when running compiled. Am I missing something?
Cheers
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
It works in the IDE as well, just don't use breakpoints to stop the execution. That will prevent the InputBox from being hooked and subclassed and so it won't be able to display proper Unicode characters.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I will attempt to use this inputBox improvement. I don't use it often and when I have done so, I have generally ended up rolling my own (and done a fairly poor job of it), so thankyou for this.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
VanGoghGaming
It works in the IDE as well, just don't use breakpoints to stop the execution. That will prevent the InputBox from being hooked and subclassed and so it won't be able to display proper Unicode characters.
I don't have any breakpoints, so it must be one of my add-ins preventing it. Cheers
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I second taishan's claim - not working in IDE, showing the ???.
When I compile and run I get a strange message from windows: "The application has failed to start because its side by side configuration is incorrect..."
This is just too much for me. I give up.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
That's a very strange error indeed, just remove the external manifest since it's already included in the resource file. Probably your Windows is set up to prefer external manifests.
Anyway I've uploaded a new version that should work in the IDE for you as well (although it always has for the majority of users so far). I could only guess the problem was with reading the Unicode text from file.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
Dry Bone
I second taishan's claim - not working in IDE, showing the ???.
When I compile and run I get a strange message from windows: "The application has failed to start because its side by side configuration is incorrect..."
This is just too much for me. I give up.
Works perfectly for me on Win10, I run with UAC off if that helps.
FYI - V.G you have bundled a binary in with that zipfile which I believe a forum rule disallows. Best to remove it and let everyone compile themselves.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
There is no binary, you've mistaken "InputBoxTest.exe.manifest" which is a text file. ;)
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I swear I saw a binary, I thought I immediately recompiled and overwrote it. I do know what an external manifest looks like, so I shouldn't have mistaken that. Must have been a glitch in my own personal matrix.
Anyway, my real point is that it all works for me! Very well indeed.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I can run the compiled version now. Still getting the "???". It's not encoding related. The strings are ok, just won't show on dialog.
The title is unicode alright, but the message is all "???", and the Textbox is also "???" and won't accept unicode characters!
What is going on?
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Hey, look at this cool method for unicode InputBox:
Code:
Public Function InputBoxW(Prompt, Title, Default) As String
Dim sc
Dim s
Set sc = CreateObject("msscriptcontrol.scriptcontrol")
sc.language = "vbscript"
s = sc.Eval("InputBox(""" & Prompt & """,""" & Title & """,""" & Default & """)")
If IsEmpty(s) Then s = vbNullString Else If Len(s) = 0 Then s = ""
InputBoxW = s
End Function
What say ye?
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
No idea what's going on mate, especially since you say the InputBox title is showing Unicode characters correctly. That means the InputBox is correctly subclassed and is receiving messages so I don't know why the "EditBox" isn't responding well to the "WM_SETTEXT" message for you.
If you manage to sort it out I'd be interested to know what was the cause of this strange issue for you.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Hey BroVanGogh, it works perfectly now, inIDE and Exe. Excellent!
Can we hack the size of the font? I've been trying to push everything up to Segoe UI 11pt.
Cheers
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Yeah there's a "SetFont" method to use whatever font and size you want, this is mentioned above as well. I don't know what's all the rage with this Segoe font. I prefer the "Microsoft Sans Serif" font which is the TrueType successor of the good ol' tried and tested "MS Sans Serif" bitmap font. :D
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Great news on the font sizing! For my eyes Segoe looks beautiful with the Asian ideograms, and those from Arabic and Hebrew to Thai and Hindi. It is just a great UI font, but I will take another look at Sans Serif. I guess you'll have to make another project for the good old message box. Elroy and Niya broke ground with a great start, prompting dil to write the funniest response I've ever read on the forums.Cheers
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
What's even funnier is that he's not wrong at all! :D
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
Dry Bone
I second taishan's claim - not working in IDE, showing the ???.
When I compile and run I get a strange message from windows: "The application has failed to start because its side by side configuration is incorrect..."
This is just too much for me. I give up.
You most likely needed to install a manifest for yourself VB6.EXE
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
In fact, there is a way to call the native InputBox from the library msvbvm60.dll directly using the DialogBoxParamW function.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
My function works without manifests.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Thanks to user "HackerVlad" above, I have fixed the issue encountered by some users where the InputBox would not display Unicode characters in the absence of a theme manifest. Also I have replaced the method of finding the InputBox Dialog, instead of installing a CBT hook with "SetWindowsHookEx" now the program employs a basic "trampoline" hook on the "DialogBoxParamA" API function used to create the InputBox. The demo project has been updated in the first post above.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I also want to point out the advantages of my function:
1. Does not require manifests
2. There are no complicated hooks
3. No need to use sophisticated subclassing technology
4. There is no need for any trampolines and redirects
5. The function is written very clearly, almost like in the original source code from Microsoft
6. The window alignment is exactly the same as in the original InputBox as in Microsoft
7. An additional feature has been added to align the window to the center of the working area of the screen
Code:
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
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
So why not create your own CodeBank thread rather than just posting into this one. The thread back in the Q&A section is a good place to debate the merits of different approaches, but the CodeBank is not. This area is for posting working snippets and questions regarding those working snippets. Since your reply is neither, I was tempted to do something other than just replying. One option would be to split it out into its own thread, but you should do that, not me, as that first post would be kind of important. The other option was to remove the post along with replying as I have (minus this part, as that would be way too self-referential), but I decided not to, as it would make this reply quite weird.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I'm new to this forum. Forgive me.
-
1 Attachment(s)
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
No worries, the purpose of this thread is focused only on the original VB6 "InputBox" function and enhancing it with additional edit styles and new features. Speaking of which, I have just released a new update (which can be downloaded from the first post above as usual).
The size of the InputBox is now calculated automatically in case the "Prompt" text is too big to fit in the original size. There is no longer a need to approximate the height increase by a percentage as it will be calculated on the fly for the best fit!
Also now you can use the FontColor property to customize the color of the "Prompt" text (in addition to its 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 a poor user experience overall):
Attachment 190334
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Excellent work, BroVanGogh! I think you've conquered this exercise. You've become the Unicode master for those who want to stay within the confines of VB common controls! Cheers
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
VanGoghGaming great job! I like that you added the ability to change the color of the label text! But forum users still want to be able to change the text color and the background color of the text field. https://www.vbforums.com/showthread....=1#post5631388
-
1 Attachment(s)
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
HackerVlad
But forum users still want to be able to change the text color and the background color of the text field.
Sometimes, forum users want the most unreasonable of things! ;) You can change the background colors although it doesn't look great in my opinion:
Attachment 190347
We need to handle the "WM_CTLCOLORSTATIC" and "WM_CTLCOLOREDIT" messages and instead of returning a system brush with the background color we create a new brush with whatever background color we want and return that instead. Unlike the system brush, this new brush will have to be deleted when we're done with it:
Code:
Case WM_CTLCOLORSTATIC
' .... snip
SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_lFontColor
If hBrushStatic = 0 Then hBrushStatic = CreateSolidBrush(vbYellow)
bDiscardMessage = True: ISubclass_WndProc = hBrushStatic ' GetSysColorBrush(COLOR_BTNFACE) ' Returns a handle to a system brush with the default window background color
Case WM_CTLCOLOREDIT
SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_lFontColor
If hBrushEdit = 0 Then hBrushEdit = CreateSolidBrush(vbGreen)
bDiscardMessage = True: ISubclass_WndProc = hBrushEdit
Case WM_DESTROY
If DeleteObject(hBrushStatic) Then hBrushStatic = 0
If DeleteObject(hBrushEdit) Then hBrushEdit = 0
End Select
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
I completely agree with you that sometimes forum members want the most unreasonable!!! But thank you very much for your work.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
VanGoghGaming
Sometimes, forum users want the most unreasonable of things! ;) You can change the background colors although it doesn't look great in my opinion:
Attachment 190347
We need to handle the "WM_CTLCOLORSTATIC" and "WM_CTLCOLOREDIT" messages and instead of returning a system brush with the background color we create a new brush with whatever background color we want and return that instead. Unlike the system brush, this new brush will have to be deleted when we're done with it:
Code:
Case WM_CTLCOLORSTATIC
' .... snip
SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_lFontColor
If hBrushStatic = 0 Then hBrushStatic = CreateSolidBrush(vbYellow)
bDiscardMessage = True: ISubclass_WndProc = hBrushStatic ' GetSysColorBrush(COLOR_BTNFACE) ' Returns a handle to a system brush with the default window background color
Case WM_CTLCOLOREDIT
SetBkMode wParam, TRANSPARENT: SetTextColor wParam, m_lFontColor
If hBrushEdit = 0 Then hBrushEdit = CreateSolidBrush(vbGreen)
bDiscardMessage = True: ISubclass_WndProc = hBrushEdit
Case WM_DESTROY
If DeleteObject(hBrushStatic) Then hBrushStatic = 0
If DeleteObject(hBrushEdit) Then hBrushEdit = 0
End Select
if use createwibdowex ""edit,can't hook message ""WM_CTLCOLOREDIT,why?
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Quote:
Originally Posted by
VanGoghGaming
Sometimes, forum users want the most unreasonable of things! ;) You can change the background colors although it doesn't look great in my opinion:
[/code]
Why reply to this on this old board? Because some things are just simple upgrades.Of course, after all the technologies are developed, these corresponding technologies can be released to a new code base article.
Sometimes it's not that users have strange ideas, but that Microsoft should have done these things. Uch as text that supports such Unicode. Or you can set a background photo. Background color.
Of course, the easiest way is. Recreate a dialog box with the API. Only the code will increase a lot.Or simply design a new form. The title of the form, as well as the prompt text and text box content, all need to be supported. unicode
With the transparency property, you can either set a background image for an area, or insert an image.
With these better features. Users can use different colors or images to create a more perfect dialog box.Can be used with twinbasic
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
The "WM_CTLCOLOREDIT" message is sent to the parent of the "Edit" control, which is the InputBox window so that's the one you need to subclass.
Make sure to specify the handle of the parent window in your call to CreateWindowExW:
Code:
HWND CreateWindowExW(
[in] DWORD dwExStyle,
[in, optional] LPCWSTR lpClassName,
[in, optional] LPCWSTR lpWindowName,
[in] DWORD dwStyle,
[in] int X,
[in] int Y,
[in] int nWidth,
[in] int nHeight,
[in, optional] HWND hWndParent, ' <-- this needs to be the hWnd of the InputBox
[in, optional] HMENU hMenu,
[in, optional] HINSTANCE hInstance,
[in, optional] LPVOID lpParam
);
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Small bug-fix update, now the edit box height will be adjusted correctly in case you choose a larger font size.
-
Re: VB6 - Original InputBox function reloaded with full Unicode support & new Edit St
Added the "Centered" property. Now you can center the InputBox on the current monitor or on its owner window. The download ZIP file has been updated in the first post.
