[VB6,twinBASIC/x64] Undocumented API: SHLimitInputEditWithFlags: Easy input filtering

[fafalone]

UNDOCUMENTED API: SHLimitInputEditWithFlags
Easily apply category filters, paste handling, and automated tooltips to an edit control.

Microsoft being Microsoft, they only begrudgingly documented a function called SHLimitInputEdit for the DOJ settlement, and did so poorly. This is a weird function; it takes an edit hwnd, and an object that implements IShellFolder and IItemNameLimits. The former doesn't even matter (unless it's been implemented in newer versions of Windows; I haven't checked). When you implement IItemNameLimits, you get a single call to GetValidCharacters, where you can supply a string of either included or excluded characters (only 1 can be used, so if you specify any excluded characters, included becomes null). It's an odd way of doing things.

But it turns out, that's a front end for an actually much more interesting and useful but completely undocumented, SHLimitInputEditWithFlags, an API Geoff Chappell found as exported at ordinal #754 in shell32.dll (it's still ordinal only in Windows 10, even though it's been kicking around since Windows XP).

This function allows a wide variety of options for limits and a tooltip that pops up upon bad input. Instead of just being able to specify an exact string, you can use CT_TYPE1 categories, which in addition to the standard upper, lower, digits... has some handy options like categories for hexadecimal, punctuation, or control characters. It also implements custom categories; binary, octal, and ASCII a-z/A-Z. It also provides control over a tooltip that pops up when you attempt to enter a bad character-- you can have no tooltip, or specify the title, message, and icon (a TTI_* default icon or custom hIcon), and set alignment, width, and timeout (including timing out immediately if a valid input is received). It also handles pasting in several different ways; filtering in the valid chars, pasting until the 1st invalid char, or canceling the paste. If the paste is modified, it puts what was pasted on the clipboard (optionally). The pasting options and automatic control over the tooltip is what really makes this worthwhile over just manually checking KeyPress events or WM_CHAR messages.

Requirements
-No dependencies.
-Function present on Windows XP through at least Windows 10 (I haven't checked 11).

Details

Public Declare Function SHLimitInputEditWithFlags Lib "shell32" Alias "#754" (ByVal hwndEdit As Long, pil As LIMITINPUT) As Long
Public Declare PtrSafe Function SHLimitInputEditWithFlags Lib "shell32" Alias "#754" (ByVal hwndEdit As LongPtr, pil As LIMITINPUT) As Long

SHLimitInputEditWithFlags takes two arguments, an hWnd for an edit control, and an (until this post) undocumented structure. Here's the members and a description:

Public Type LIMITINPUT
    cbSize As Long          'Size of structure. Must set.
    dwMask As LI_Mask       'LIM_* values.
    dwFlags As LI_Flags     'LIF_* values.
    hInst As LongPtr        'App.hInstance or loaded module hInstance.
    pszFilter As LongPtr    'String via StrPtr, LICF_* category, LPSTR_TEXTCALLBACK to set via LIN_GETDISPINFO, or resource id in .hInst.
    pszTitle As LongPtr     'Optional. String via StrPtr, LPSTR_TEXTCALLBACK to set via LIN_GETDISPINFO, or resource id in .hInst.
    pszMessage As LongPtr   'Ignore if tooltip disabled. String via StrPtr, LPSTR_TEXTCALLBACK to set via LIN_GETDISPINFO, or resource id in .hInst.
    hIcon As LongPtr        'See TTM_SETTITLE. Can be TTI_* default icon, hIcon, or I_ICONCALLBACK to set via LIN_GETDISPINFO.
    hwndNotify As LongPtr   'Window to send notifications to. Must specify if any callbacks used or bad character notifications enabled.
    iTimeout As Long        'Timeout in milliseconds. Defaults to 10000 if not set.
    cxTipWidth As Long      'Tooltip width. Default 500px.
End Type

dwMask is just a list of which of the remaining members should be used:

'Values for LIMITINPUT.dwMask
Public Enum LI_Mask
    LIM_FLAGS = &H1      'dwFlags used
    LIM_FILTER = &H2     'pszFilter used
    LIM_HINST = &H8      'hinst contains valid data. Generally must be set.
    LIM_TITLE = &H10     'pszTitle used. Tooltip title.
    LIM_MESSAGE = &H20   'pszMessage used. Tooltip main message.
    LIM_ICON = &H40      'hicon used. Can use default icons e.g. IDI_HAND. Loaded from .hInst.
    LIM_NOTIFY = &H80    'hwndNotify used. NOTE: Must be set to receive notifications. Automatic finding of parent broken.
    LIM_TIMEOUT = &H100  'iTimeout used. Default timeout=10000.
    LIM_TIPWIDTH = &H200 'cxTipWidth used. Default 500px.
End Enum

Now we'll get into the core of it with the flags for dwFlags:

'Values for LIMITINPUT.dwFlags
Public Enum LI_Flags
    LIF_INCLUDEFILTER = &H0     'Default: pszFilter specifies what to include.
    LIF_EXCLUDEFILTER = &H1     'pszFilter specifies what to exclude.
    LIF_CATEGORYFILTER = &H2    'pszFilter uses LICF_* categories, not a string of chars.

    LIF_WARNINGBELOW = &H0      'Default: Tooltip below.
    LIF_WARNINGABOVE = &H4      'Tooltip above.
    LIF_WARNINGCENTERED = &H8   'Tooltip centered.
    LIF_WARNINGOFF = &H10       'Disable tooltip.

    LIF_FORCEUPPERCASE = &H20   'Makes chars uppercase.
    LIF_FORCELOWERCASE = &H40   'Makes chars lowercase. (This and forceupper mutually exclusive)

    LIF_MESSAGEBEEP = &H0       'Default: System default beep played.
    LIF_SILENT = &H80           'No beep.

    LIF_NOTIFYONBADCHAR = &H100 'Send WM_NOTIFY LIN_NOTIFYBADCHAR. NOTE: Must set LIM_NOTIFY flag and .hwndNotify member.
    LIF_HIDETIPONVALID = &H200  'Timeout tooltip early if valid char entered.

    LIF_PASTESKIP = &H0         'Default: Paste any allowed characters, skip disallowed.
    LIF_PASTESTOP = &H400       'Paste until first disallowed character encountered.
    LIF_PASTECANCEL = &H800     'Cancel paste entirely if any disallowed character.

    LIF_KEEPCLIPBOARD = &H1000  'If not set, modifies clipboard to what was pasted after paste flags executed.
End Enum

If you do not use the LIF_CATEGORYFILTER flag, the .pszFilter member must be set to StrPtr(value) where value is a non-delimited string of which characters to allow (by default) or disallow (if LIF_EXCLUDEFILTER flag is included). If you do use the flag, the following categories are valid:

'Filters support CT_TYPE1 categories:
Public Const LICF_UPPER = &H1
Public Const LICF_LOWER = &H2
Public Const LICF_DIGIT = &H4
Public Const LICF_SPACE = &H8
Public Const LICF_PUNCT = &H10  'Punctuation
Public Const LICF_CNTRL = &H20  'Control characters
Public Const LICF_BLANK = &H40
Public Const LICF_XDIGIT = &H80  'Hexadecimal values, 0-9 and A-F.
Public Const LICF_ALPHA = &H100  'Any CT_TYPE1 linguistic character. Includes non-Latin alphabets.
'Custom categories
Public Const LICF_BINARYDIGIT = &H10000
Public Const LICF_OCTALDIGIT = &H20000 'Base 8; 0-7.
Public Const LICF_ATOZUPPER = &H100000 'ASCII A to Z
Public Const LICF_ATOZLOWER = &H200000 'ASCII a to z
Public Const LICF_ATOZ = (LICF_ATOZUPPER Or LICF_ATOZLOWER)

From there, you're all set to apply basic input limits to an edit control. Remember, if you don't want a tooltip you don't need to set the title, message, and icon, but in that case you must include the LIF_WARNINGOFF flag, or the function will fail. If you are going to have a tooltip, you must as a minimum specify the message.

Advanced

There's a couple flags for advanced options. LIF_NOTIFYONBADCHAR will send hWnd specified by the .hwndNotify member a LIN_BADCHAR notification code in a WM_NOTIFY message. You must subclass the specified hWnd to receive the message (on Windows 10, it will not automatically send them to the parent, but directly to the provided hWnd. That automatic behavior may work on earlier versions, but manually specifying it works on all). From there it has it's own NM structure to copy:

Private Type NMLIBADCHAR
    hdr As NMHDR
    wParam As LongPtr 'WM_CHAR wParam (Char code)
    lParam As LongPtr 'WM_CHAR lParam (see MSDN for details)
End Type

That gives you the WM_CHAR message.

There's also special handling for WM_PASTE operations built in. The default behavior is to paste whatever characters from the clipboard are allowed, then set the contents of the clipboard to the filtered result. You can change that behavior to only pasting up until the first disallowed character with the LIF_PASTESTOP flag, or to cancel the paste entirely with LIF_PASTECANCEL.

Callbacks

I didn't implement this option in the demo because I don't see a lot of utility for it, but you can specify LPSTR_TEXTCALLBACK for the text fields, and I_ICONCALLBACK for the icon field, and the control will send a LIN_GETDISPINFO message for the tooltip text and LIN_GETFILTERINFO for the filter. I'm not going to detail it, but it works exactly like LVN_GETDISPINFO callbacks for the ListView control, and there's plenty of documentation for that. The constants and structure are included in the Demo if you did want to explore this.

Sample Project

The demo pictured at the top of this post implements a wide array of features, including subclassing for the bad character notifications, but also includes a simple 'Set to numbers only' to show how simple calls to this function can be:

Dim tli As LIMITINPUT
tli.cbSize = LenB(tli)
tli.dwMask = LIM_FILTER Or LIM_FLAGS
tli.dwFlags = LIF_CATEGORYFILTER Or LIF_WARNINGOFF
tli.pszFilter = LICF_DIGIT

SHLimitInputEditWithFlags Text1.hWnd, tli

That's all you need to do to have a textbox take only numbers, with no tooltip.

---

And that's it! Enjoy this undocumented treasure from the Windows API.

Thanks: Thanks ToddB, it is super cool and should have been a documented tool the world knew

IMPORTANT: This is an undocumented, internal API, with all the issues that involves. There may be small variations in functionality between Windows versions, stability is not guaranteed, and it may be removed at any time from future versions, or have it's ordinal changed.

**UPDATE**
02 Jul 2023: UndocEditLimit-R2.zip (Revision 2) corrects an odd bug where the custom filters weren't working because despite being declared as a Unicode string type (LPWSTR), the API handled it as an ANSI string, and thus is was necessary to convert first.

13 Dec 2023: Project updated for Universal Compatibility. Now compatible with VB6, VBA6, VBA7 32bit, VBA7 64bit, twinBASIC 32bit, and twinBASIC 64bit. The zip contains both a VB6 project and twinBASIC project (as well as an alternate twinBASIC project without universal compatibility using tB language enhancements).

[Nouyana]

"Custom set" options are not working under WinXP.

[fafalone]

So I looked into this, it's the same on Win10...

What's happening, is despite .pszFilter being a LPWSTR (W=Unicode), it's actually expecting an ANSI string.

The Exclude filter below that had a further error in that it referred to the textbox above it.

Replace the two blocks for Option2(2) and Option2(3) with

ElseIf Option2(2).Value = True Then
    sFilter = StrConv(Text3.Text, vbFromUnicode)
    tli.pszFilter = StrPtr(sFilter)
    sMsg = "Only " & Text3.Text & " are allowed."
ElseIf Option2(3).Value = True Then
    tli.dwFlags = tli.dwFlags Or LIF_EXCLUDEFILTER
    sFilter = StrConv(Text4.Text, vbFromUnicode)
    tli.pszFilter = StrPtr(sFilter)
    sMsg = Text3.Text & " are not allowed."
End If

Or, I've updated the attachment.

Thanks for letting me know!

[Nouyana]

So I looked into this, it's the same on Win10...

What's happening, is despite .pszFilter being a LPWSTR (W=Unicode), it's actually expecting an ANSI string.

No. VB6 always assumes that all API-functions are non-unicode. That is why VB6 always converts strings in API-calls to ANSI. If we have a problem with strings in API-calls, it means that API-function expects unicode strings.

You should try to declare pszFilter(1 To 256 * 2) As Byte and fill it like that:

Private Declare Sub CopyMemory _
                Lib "kernel32.dll" _
                Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                       ByRef Source As Any, _
                                       ByVal Length As Long)
