vb 让窗体与其他程序同时拥有输入焦点(像屏幕键盘那样)
2个回答
展开全部
不可能出现两个以上窗体同时拥有输入焦点的情况的。屏幕键盘那是因为本身是无焦点的窗体(这样的窗体有吗?当然有,用API函数创建一个WS_EX_NOACTIVATE风格的窗体即可,自己网上搜一搜即知),或者用这种折中的方法实现也可:点击前先记下前台窗口句柄及其拥有输入焦点的控件句柄,点击后立刻切换到该窗体并把焦点还给该控件。总之一句话,焦点只能有一个的。
另外,“永远不会失去焦点”就意味着其他软件“永远不会得到焦点”,这样其他软件就无法用鼠标键盘进行输入了,呵呵,如果真有这样的功能,做病毒和木马的人倒可一试。
另外,“永远不会失去焦点”就意味着其他软件“永远不会得到焦点”,这样其他软件就无法用鼠标键盘进行输入了,呵呵,如果真有这样的功能,做病毒和木马的人倒可一试。
展开全部
只能用钩子
其他不可能了
'比如说这个
Private Sub Form_Load()
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub
'在模块中
Option Explicit
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const WH_KEYBOARD = 2
Public Const WH_KEYBOARD_LL = 13
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const WM_SYSCHAR = &H106
Public Const WM_SYSCOMMAND = &H112
Public Type KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下:128 抬起:0
time As Long 'Window运行时间
End Type
Public keyMsg As KEYMSGS '键盘消息
Public hHook As Long '创建的钩子的句柄
Public Function CallKeyHookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
If idHook = HC_ACTION Then
CopyMemory keyMsg, lParam, LenB(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_SYSKEYUP, WM_KEYDOWN, WM_KEYUP '判断是否为键盘消息
lKey = keyMsg.sKey And &HFF '扫描码
lKey = lKey * 65536 '将扫描码左移16位,使位0~15置0
If keyMsg.flag = 0 Or keyMsg.flag = 32 Or keyMsg.flag = 128 Or keyMsg.sKey = 54 Then
strLen = GetKeyNameText(lKey, strKeyName, 250) '获取该按键的名称
Else
strLen = GetKeyNameText((lKey Or &H1000000), strKeyName, 250) '位24为增强型键盘上的扩展位
End If
Form1.Text1.Text = keyMsg.vKey
Form1.Text2.Text = Form1.Text2.Text & Left(strKeyName, strLen)
End Select
End If
CallKeyHookProc = CallNextHookEx(hHook, idHook, wParam, lParam) '呼叫下一个钩子
End Function
其他不可能了
'比如说这个
Private Sub Form_Load()
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf CallKeyHookProc, App.hInstance, 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook
End Sub
'在模块中
Option Explicit
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Const WH_KEYBOARD = 2
Public Const WH_KEYBOARD_LL = 13
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public Const WM_SYSCHAR = &H106
Public Const WM_SYSCOMMAND = &H112
Public Type KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下:128 抬起:0
time As Long 'Window运行时间
End Type
Public keyMsg As KEYMSGS '键盘消息
Public hHook As Long '创建的钩子的句柄
Public Function CallKeyHookProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
If idHook = HC_ACTION Then
CopyMemory keyMsg, lParam, LenB(keyMsg)
Select Case wParam
Case WM_SYSKEYDOWN, WM_SYSKEYUP, WM_KEYDOWN, WM_KEYUP '判断是否为键盘消息
lKey = keyMsg.sKey And &HFF '扫描码
lKey = lKey * 65536 '将扫描码左移16位,使位0~15置0
If keyMsg.flag = 0 Or keyMsg.flag = 32 Or keyMsg.flag = 128 Or keyMsg.sKey = 54 Then
strLen = GetKeyNameText(lKey, strKeyName, 250) '获取该按键的名称
Else
strLen = GetKeyNameText((lKey Or &H1000000), strKeyName, 250) '位24为增强型键盘上的扩展位
End If
Form1.Text1.Text = keyMsg.vKey
Form1.Text2.Text = Form1.Text2.Text & Left(strKeyName, strLen)
End Select
End If
CallKeyHookProc = CallNextHookEx(hHook, idHook, wParam, lParam) '呼叫下一个钩子
End Function
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |