VB全局快捷键问题
问下全局的快捷键就是无论任何情况下按F10就等于按了程序某个按钮的功能还有一键呼出功能如何实现...
问下全局的快捷键
就是无论任何情况下按F10
就等于按了程序某个按钮的功能
还有一键呼出功能如何实现 展开
就是无论任何情况下按F10
就等于按了程序某个按钮的功能
还有一键呼出功能如何实现 展开
6个回答
展开全部
v
呵呵
楼上俩位的,你们那个太占资源了,只有在没有办法的情况下才使用你们这个办法....
使用timer....如果使用这个功能,cup占用可不是一般的多阿~是非常多~
给你这个代码,只有在按下键盘的时候才会激发~不占资源~~
'模块
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private lngHook As Long
Public Function HotKey(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim p As PKBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN
Call CopyMemory(p, ByVal lParam, Len(p))
If p.vkCode = vbKeyF10 Then '这里定义热键
MsgBox "你按下了F10" '这里,执行你要执行的程序,我这里示范msgbox
End If
Case Else
End Select
End If
Call CallNextHookEx(WH_KEYBOARD_LL, nCode, wParam, lParam)
End Function
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HotKey, App.hInstance, 0)
End Sub
Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook)
End Sub
'窗体
Private Sub Form_Load()
HooK
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHooK
End Sub
呵呵
楼上俩位的,你们那个太占资源了,只有在没有办法的情况下才使用你们这个办法....
使用timer....如果使用这个功能,cup占用可不是一般的多阿~是非常多~
给你这个代码,只有在按下键盘的时候才会激发~不占资源~~
'模块
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private lngHook As Long
Public Function HotKey(ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim p As PKBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN
Call CopyMemory(p, ByVal lParam, Len(p))
If p.vkCode = vbKeyF10 Then '这里定义热键
MsgBox "你按下了F10" '这里,执行你要执行的程序,我这里示范msgbox
End If
Case Else
End Select
End If
Call CallNextHookEx(WH_KEYBOARD_LL, nCode, wParam, lParam)
End Function
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf HotKey, App.hInstance, 0)
End Sub
Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook)
End Sub
'窗体
Private Sub Form_Load()
HooK
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHooK
End Sub
展开全部
v
其实很简单的
~~~~只要不注册辅助键就可以了~~修改了~~
'模块
Option
Explicit
Declare
Function
SetWindowLong
Lib
"user32"
Alias
"SetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long,
ByVal
dwNewLong
As
Long)
As
Long
Declare
Function
GetWindowLong
Lib
"user32"
Alias
"GetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long)
As
Long
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
Declare
Function
RegisterHotKey
Lib
"user32"
(ByVal
hwnd
As
Long,
ByVal
id
As
Long,
ByVal
fsModifiers
As
Long,
ByVal
vk
As
Long)
As
Long
Declare
Function
UnregisterHotKey
Lib
"user32"
(ByVal
hwnd
As
Long,
ByVal
id
As
Long)
As
Long
Public
Const
WM_HOTKEY
=
&H312
Public
Const
GWL_WNDPROC
=
(-4)
Public
preWinProc
As
Long
Public
Modifiers
As
Long,
uVirtKey1
As
Long,
idHotKey
As
Long
Private
Type
taLong
ll
As
Long
End
Type
Private
Type
t2Int
lWord
As
Integer
hword
As
Integer
End
Type
Public
Function
wndproc(ByVal
hwnd
As
Long,
ByVal
Msg
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
Dim
lp
As
taLong,
i2
As
t2Int
If
Msg
=
WM_HOTKEY
Then
If
wParam
=
idHotKey
Then
lp.ll
=
lParam
LSet
i2
=
lp
If
(i2.lWord
=
Modifiers)
And
i2.hword
=
uVirtKey1
Then
'------------------------------------------------------
'这里面是快捷键代码,你可以随便改
If
Form1.Check100.Value
=
1
Then
Form1.Check100.Value
=
0
Else
Form1.Check100.Value
=
1
End
If
'------------------------------------------------------
End
If
End
If
End
If
'如果不是热键信息则调用原来的程序
wndproc
=
CallWindowProc(preWinProc,
hwnd,
Msg,
wParam,
lParam)
End
Function
'窗体
Option
Explicit
Private
Sub
Form_Load()
Dim
ret
As
Long
'记录原来的window程序地址
preWinProc
=
GetWindowLong(Me.hwnd,
GWL_WNDPROC)
'用自定义程序代替原来的window程序
ret
=
SetWindowLong(Me.hwnd,
GWL_WNDPROC,
AddressOf
wndproc)
idHotKey
=
1
'in
the
range
&h0000
through
&hBFFF
uVirtKey1
=
vbKey1
'注册的热键为Alt+1
'注册热键
ret
=
RegisterHotKey(Me.hwnd,
idHotKey,
Modifiers,
uVirtKey1)
If
ret
=
0
Then
MsgBox
"注册热键失败,请使用其它热键!",
vbCritical,
"错误"
End
If
End
Sub
Private
Sub
Form_QueryUnload(Cancel
As
Integer,
UnloadMode
As
Integer)
Dim
ret
As
Long
'取消Message的截取,使之送往原来的window程序
ret
=
SetWindowLong(Me.hwnd,
GWL_WNDPROC,
preWinProc)
Call
UnregisterHotKey(Me.hwnd,
uVirtKey1)
End
Sub
其实很简单的
~~~~只要不注册辅助键就可以了~~修改了~~
'模块
Option
Explicit
Declare
Function
SetWindowLong
Lib
"user32"
Alias
"SetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long,
ByVal
dwNewLong
As
Long)
As
Long
Declare
Function
GetWindowLong
Lib
"user32"
Alias
"GetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long)
As
Long
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
Declare
Function
RegisterHotKey
Lib
"user32"
(ByVal
hwnd
As
Long,
ByVal
id
As
Long,
ByVal
fsModifiers
As
Long,
ByVal
vk
As
Long)
As
Long
Declare
Function
UnregisterHotKey
Lib
"user32"
(ByVal
hwnd
As
Long,
ByVal
id
As
Long)
As
Long
Public
Const
WM_HOTKEY
=
&H312
Public
Const
GWL_WNDPROC
=
(-4)
Public
preWinProc
As
Long
Public
Modifiers
As
Long,
uVirtKey1
As
Long,
idHotKey
As
Long
Private
Type
taLong
ll
As
Long
End
Type
Private
Type
t2Int
lWord
As
Integer
hword
As
Integer
End
Type
Public
Function
wndproc(ByVal
hwnd
As
Long,
ByVal
Msg
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
Dim
lp
As
taLong,
i2
As
t2Int
If
Msg
=
WM_HOTKEY
Then
If
wParam
=
idHotKey
Then
lp.ll
=
lParam
LSet
i2
=
lp
If
(i2.lWord
=
Modifiers)
And
i2.hword
=
uVirtKey1
Then
'------------------------------------------------------
'这里面是快捷键代码,你可以随便改
If
Form1.Check100.Value
=
1
Then
Form1.Check100.Value
=
0
Else
Form1.Check100.Value
=
1
End
If
'------------------------------------------------------
End
If
End
If
End
If
'如果不是热键信息则调用原来的程序
wndproc
=
CallWindowProc(preWinProc,
hwnd,
Msg,
wParam,
lParam)
End
Function
'窗体
Option
Explicit
Private
Sub
Form_Load()
Dim
ret
As
Long
'记录原来的window程序地址
preWinProc
=
GetWindowLong(Me.hwnd,
GWL_WNDPROC)
'用自定义程序代替原来的window程序
ret
=
SetWindowLong(Me.hwnd,
GWL_WNDPROC,
AddressOf
wndproc)
idHotKey
=
1
'in
the
range
&h0000
through
&hBFFF
uVirtKey1
=
vbKey1
'注册的热键为Alt+1
'注册热键
ret
=
RegisterHotKey(Me.hwnd,
idHotKey,
Modifiers,
uVirtKey1)
If
ret
=
0
Then
MsgBox
"注册热键失败,请使用其它热键!",
vbCritical,
"错误"
End
If
End
Sub
Private
Sub
Form_QueryUnload(Cancel
As
Integer,
UnloadMode
As
Integer)
Dim
ret
As
Long
'取消Message的截取,使之送往原来的window程序
ret
=
SetWindowLong(Me.hwnd,
GWL_WNDPROC,
preWinProc)
Call
UnregisterHotKey(Me.hwnd,
uVirtKey1)
End
Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
需要一个模块,一个窗体。
==========Module1.Bas=========
Option Explicit
Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public hHook&, i%, appStr$, SBUF$, pos1$(), pos2$()
Const KBH_MASK = &H20000000
Sub ints()
appStr = "从" & Now & "开始键盘记录如下..." & vbCrLf
SBUF = "96_0|97_1|98_2|99_3|100_4|101_5|102_6|103_7|104_8|105_9|106_*|107_+|109_-|110_.|111_/|13_Enter|144_NumLock|65_A|66_B|67_C|68_D|69_E|70_F|71_G|72_H|73_I|74_J|75_K|76_L|77_M|78_N|79_O|80_P|81_Q|82_R|83_S|84_T|85_U|86_V|87_W|88_X|89_Y|90_Z48_0|49_1|50_2|51_3|52_4|53_5|54_6|55_7|56_8|57_9|192_`|189_-|187_=|220_\|8_BACKSpace|44_Print|45_InSert|46_Delete|145_ScrollLock|36_Home|35_End|19_PauseBreak|33_PageDown|34_PageUp|38_上|40_下|37_左|39_右|27_Esc|112_F1|113_F2|114_F3|115_F4|116_F5|117_F6|118_F7|119_F8|120_F9|121_F10|122_F11|123_F12|9_TAB|20_CapsLock|160_左Shift|162_左Ctrl|91_左Win|13_右Enter|161_右Shift|92_右Win|93_右List|163_右Ctrl"
pos1 = Split(SBUF, "|"): ReDim pos2$(256)
For i = 0 To UBound(pos1) - 1
pos2(Val(pos1(i))) = Mid(pos1(i), InStr(1, pos1(i), "_") + 1)
Next
End Sub
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_KEYDOWN Then
CopyMemory mymsg, ByVal lParam, Len(mymsg)
If pos2(mymsg.vKey) = "F10" Then
Form1.SetFocus
MsgBox "你按下F10了。"
MyKBHook = 1
Exit Function
End If
End If
End If
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
=========Form1.Frm========
Option Explicit
Private Sub form_Load()
KeyPreview = 1: ScaleMode = 3: AutoRedraw = 1
Module1.ints
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
==========Module1.Bas=========
Option Explicit
Public Type EVENTMSG
vKey As Long
sKey As Long
flag As Long
time As Long
End Type
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
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
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public mymsg As EVENTMSG
Public Const WH_KEYBOARD_LL = 13
Public Const WM_KEYDOWN = &H100
Public hHook&, i%, appStr$, SBUF$, pos1$(), pos2$()
Const KBH_MASK = &H20000000
Sub ints()
appStr = "从" & Now & "开始键盘记录如下..." & vbCrLf
SBUF = "96_0|97_1|98_2|99_3|100_4|101_5|102_6|103_7|104_8|105_9|106_*|107_+|109_-|110_.|111_/|13_Enter|144_NumLock|65_A|66_B|67_C|68_D|69_E|70_F|71_G|72_H|73_I|74_J|75_K|76_L|77_M|78_N|79_O|80_P|81_Q|82_R|83_S|84_T|85_U|86_V|87_W|88_X|89_Y|90_Z48_0|49_1|50_2|51_3|52_4|53_5|54_6|55_7|56_8|57_9|192_`|189_-|187_=|220_\|8_BACKSpace|44_Print|45_InSert|46_Delete|145_ScrollLock|36_Home|35_End|19_PauseBreak|33_PageDown|34_PageUp|38_上|40_下|37_左|39_右|27_Esc|112_F1|113_F2|114_F3|115_F4|116_F5|117_F6|118_F7|119_F8|120_F9|121_F10|122_F11|123_F12|9_TAB|20_CapsLock|160_左Shift|162_左Ctrl|91_左Win|13_右Enter|161_右Shift|92_右Win|93_右List|163_右Ctrl"
pos1 = Split(SBUF, "|"): ReDim pos2$(256)
For i = 0 To UBound(pos1) - 1
pos2(Val(pos1(i))) = Mid(pos1(i), InStr(1, pos1(i), "_") + 1)
Next
End Sub
Public Function MyKBHook(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If ncode = 0 Then
If wParam = WM_KEYDOWN Then
CopyMemory mymsg, ByVal lParam, Len(mymsg)
If pos2(mymsg.vKey) = "F10" Then
Form1.SetFocus
MsgBox "你按下F10了。"
MyKBHook = 1
Exit Function
End If
End If
End If
MyKBHook = CallNextHookEx(hHook, ncode, wParam, lParam)
End Function
=========Form1.Frm========
Option Explicit
Private Sub form_Load()
KeyPreview = 1: ScaleMode = 3: AutoRedraw = 1
Module1.ints
hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf MyKBHook, App.hInstance, 0)
If hHook = 0 Then End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbkeyf10) < 0 Then XXX_click()
if .....其他键的... 呼出功能就是 form.show...其他自己发挥想象把..
End Sub
timer1.Interval = 1-100最好..不然会有点迟钝的..
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbkeyf10) < 0 Then XXX_click()
if .....其他键的... 呼出功能就是 form.show...其他自己发挥想象把..
End Sub
timer1.Interval = 1-100最好..不然会有点迟钝的..
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
请先定义一个模块,在模块中可以用Global完成你所说的全局快捷键。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询