Private Sub Command1_Click()
 ' ...
   ElseIf Option2(2).Value = True Then
      sFilter = Text3.Text
      With tli
         CopyMemory ByVal VarPtr(.pszFilter(LBound(.pszFilter))), _
                    ByVal StrPtr(sFilter), Min(Len(sFilter) * 2, _
                    UBound(.pszFilter) - LBound(.pszFilter) + 1 - 2)
      End With
      sMsg = "Only " & Text3.Text & " are allowed."
 ' ...
End Sub

I will try it later too.

[fafalone]

You misunderstand.

typedef struct tagLIMITINPUT
{
    DWORD       cbSize;
    DWORD       dwMask;
    DWORD       dwFlags;
    HINSTANCE   hinst;
    LPWSTR      pszFilter;      // pointer to a string, or the ID of a string resource if hinst is also given, or LPSTR_TEXTCALLBACK if the parent window should be notified to provide a string.
    LPWSTR      pszTitle;       // pointer to a string, or the ID of a string resource if hinst is also given, or LPSTR_TEXTCALLBACK if the parent window should be notified to provide a string.
    LPWSTR      pszMessage;     // pointer to a string, or the ID of a string resource if hinst is also given, or LPSTR_TEXTCALLBACK if the parent window should be notified to provide a string.
    HICON       hIcon;          // handle to an icon, or I_ICONCALLBACK if the notify window should be asked to provide an icon.
    HWND        hwndNotify;     // handle to a window to process notify messages
    INT         iTimeout;       // time in milliseconds to display the tooltip
    INT         cxTipWidth;     // max width of the tooltip in pixels.  Defaults to 500.
} LIMITINPUT;

This is the C declaration for the LIMITINPUT struct.

LPWSTR is a Long Pointer to a Wide String -- Wide meaning 2-byte Unicode. So this API is telling us it expects a Unicode string. But it's lying to us... or more accurately, we haven't done #define UNICODE so that sizeof(TCHAR) = 2 and so the API internally maps StrCpy to StrCpyW instead of StrCpyA when it uses them.
VB6 strings are Unicode internally, which is way we pass with StrPtr-- to bypass the Unicode to ANSI conversion.

You should try to declare pszFilter(1 To 256 * 2) As Byte and fill it like that:

This is completely incorrect. It's expecting a pointer, not a raw character array. Doing it that way will cause all the remaining members to be overwritten by your string... you're going to experience a crash. And why use all that stuff in your function rather than a simple StrConv call? You'd use pszFilter As String and simply do pszFilter = Text3.Text *if there were no other considerations*... however here we have an additional use of this member: When you specify a category filter, pszFilter is not treated as a pointer to a string, it's treated as a flag containing 1 or more of the LICF_* values. So now what are you going to do? VB won't like you overwriting the String pointer.

Strongly advise using the simple method I posted, which I've verified works.

[Nouyana]

When you specify a category filter, pszFilter is not treated as a pointer to a string, it's treated as a flag containing 1 or more of the LICF_* values. So now what are you going to do?

Yes, I was wrong. I did not study your example carefully. Sorry.

The only problem is that we can't use Unicode here
Why should we use vbFromUnicode for the "Wide String"? There should be another way.

I've replaced some controls with Krool's VBCCR. Try to use it.

SHLimitInputEditWithFlags.7z

[Nouyana]

The Chr$ function in FormWndProc cause an error when deal with unicode characters. Maybe you should use ChrW$.

