Const WM_SYSCOMMAND = &H112
Const SC_SIZE = &HF000&
’ 检查是否是WM_SYSCOMMAND消息
If msg = WM_SYSCOMMAND Then
’ 如果收到的消息是WM_SYSCOMMAND ,进一步检查命令参数是否是SC_SIZE, 如果是就忽略它,不进行任何处理。
If (wParam And &HFFF0) = SC_SIZE Then Exit Function
End If
’*其余的消息传递给源窗口过程函数*非常重要
NewWindowProc = CallWindowProc( _
OldWindowProc, hwnd, msg, wParam, _
lParam)
End Function
上面的过程函数首先检查收到的消息是否是WM_SYSCOMMAND消息,如果是,那么再进一步检查参数(wParam)是否是SC_SIZE命令。如果是表示窗体想要调整大小。但是我们自定义的窗口过程函数已经对它进行了处理,因此这个消息将不会被传递到源窗口过程函数。而我们自定义的这个窗口过程没有处理的消息将全部进一步传递给源窗口过程函数(它的地址保存在OldWindowProc中)。
需要注意的是,当我们卸载我们子类的对象前,我们必须恢复它的窗口过程函数。
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub
因为我们卸载一个窗口对象,系统会发送WM_NCDESTROY消息给对象,因此我们可以通过检测这个消息来自动恢复对象的源窗口过程。
Public Function NewWindowProc( ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, lParam As WINDOWPOS) As Long
Const WM_NCDESTROY = &H82
Const WM_SYSCOMMAND = &H112
Const SC_SIZE = &HF000&
’ 如果组件被销毁,恢复源窗口过程处理函数
If msg = WM_NCDESTROY Then
SetWindowLong hwnd, GWL_WNDPROC,OldWindowProc
End If
If msg = WM_SYSCOMMAND Then
If (wParam And &HFFF0) = SC_SIZE Then Exit Function
End If
NewWindowProc = CallWindowProc( _
OldWindowProc, hwnd, msg, wParam, _
lParam)
End Function
需要注意的一点是,这种方式很容易造成VB IDE的崩溃。不要在调试模式中途暂停或终于应用程序,因为这样可能不能恢复源窗口过程函数,造成无法处理正常的消息,变得异常或IDE崩溃,因此切记调试前一定存盘。
除了使用子类的方法,我没还可以使用几个API函数向对象主动发消息。我们可以用SendMessage和PostMessage:
PostMessage将消息直接加入到应用程序的消息队列中,不等程序返回就退出;而SendMessage()则刚好相反,应用程序处理完此消息后,它才返回,可以参考下图:
下面就对具体实际应用举几个例子:
TextBox控件:
a. 控制Textbox输入格式,我想大多人都遇到这个问题,在TextBox作为输入接口时,有时我们希望用户只能输入数字、大写、字母等,一般的做法是对用户输入的字符这个检查。但是如果我们使用API,将很容易实现这些功能,比如:
? 只允许输入数字:
Public Function NumbersOnly(tBox As TextBox)
Dim DefaultStyle As Long
DefaultStyle = GetWindowLong(tBox.hwnd, GWL_STYLE)
NumbersOnly = SetWindowLong(tBox.hwnd, GWL_STYLE, DefaultStyle Or ES_NUMBER)
End Function
? 只允许大写:
Public Function UpperCaseOnly(tBox As TextBox)
Dim DefaultStyle As Long
DefaultStyle = GetWindowLong(tBox.hwnd, GWL_STYLE)
UpperCaseOnly = SetWindowLong(tBox.hwnd, GWL_STYLE, DefaultStyle Or ES_UPPERCASE)
End Function
? 只允许小写:
Public Function LowerCaseOnly(tBox As TextBox)
Dim DefaultStyle As Long
DefaultStyle = GetWindowLong(tBox.hwnd, GWL_STYLE)
LowerCaseOnly = SetWindowLong(tBox.hwnd, GWL_STYLE, DefaultStyle Or ES_LOWERCASE)
End Function
当然上边三个函数可以合成一