So there's quite a few posts about specific questions where code like this is shown, but I really thought it would be better to have a subclassing tutorial type codebank entry for it to make it more easily searchable, and a better answer for when somebody hasn't used subclassing before.
Since Windows XP, there's been some great subclassing setups posted showing how to use SetWindowSubclass as a newer, better subclassing method than previous SetWindowLong-based methods. Karl E. Peterson's HookXP and LaVolpe's Subclassing With Common Controls Library being two top notch examples, and this method was first shown to me by Bonnie West over in my ITaskBarList3 demo. But before delving into using interfaces etc, (and even still for subclassing things other than forms and the like), it's helpful to show how to do the very simplest of subclassing: When you have any object, and just want to have a code to handle a message without much fuss.
The subclassing example I picked for this is validating whether text typed into a textbox is a valid filename, and blocking the input altogether if the keystroke or paste operation contains an illegal character or is too long. (You could do this without subclassing in most scenarios, but I thought it was a nice and simple way to get the idea across.)
All it requires on the form is a single textbox.
Once you have that, you'll need to create the function that handles its messages in a module. All such functions, usually referred to as the WndProc, have the same arguments. Also, they all must unsubclass when the window is being destroyed (or before) otherwise the program will crash. So before adding any code for handling messages, the basic prototype looks like this:
The DefSubclassProc call passes everything back to the default handler if you're not completely handling it. The PtrEditWndProc is there because you can't use the AddressOf operator to get the address of the function it's in.
Now that you have a function to handle the messages, you can add the code to start the subclass back in the form:
And now you have a basic subclass all set up and ready to go. You don't need an Unsubclass in Form_Unload.
Here's the message handlers used to validate input for a textbox looking for a valid file name (and appears right after Select Case uMsg:
Here's what the full project looks like with all the supporting codes and declares added in:
Form1
mSubclass
It's still a little complicated, but this is the very simplest way to get subclassing going.
Since Windows XP, there's been some great subclassing setups posted showing how to use SetWindowSubclass as a newer, better subclassing method than previous SetWindowLong-based methods. Karl E. Peterson's HookXP and LaVolpe's Subclassing With Common Controls Library being two top notch examples, and this method was first shown to me by Bonnie West over in my ITaskBarList3 demo. But before delving into using interfaces etc, (and even still for subclassing things other than forms and the like), it's helpful to show how to do the very simplest of subclassing: When you have any object, and just want to have a code to handle a message without much fuss.
The subclassing example I picked for this is validating whether text typed into a textbox is a valid filename, and blocking the input altogether if the keystroke or paste operation contains an illegal character or is too long. (You could do this without subclassing in most scenarios, but I thought it was a nice and simple way to get the idea across.)
All it requires on the form is a single textbox.
Once you have that, you'll need to create the function that handles its messages in a module. All such functions, usually referred to as the WndProc, have the same arguments. Also, they all must unsubclass when the window is being destroyed (or before) otherwise the program will crash. So before adding any code for handling messages, the basic prototype looks like this:
Code:
Public Function EditWndProc(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
'[other messages will go here later]
Case WM_DESTROY
Call UnSubclass(hWnd, PtrEditWndProc)
End Select
EditWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Private Function PtrEditWndProc() As Long
PtrEditWndProc = FARPROC(AddressOf EditWndProc)
End FunctionNow that you have a function to handle the messages, you can add the code to start the subclass back in the form:
Code:
Private Sub Form_Load()
Call Subclass(Text1.hWnd, AddressOf EditWndProc)
End SubHere's the message handlers used to validate input for a textbox looking for a valid file name (and appears right after Select Case uMsg:
Code:
Case WM_CHAR
Dim lLen As Long
lLen = SendMessageW(hWnd, WM_GETTEXTLENGTH, 0, ByVal 0&) + 1
If lLen > 260 Then
Beep
wParam = 0
Call ShowBalloonTipEx(hWnd, "", "Maximum number of characters has been reached. The total length of the file name cannot exceed 260 characters.", TTI_NONE) ' TTI_ERROR)
Exit Function
End If
Select Case wParam
Case 47, 92, 60, 62, 58, 42, 124, 63, 34 'Illegal chars /\<>:*|?"
Beep
Call ShowBalloonTipEx(hWnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
wParam = 0
End Select
Case WM_PASTE
Dim iCheck As Integer
iCheck = IsClipboardValidFileName()
If iCheck = 0 Then
Beep
Call ShowBalloonTipEx(hWnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
Exit Function
ElseIf iCheck = -1 Then
Beep
Call ShowBalloonTipEx(hWnd, "", "The file name you have entered is too long. The total length of the file name cannot exceed 260 characters.", TTI_NONE) ' TTI_ERROR)
Exit Function
End IfForm1
Code:
Option Explicit
Private Sub Form_Load()
Call Subclass(Text1.hWnd, AddressOf EditWndProc)
End SubCode:
Option Explicit
Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function SendMessageW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type EDITBALLOONTIP
cbStruct As Long
pszTitle As Long
pszText As Long
ttiIcon As BalloonTipIconConstants ' ; // From TTI_*
End Type
Private Enum BalloonTipIconConstants
TTI_NONE = 0
TTI_INFO = 1
TTI_WARNING = 2
TTI_ERROR = 3
End Enum
Private Const WM_CHAR = &H102
Private Const WM_PASTE = &H302
Private Const WM_DESTROY = &H2
Private Const WM_GETTEXTLENGTH = &HE
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SHOWBALLOONTIP As Long = (ECM_FIRST + 3)
Public Function Subclass(hWnd As Long, lpfn As Long) As Long
Subclass = SetWindowSubclass(hWnd, lpfn, 0)
End Function
Public Function UnSubclass(hWnd As Long, lpfn As Long) As Long
'Only needed if you want to stop the subclassing code and keep the program running.
'Otherwise, the WndProc function should call this on WM_DESTROY
UnSubclass = RemoveWindowSubclass(hWnd, lpfn, 0)
End Function
Public Function EditWndProc(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_CHAR
Dim lLen As Long
lLen = SendMessageW(hWnd, WM_GETTEXTLENGTH, 0, ByVal 0&) + 1
If lLen > 260 Then
Beep
wParam = 0
Call ShowBalloonTipEx(hWnd, "", "Maximum number of characters has been reached. The total length of the file name cannot exceed 260 characters.", TTI_NONE) ' TTI_ERROR)
Exit Function
End If
Select Case wParam
Case 47, 92, 60, 62, 58, 42, 124, 63, 34 'Illegal chars /\<>:*|?"
Beep
Call ShowBalloonTipEx(hWnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
wParam = 0
End Select
Case WM_PASTE
Dim iCheck As Integer
iCheck = IsClipboardValidFileName()
If iCheck = 0 Then
Beep
Call ShowBalloonTipEx(hWnd, "", "File names may not contain any of the following characters:" & vbCrLf & " / \ < > : ? * | " & Chr$(34), TTI_NONE) ' TTI_ERROR)
Exit Function
ElseIf iCheck = -1 Then
Beep
Call ShowBalloonTipEx(hWnd, "", "The file name you have entered is too long. The total length of the file name cannot exceed 260 characters.", TTI_NONE) ' TTI_ERROR)
Exit Function
End If
Case WM_DESTROY
Call UnSubclass(hWnd, PtrEditWndProc)
End Select
EditWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Private Function PtrEditWndProc() As Long
PtrEditWndProc = FARPROC(AddressOf EditWndProc)
End Function
Private Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
Private Sub ShowBalloonTipEx(hWnd As Long, sTitle As String, sText As String, btIcon As BalloonTipIconConstants)
Dim lR As Long
Dim tEBT As EDITBALLOONTIP
tEBT.cbStruct = LenB(tEBT)
tEBT.pszText = StrPtr(sText)
tEBT.pszTitle = StrPtr(sTitle)
tEBT.ttiIcon = btIcon
lR = SendMessageW(hWnd, EM_SHOWBALLOONTIP, 0, tEBT)
End Sub
Public Function IsClipboardValidFileName() As Integer
Dim i As Long
Dim sz As String
Dim sChr As String
'there's a couple scenarios for invalid file names i've trimmed out
'to keep this example as simple as possible, look into them if you're
'going to use this code in an actual rename procedure
sz = Clipboard.GetText
If Len(sz) > 260 Then
IsClipboardValidFileName = -1
Exit Function
End If
IsClipboardValidFileName = 1
If InStr(sz, "*") Or InStr(sz, "?") Or InStr(sz, "<") Or InStr(sz, ">") Or InStr(sz, "|") Or InStr(sz, Chr$(34)) Then
IsClipboardValidFileName = 0
End If
End Function