Your example doesn't work not only with 2-bytes chineese characters (as in SHLimitInputEditWithFlags.7z) but with any 1-byte character but english. I'm from Russia, for example.

[Nouyana]

I've found the error! All works fine now without any StrConv:

Public Function FormWndProc(ByVal hWnd As Long, _
                            ByVal uMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam As Long, _
                            ByVal uIdSubclass As Long, _
                            ByVal dwRefData As Long) As Long
   Select Case uMsg
   Case WM_NOTIFY
      Dim hdr As NMHDR
'      CopyMemory hdr, ByVal lParam, Len(hdr)
      CopyMemory hdr, ByVal lParam, Len(lParam)
      If hdr.hWndFrom = Form1.Text1.hWnd Then
         If hdr.Code = LIN_BADCHAR Then
            Dim nmlibc As NMLIBADCHAR
'            CopyMemory nmlibc, ByVal lParam, Len(nmlibc)
            CopyMemory nmlibc, ByVal lParam, Len(lParam)
            Debug.Print "NotifyBadChar " & ChrW$(nmlibc.wParam)
            Form1.BadInput ChrW$(nmlibc.wParam)
         End If
      End If
   Case WM_DESTROY
      Call UnSubclass2(hWnd, PtrFormWndProc(), uIdSubclass)
   End Select
   FormWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

[Nouyana]

Can you explain why do we need this function here?

[fafalone]

The subclass? You don't need it; it's an optional feature to notify you of when a character is blocked and what it was. Don't use the LIF_NOTIFYONBADCHAR flag and you don't need any subclassing.

[VanGoghGaming]

What DOJ settlement is that? Was Microsoft required to document functions exported in various DLLs?

[fafalone]

https://en.wikipedia.org/wiki/United...Microsoft_Corp.

