楼主
amulee |
学习API过程中的一个示例。
对InputBox中的文本输入框进行子类化以拦截输入的信息，并同步显示在单元格中。
其实原理很简单，代码如下：
- Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
- Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal Hwnd1 As Long, ByVal Hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) 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
- Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
- Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
- Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 Const WM_DESTROY = &H2
- Private Const GWL_WNDPROC = (-4)
- Private Const WM_CHAR = &H102
- Dim TimerID As Long 'Timer ID
- Private Const InputBoxTitle = "示例" '输入对话框标题
- Private lpPrevWndProc As Long '存放原窗口函数句柄
- '对InputBox中的文本框进行子类化
- Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
- Dim Hwnd1 As Long, Hwnd2 As Long
- '输入密码的对话框句柄
- Hwnd1 = FindWindow(vbNullString, InputBoxTitle)
- If Hwnd1 <> 0 Then '若对话框存在
- '获得文本框的句柄
- Hwnd2 = FindWindowEx(Hwnd1, 0, "Edit", vbNullString)
- '子类化
- lpPrevWndProc = SetWindowLong(Hwnd2, GWL_WNDPROC, AddressOf txtWindowProc)
- '关闭定时器
- timeKillEvent TimerID
- End If
- End Sub
- '自己的窗口函数，拦截消息
- Public Function txtWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
- ByVal wParam As Long, ByVal lParam As Long) As Long
- Dim Temp As Long
- If uMsg = WM_CHAR Then Range("A1") = Range("A1") & Chr(wParam)
- '当窗口关闭时，取消子类化
- If uMsg = WM_DESTROY Then
- Temp = SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
- End If
- '调用原窗口函数,由原窗口函数处理Windows消息
- txtWindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
- End Function
- '自定义MyInputBox函数
- Function MyInputBox(Prompt As String, Title As String)
- TimerID = timeSetEvent(10, 50, AddressOf TimeProc, 1, 1)
- pswdInputBox = InputBox(Prompt:=Prompt, Title:=Title)
- End Function
- Sub Main()
- Dim aa
- Range("A1").ClearContents
- aa = MyInputBox("OK", InputBoxTitle)
- End Sub
 单元格与InputBox同步显示.rar
|