-
2 Attachment(s)
[VB6,twinBASIC/x64] Undocumented API: SHLimitInputEditWithFlags: Easy input filtering
Attachment 184176
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
Code:
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:
Code:
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:
Code:
'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:
Code:
'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:
Code:
'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:
Code:
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:
Code:
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 :wave:
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).
-
1 Attachment(s)
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
"Custom set" options are not working under WinXP.
Attachment 188043
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
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
Code:
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!
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
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.
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:
Code:
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.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
You misunderstand.
Code:
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.
Quote:
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.
-
1 Attachment(s)
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
fafalone
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.
Attachment 188058
-
1 Attachment(s)
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
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 Attachment 188059) but with any 1-byte character but english. I'm from Russia, for example.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
I've found the error! All works fine now without any StrConv:
Code:
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
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Can you explain why do we need this function here?
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
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.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
What DOJ settlement is that? Was Microsoft required to document functions exported in various DLLs?
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
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).
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
I can't use [Backspace] to delete characters in a TextBox. Only [Delete] button is allowed.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
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.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
fafalone
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).
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
fafalone
I didn't implement using LIM_TIPWIDTH and .cxTipWidth to set a custom width.
I tried, but they don't work for me.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
LIF_PASTESTOP doesn't work
LIF_PASTECANCEL works only with subclassing
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
Nouyana
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.
Quote:
I tried, but they don't work for me.
It specifies a maximum width.
Quote:
LIF_PASTESTOP doesn't work
Is this with Chinese characters? It's working for me.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
fafalone
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:)
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
Nouyana
(...) 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.
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
Quote:
Originally Posted by
fafalone
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:
Code:
'-----------------------------------------------------------------------------
' 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
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
The second part:
Code:
' ========================= 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
-
Re: [VB6] Undocumented API: SHLimitInputEditWithFlags - Easy input filtering
This is for your Form1:
Code:
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
-
Re: [VB6,twinBASIC/x64] Undocumented API: SHLimitInputEditWithFlags: Easy input filte
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.