Part of the settlement reached included documenting all Windows APIs which their non-Windows products had access to, but weren't previously documented. MS had been giving their own apps like IE and Office an advantage by giving them access to undocumented system APIs. They documented a lot, but in an extremely half assed manner, and have been in open violation this whole time since there's a number of APIs their own products call that have never been documented (for more on that, see Geoff Chappell's excellent research).

[Nouyana]

I can't use [Backspace] to delete characters in a TextBox. Only [Delete] button is allowed.

[fafalone]

Weird. Not only that, it's not even recognizing it at backspace, it saying is character 0x19, 'end of medium'. Which comes up as an alias for backspace but only on some ancient terminals.

If you're using a category filter, you can add LICF_CNTRL to allow control characters (including backspace).

For an allow only filter, I'm looking at ways to add it... simply appending it doesn't seem to work. Will have to get back to you on that.

[Nouyana]

If you're using a category filter, you can add LICF_CNTRL to allow control characters (including backspace).

In this case other rules are not working. Test it with your hexadecimal example. I can enter anything (including backspace).

[Nouyana]

I didn't implement using LIM_TIPWIDTH and .cxTipWidth to set a custom width.

I tried, but they don't work for me.

[Nouyana]

LIF_PASTESTOP doesn't work
LIF_PASTECANCEL works only with subclassing

[fafalone]

In this case other rules are not working. Test it with your hexadecimal example. I can enter anything (including backspace).

What do you mean ? When I apply hexadecimal it correctly filters out everything besides A-F and 0-9, allowing backspace by adding LICF_CNTRL was the point, you wanted that to work right? If you remove that, it's strict A-F/0-9 with delete.

I tried, but they don't work for me.

It specifies a maximum width.

LIF_PASTESTOP doesn't work

Is this with Chinese characters? It's working for me.

[Nouyana]

Is this with Chinese characters? It's working for me.

Is there any Chinese living in the NYC?

It seems that it depends on clipboard content-type (CF_UNICODETEXT or not). Try to change character set in Notepad++ from UCS-2 to ANSI before copy/paste to your sample program. It will works fine with UCS-2 and will not with ANSI. Use only English alphabet

[fafalone]

(...) Your example doesn't work not only with 2-bytes chineese characters (...)

That's why I asked. But yes there's quite a few Chinese people here.

[Nouyana]

What do you mean ? When I apply hexadecimal it correctly filters out everything besides A-F and 0-9, allowing backspace by adding LICF_CNTRL

Yes, I was wrong. It works. This is a class I'm working on. A lot of Russian comments though.

The first part:

'-----------------------------------------------------------------------------
' Module   : CTextBoxLimits
' Descript : Класс для задания ограничений ввода для TextBox.
'            Может отображать ToolTip и издавать Beep при некорректном вводе.
'            Большинство текстовых свойств может использовать ресурсы, но
'            это пока не реализовано в классе.
' Author   : Топоров Константин Станиславович, 05.07.2023
'            Основная техническая информация о недокументированной функции
'            SHLimitInputEditWithFlags взята у fafalone:
'            https://www.vbforums.com/showthread.php?895398-VB6-Undocumented-API-SHLimitInputEditWithFlags-Easy-input-filtering&p=5611062#post5611062
'-----------------------------------------------------------------------------

Option Explicit

Private Enum LI_Mask    'ФЛАГИ ДЛЯ LIMITINPUTSTRUCT.dwMask
   LIM_FLAGS = &H1      ' - включает dwFlags (LIF_* флаги);
   LIM_FILTER = &H2     ' - включает pszFilter (в т.ч. LICF_* флаги);
   LIM_HINST = &H8      ' - включает hInst;
   LIM_TITLE = &H10     ' - включает pszTitle (заголовок Tooltip);
   LIM_MESSAGE = &H20   ' - включает pszMessage (сообщение Tooltip);
   LIM_ICON = &H40      ' - включает hIcon (иконка Tooltip). Может использовать иконки по умолчанию, такие как. IDI_HAND. загружается из .hInst.
   LIM_NOTIFY = &H80    ' - включает hwndNotify. ВАЖНО: Флаг должен быть установлен для получения уведомлений. Автоматический поиск родителя (parent) не работает.
   LIM_TIMEOUT = &H100  ' - включает iTimeout. Таймаут Tooltip по умолчанию = 10000 миллисекунд.
   LIM_TIPWIDTH = &H200 ' - включает cxTipWidth. Ширина Tooltip. По умолчанию = 500px.
End Enum

Private Enum LIF_Flags         'ФЛАГИ ДЛЯ LIMITINPUTSTRUCT.dwFlags
   LIF_INCLUDEFILTER = &H0     ' - ПО УМОЛЧАНИЮ: pszFilter определяет список допустимых символов;
   LIF_EXCLUDEFILTER = &H1     ' - pszFilter определяет список НЕдопустимых символов;
   LIF_CATEGORYFILTER = &H2    ' - pszFilter использует константы LICF_* вместо строки символов;
   
   LIF_WARNINGBELOW = &H0      ' - ПО УМОЛЧАНИЮ: Tooltip под текстовым полем.
   LIF_WARNINGABOVE = &H4      ' - кончик Tooltip сверху.
   LIF_WARNINGCENTERED = &H8   ' - кончик Tooltip по центру.
   LIF_WARNINGOFF = &H10       ' - отключить tooltip.
   
   LIF_FORCEUPPERCASE = &H20   ' - автоматически переводит символы в верхний регистр;
   LIF_FORCELOWERCASE = &H40   ' - либо в нижний регистр;
   
   LIF_MESSAGEBEEP = &H0       ' - ПО УМОЛЧАНИЮ: Системный beep при недопустимом вводе;
   LIF_SILENT = &H80           ' - без сигнала (beep).
   
   LIF_NOTIFYONBADCHAR = &H100 ' - Windows посылает уведомления WM_NOTIFY LIN_NOTIFYBADCHAR.
                               '   Важно: Должен быть установлен флаг LIM_NOTIFY и задан параметр .hwndNotify.
                               '   Для этих целей fafalone использовал сабклассинг.
                               
   LIF_HIDETIPONVALID = &H200  ' - Таймаут для Tooltip уменьшается, если введён корректный символ.
   
   LIF_PASTESKIP = &H0         ' - ПО УМОЛЧАНИЮ: При вставке из буфера будут вставлены все допустимые символы. Недопустимые будут пропущены.
   LIF_PASTESTOP = &H400       ' - Вставка будет осуществляться до первого недопустимого символа.
   LIF_PASTECANCEL = &H800     ' - Вставка будет полностью отменена, если есть хотя бы один недопустимый символ.
   
   LIF_KEEPCLIPBOARD = &H1000  ' - Если не задан, то передаёт в буфер то, что было фактически вставлено в TextBox.
End Enum

Private Enum LICF_Flags        ' ФЛАГИ ДЛЯ pszFilter. ОСНОВНЫЕ (CT_TYPE1):
   LICF_UPPER = &H1            ' - верхний регистр;
   LICF_LOWER = &H2            ' - нижний регистр;
   LICF_DIGIT = &H4            ' - цифры;
   LICF_SPACE = &H8            ' - пробел;
   LICF_PUNCT = &H10           ' - знаки пунктуации;
   LICF_CNTRL = &H20           ' - управляющие символы (включая BackSpace);
   LICF_BLANK = &H40           '
   LICF_XDIGIT = &H80          ' - шестнадцатиричные цифры (0-9 и A-F);
   LICF_ALPHA = &H100          ' - любая буква любого алфавита.
   
                               ' ДОП.ФЛАГИ ДЛЯ pszFilter. (CT_TYPE2):
   LICF_BINARYDIGIT = &H10000  ' - 0 или 1;
   LICF_OCTALDIGIT = &H20000   ' - Base 8; 0-7.
   LICF_ATOZUPPER = &H100000   ' - ASCII A to Z
   LICF_ATOZLOWER = &H200000   ' - ASCII a to z
   LICF_ATOZ = (LICF_ATOZUPPER Or LICF_ATOZLOWER)
End Enum

Private Enum TTI_Icons         ' СПИСОК ВОЗМОЖНЫХ ИКОНОК ДЛЯ Tooltip
   TTI_NONE = 0
   
   TTI_INFO = 1
   TTI_WARNING = 2
   TTI_ERROR = 3
   
   TTI_INFO_LARGE = 4
   TTI_WARNING_LARGE = 5
   TTI_ERROR_LARGE = 6
End Enum

Private Type LIMITINPUTSTRUCT  ' СТРУКТУРА ПАРАМЕТРА Limits
   cbSize     As Long          ' Размер структуры. Обязательный параметр.
   dwMask     As LI_Mask       ' Флаги LIM_*.
   dwFlags    As LIF_Flags     ' Флаги LIF_*;
   hInst      As Long          ' App.hInstance или hInstance загруженного модуля.
   pszFilter  As LICF_Flags    ' Указатель на строку-фильтр (StrPtr)
                               '   или константы LICF_*,
                               '   или id ресурса в .hInst.
   pszTitle   As Long          ' Указатель на строку-заголовок Tooltip (StrPtr)
                               '   или id ресурса в .hInst.
   pszMessage As Long          ' Указатель на строку-сообщение Tooltip (StrPtr)
                               '   или id ресурса в .hInst.
   hIcon      As TTI_Icons     ' Иконка для Tooltip. Это может быть:
                               '   или константы TTI_*,
                               '   или id ресурса в .hInst.
   hwndNotify As Long          ' Окно-получатель сообщений. Должно быть указа-
                               '   но, если уведомления о некорректных симво-
                               '   лах включены (LIM_NOTIFY).
   iTimeout   As Long          ' Таймаут Tooltip. По умолчанию = 10000 миллисекунд.
   cxTipWidth As Long          ' Ширина Tooltip. По умолчанию = 500px.
End Type

Private Declare Function SHLimitInputEditWithFlags _
               Lib "shell32" _
               Alias "#754" (ByVal hWndEdit As Long, _
                             Limits As LIMITINPUTSTRUCT) As Long
Private Declare Function GetWindowLong _
                Lib "user32" _
                Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                        ByVal nIndex As Long) As Long
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 SendMessage _
                Lib "user32" _
                Alias "SendMessageA" (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Public Enum TBLIM_FilterType
   TBLIM_ALLOW = 0
   TBLIM_EXCLUDE = 1
End Enum

Public Enum TBLIM_Icons
   TBLIM_NONE = 0
   TBLIM_INFO = 1
   TBLIM_WARNING = 2
   TBLIM_ERROR = 3
End Enum

Public Enum TBLIM_ToolTipState
   TBLIM_BELOW = &H0      ' - Tooltip под текстовым полем.
   TBLIM_ABOVE = &H4      ' - кончик Tooltip сверху.
   TBLIM_CENTERED = &H8   ' - кончик Tooltip по центру.
   TBLIM_TURN_OFF = &H10  ' - отключить tooltip.
End Enum

Public Enum TBLIM_PasteType
   TBLIM_PASTESKIP = &H0     ' - При вставке из буфера будут вставлены все допустимые символы. Недопустимые будут пропущены.
   TBLIM_PASTESTOP = &H400   ' - Вставка будет осуществляться до первого недопустимого символа.
   TBLIM_PASTECANCEL = &H800 ' - Вставка будет полностью отменена, если есть хотя бы один недопустимый символ.
End Enum

Private Limits   As LIMITINPUTSTRUCT ' Limits parameter of SHLimitInputEditWithFlags
Private DefaultLimits   As LIMITINPUTSTRUCT ' To Reset all.
Private hWndEdit        As Long      ' hWndEdit parameter of SHLimitInputEditWithFlags
Private sToolTipTitle   As String    ' Заголовок ToolTip
Private sToolTipMessage As String    ' Сообщение ToolTip
Private sLimitsFilter   As String    ' Фильтр
Private nLimitsLength   As Long      ' Для LimitsLength (EM_LIMITTEXT)

Private Const EM_LIMITTEXT = &HC5
Private Const GWL_STYLE = -16
Private Const ES_UPPERCASE = 8
Private Const ES_LOWERCASE = 16
Private lStyle   As Long             ' для GetWindowLong и SetWindowLong

[Nouyana]

The second part:

' ========================= CLASS INITIALIZATION ==========================
Public Property Let hWnd(Optional ByVal bSavePreviousLimits As Boolean = _
                           False, ByVal lonValue As Long)

   Static bInitialized As Boolean

   If bInitialized Then Exit Property
   bInitialized = True
   hWndEdit = lonValue

   With DefaultLimits                             ' Default values
      .cbSize = Len(DefaultLimits)
      .dwMask = LIM_FILTER + LIM_FLAGS + LIM_HINST + LIM_ICON _
                + LIM_MESSAGE + LIM_TIMEOUT + LIM_TITLE
      .hInst = App.hInstance
      .dwFlags = LIF_KEEPCLIPBOARD
      .pszFilter = LICF_CNTRL
   End With

   lStyle = GetWindowLong(hWndEdit, GWL_STYLE)
   
   If bSavePreviousLimits Then Exit Property
   Call Reset                                     ' Reset all properties
End Property

Public Sub Reset()
   Static bInitialized As Boolean
   Limits = DefaultLimits
   
   ToolTipTitle = "Bad character"                 ' Default values
   ToolTipMessage = "This character is not allowed"
   ToolTipIcon = TBLIM_WARNING
   ToolTipState = TBLIM_BELOW
   ToolTipTimeout = 10000&
   ForceUpperCase = False
   ForceLowerCase = False
   FilterType = TBLIM_ALLOW
   LimitsFilter = ""          ' Should be first in Limits* sets
   LimitsHexadecimal = False
   LimitsDigits = False
   LimitsSpace = False
   LimitsLength = 0
   BeepOnError = True
   
   If bInitialized Then Call Refresh
   bInitialized = True
End Sub
Public Sub Refresh()
   Dim hr   As Long
   Dim lerr As Long
   
'   Debug.Print "==== Refresh ===="
'   Debug.Print "LICF_SPACE "; CBool(Limits.pszFilter And LICF_SPACE)
'   Debug.Print "LICF_DIGIT "; CBool(Limits.pszFilter And LICF_DIGIT)
'   Debug.Print "LICF_XDIGIT "; CBool(Limits.pszFilter And LICF_XDIGIT)
'   Debug.Print "LIF_EXCLUDEFILTER "; CBool(Limits.dwFlags And LIF_EXCLUDEFILTER)
'   Debug.Print "ES_UPPERCASE "; CBool(lStyle And ES_UPPERCASE)
   
   hr = SetWindowLong(hWndEdit, GWL_STYLE, lStyle)
   lerr = Err.LastDllError
   If lerr Then
      Debug.Print "SetWindowLong error: hr=0x" & Hex$(hr) & _
           ", err=0x" & Hex$(lerr)
   End If
   
   hr = SHLimitInputEditWithFlags(hWndEdit, Limits)
   lerr = Err.LastDllError
   If lerr Then
      Debug.Print "SHLimitInputEditWithFlags error: hr=0x" & Hex$(hr) & _
           ", err=0x" & Hex$(lerr)
   End If
   
   hr = SendMessage(hWndEdit, EM_LIMITTEXT, nLimitsLength, ByVal 0&)
   lerr = Err.LastDllError
   If lerr Then
      Debug.Print "SendMessage(EM_LIMITTEXT) error: hr=0x" & Hex$(hr) & _
           ", err=0x" & Hex$(lerr)
   End If
End Sub

' ========================= PUBLIC PROPERTIES =============================
Public Property Let ToolTipTitle(ByVal strValue As String)
   sToolTipTitle = strValue
   Limits.pszTitle = StrPtr(sToolTipTitle)
End Property
Public Property Let ToolTipMessage(ByVal strValue As String)
   sToolTipMessage = strValue
   Limits.pszMessage = StrPtr(sToolTipMessage)
End Property
Public Property Let ToolTipIcon(Optional ByVal bLarge As Boolean = False, _
                                ByVal tti As TBLIM_Icons)
   With Limits
      If tti Then
         .dwMask = .dwMask Or LIM_ICON
         .hIcon = tti + IIf(bLarge, 3, 0)
      Else
         .dwMask = .dwMask And Not LIM_ICON
      End If
   End With
End Property
Public Property Let ToolTipState(ByVal tts As TBLIM_ToolTipState)
   With Limits
      Select Case tts
      Case TBLIM_ToolTipState.TBLIM_TURN_OFF
         .dwFlags = .dwFlags Or LIF_WARNINGOFF
         .dwFlags = .dwFlags And Not LIF_WARNINGABOVE
         .dwFlags = .dwFlags And Not LIF_WARNINGCENTERED
      Case TBLIM_ToolTipState.TBLIM_ABOVE
         .dwFlags = .dwFlags And Not LIF_WARNINGOFF
         .dwFlags = .dwFlags Or LIF_WARNINGABOVE
         .dwFlags = .dwFlags And Not LIF_WARNINGCENTERED
      Case TBLIM_ToolTipState.TBLIM_CENTERED
         .dwFlags = .dwFlags And Not LIF_WARNINGOFF
         .dwFlags = .dwFlags And Not LIF_WARNINGABOVE
         .dwFlags = .dwFlags Or LIF_WARNINGCENTERED
      Case Else
         .dwFlags = .dwFlags And Not LIF_WARNINGOFF
         .dwFlags = .dwFlags And Not LIF_WARNINGABOVE
         .dwFlags = .dwFlags And Not LIF_WARNINGCENTERED
      End Select
   End With
End Property
Public Property Let ToolTipTimeout(Optional ByVal bHideTipOnValidEntry As _
                                   Boolean = True, ByVal lonValue As Long)
   With Limits
      If lonValue Then
         .iTimeout = lonValue
      Else
         .iTimeout = 10000
      End If
      If bHideTipOnValidEntry Then
         .dwFlags = .dwFlags Or LIF_HIDETIPONVALID
      Else
         .dwFlags = .dwFlags And Not LIF_HIDETIPONVALID
      End If
   End With
End Property

Public Property Let ForceUpperCase(ByVal bValue As Boolean)
   ' Флаг LIF_FORCEUPPERCASE без сабклассинга не работает, поэтому
   ' пользуемся обычными документированными функциями API.
'   Debug.Print ">> ForceUpperCase "; bValue
   With Limits
      If bValue Then
         lStyle = lStyle Or ES_UPPERCASE
         .pszFilter = .pszFilter Or LICF_UPPER
      Else
         lStyle = lStyle And Not ES_UPPERCASE
         .pszFilter = .pszFilter And Not LICF_UPPER
      End If
   End With
End Property
Public Property Let ForceLowerCase(ByVal bValue As Boolean)
   ' Флаг LIF_FORCELOWERCASE без сабклассинга не работает, поэтому
   ' пользуемся обычными документированными функциями API.
'   Debug.Print ">> ForceLowerCase "; bValue
   With Limits
      If bValue Then
         lStyle = lStyle Or ES_LOWERCASE
         .pszFilter = .pszFilter Or LICF_LOWER
      Else
         lStyle = lStyle And Not ES_LOWERCASE
         .pszFilter = .pszFilter And Not ES_LOWERCASE
      End If
   End With
End Property
Public Property Let FilterType(ByVal ft As TBLIM_FilterType)
   With Limits
      If ft = TBLIM_EXCLUDE Then
'         Debug.Print ">> FilterType TBLIM_EXCLUDE"
         .dwFlags = .dwFlags Or LIF_EXCLUDEFILTER
      Else
'         Debug.Print ">> FilterType TBLIM_ALLOW"
         .dwFlags = .dwFlags And Not LIF_EXCLUDEFILTER
      End If
   End With
End Property
Public Property Let LimitsHexadecimal(ByVal bValue As Boolean)
'   Debug.Print ">> LimitsHexadecimal "; bValue
   With Limits
      If bValue Then
         .dwFlags = .dwFlags Or LIF_CATEGORYFILTER
         .pszFilter = .pszFilter Or LICF_XDIGIT
'         .pszFilter = .pszFilter Or LICF_CNTRL
      Else
         .pszFilter = .pszFilter And Not LICF_XDIGIT
      End If
   End With
End Property
Public Property Let LimitsDigits(ByVal bValue As Boolean)
'   Debug.Print ">> LimitsDigits "; bValue
   With Limits
      If bValue Then
         .dwFlags = .dwFlags Or LIF_CATEGORYFILTER
         .pszFilter = .pszFilter Or LICF_DIGIT
'         .pszFilter = .pszFilter Or LICF_CNTRL
      Else
         .pszFilter = .pszFilter And Not LICF_DIGIT
      End If
   End With
End Property
Public Property Let LimitsSpace(ByVal bValue As Boolean)
'   Debug.Print ">> LimitsSpace "; bValue
   With Limits
      If bValue Then
         .dwFlags = .dwFlags Or LIF_CATEGORYFILTER
         .pszFilter = .pszFilter Or LICF_SPACE
'         .pszFilter = .pszFilter Or LICF_CNTRL
      Else
         .pszFilter = .pszFilter And Not LICF_SPACE
      End If
   End With
End Property
Public Property Let LimitsFilter(ByVal sFilter As String)
'   Debug.Print ">> LimitsFilter: "; sFilter
   sLimitsFilter = sFilter
   With Limits
      If LenB(sLimitsFilter) Then
         .pszFilter = StrPtr(sLimitsFilter)
         .dwFlags = .dwFlags And Not LIF_CATEGORYFILTER
      Else
         .dwFlags = .dwFlags Or LIF_CATEGORYFILTER
         .pszFilter = LICF_CNTRL
      End If
   End With
End Property
Public Property Let LimitsLength(ByVal nLen As Long)
'   Debug.Print ">> LimitsLength: "; nLen
   nLimitsLength = nLen                           ' 0 is default
End Property
Public Property Let BeepOnError(ByVal bValue As Boolean)
   With Limits
      If bValue Then
         .dwFlags = .dwFlags And Not LIF_SILENT
      Else
         .dwFlags = .dwFlags Or LIF_SILENT
      End If
   End With
End Property

[Nouyana]

This is for your Form1:

Option Explicit

Private Sub Command1_Click()
   With New CTextBoxLimits
      .hWnd = Text1.hWnd
      
      If Option2(0).Value = True Then
         .LimitsHexadecimal = True
         .ForceUpperCase = True
         .ToolTipMessage = "Only hexadecimal (0-9, A-F) are allowed."
   
      ElseIf Option2(1).Value = True Then
         .FilterType = TBLIM_EXCLUDE  ' (default = TBLIM_ALLOW)
         .LimitsDigits = True
         .LimitsSpace = True
         .ToolTipMessage = "No spaces or numbers allowed."
   
      ElseIf Option2(2).Value = True Then
         .LimitsFilter = Text3
         .ToolTipMessage = "Only " & Text3.Text & " are allowed."
   
      ElseIf Option2(3).Value = True Then
         .FilterType = TBLIM_EXCLUDE
         .LimitsFilter = Text4
         .ToolTipMessage = Text4 & " are not allowed."
      End If
      
      If Not CBool(Check7) Then .ToolTipIcon = TBLIM_NONE
      
      If CBool(Check2) Then
         .ToolTipState = TBLIM_ABOVE
      ElseIf CBool(Check3) Then
         .ToolTipState = TBLIM_TURN_OFF
      End If
      
      .ToolTipTimeout = CLng(Text2.Text)
      .BeepOnError = Not CBool(Check1)
      .Refresh
   End With
   
   Text1.SetFocus
End Sub

Private Sub Command2_Click()
   With New CTextBoxLimits
      .hWnd = Text1.hWnd
      .ToolTipState = TBLIM_TURN_OFF
      .LimitsDigits = True
      .Refresh
   End With
   
   Text1.SetFocus
End Sub

Private Sub Command3_Click()
   With New CTextBoxLimits
      .hWnd(True) = Text1.hWnd       ' "True" means "Save Previous Limits"
      .LimitsLength = CLng(Text5)
      .Refresh
   End With
   
   Text1.SetFocus
End Sub

Private Sub Form_Load()
   Text2 = "0"
   With New CTextBoxLimits
      .hWnd = Text2.hWnd
      .FilterType = TBLIM_ALLOW
      .LimitsDigits = True
      .Refresh
   End With
End Sub

[fafalone]

PROJECT UPDATED

I've updated this project for Universal Compatibility. Now compatible with VB6, VBA6, VBA7 32bit, VBA7 64bit, twinBASIC 32bit, and twinBASIC 64bit. The zip contains both a VB6 project and twinBASIC project (as well as an alternate twinBASIC project without universal compatibility using tB language enhancements).

Now also available on GitHub.