vb怎么设置全局热键

vb怎么设置全局热键,第1张

我不知道你想要怎样的效果,应该是下面的效果吧
我弄过的,可以的
Private
Declare
Function
GetKeyState
Lib
"user32"
(ByVal
nVirtKey
As
Long)
As
Integer
Dim
key1
As
Integer
Const
keycode1
As
Integer
=
121
Private
Sub
Form_Load()
key1
=
GetKeyState(keycode1)
Timer1Interval
=
10
Timer1Enabled
=
True
MeVisible
=
False
End
Sub
Private
Sub
Timer1_Timer()
If
GetKeyState(keycode1)
<>
key1
Then
MsgBox
"你按下了热键"
key1
=
GetKeyState(keycode1)
End
If
End
Sub
你要按F10的,就会看到效果啦

主窗体代码如下:
Option Explicit
'程序启动时注册功能热键F12
Private Sub Form_Load()
Dim Modifiers As Long
preWinProc = GetWindowLong(MehWnd, GWL_WNDPROC)
SetWindowLong MehWnd, GWL_WNDPROC, AddressOf WndProc
uVirtKey = vbKeyDelete
RegisterHotKey MehWnd, 1, Modifiers, uVirtKey
End Sub
'当程序被关闭时,取消已经注册的热键
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong MehWnd, GWL_WNDPROC, preWinProc
UnregisterHotKey MehWnd, uVirtKey '取消系统级热键,释放资源
End '终止程序运行
End Sub

添加一个标准模块,代码如下
Option Explicit
'在窗口结构中为指定的窗口设置信息
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'从指定窗口的结构中取得信息
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'运行指定的进程
Public 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
'向系统注册一个指定的热键
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
'取消热键并释放占用的资源
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long) As Long
'上述五个API函数是注册系统级热键所必需的,具体实现过程如后文所示
'热键标志常数,用来判断当键盘按键被按下时是否命中了我们设定的热键
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)
'定义系统的热键,原中断标示,被隐藏的项目句柄
Public preWinProc As Long, MyhWnd As Long, uVirtKey As Long
'热键拦截过程
Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then '如果拦截到热键标志常数
If wParam = 1 Then '如果是我们的定义的热键
HideDone '执行隐藏鼠标所指项目
End If
End If
'如果不是热键,或者不是我们设置的热键,交还控制权给系统,继续监测热键
WndProc = CallWindowProc(preWinProc, hWnd, Msg, wParam, lParam)
End Function
'最关键的项目隐藏过程
Public Sub HideDone()
MsgBox "按下了Delete键"
End Sub

不清楚热键和快捷键是什么区别
1如果你是指Chrl+S这样的快捷键,可以设置ShortCutKeys属性,属性窗口就有可视化编辑器。
2如果你是指"保存(S)",其中s有下划线这样的用Alt+字母来访问的设置,应该在菜单项的Text属性中使用&符号。&符号后面的字母将被作为快速访问字符,显示的时候&不会被显示出来,而字母会自动加上下划线。比如"保存(&s)"。
3和选中标记有关的属性有两个
CheckOnClick 在菜单项上单击时是否改变Checked属性
Checked 设置/获取 菜单项是否被选中
4设置菜单项的Enabled属性为False

一楼的方法比较巧妙,不过楼上的好像不行
最完善的方法当然做键盘勾子
简单点的,就在Form的KeyDown属性里做就OK了
也要把窗口的keypreview设为True,然后粘贴下面的代码:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
if keycode=vbkeyf3 then check1value=check1value xor 1
End Sub
就一句

用全局热键
运行后程序自动隐藏,按快捷键自动出现
'第一步:
'新建一个窗口,将以下代码复制进去
注册热键为:'Ctrl+Alt+P
Private
Sub
Form_Load()
form1hide
Dim
ret
As
Long
preWinProc
=
GetWindowLong(Mehwnd,
GWL_WNDPROC)
ret
=
SetWindowLong(Mehwnd,
GWL_WNDPROC,
AddressOf
Wndproc)
idHotKey
=
1
Modifiers
=
MOD_Alt
+
MOD_Ctrl
uVirtKey
=
vbKeyP
ret
=
RegisterHotKey(Mehwnd,
idHotKey,
Modifiers,
uVirtKey)
End
Sub
Private
Sub
Form_Unload(Cancel
As
Integer)
Dim
ret
As
Long
ret
=
SetWindowLong(Mehwnd,
GWL_WNDPROC,
preWinProc)
Call
UnregisterHotKey(Mehwnd,
uVirtKey)
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
MOD_Alt
=
&H1
Public
Const
MOD_Ctrl
=
&H2
Public
Const
MOD_Shift
=
&H4
Public
Const
GWL_WNDPROC
=
(-4)
Public
preWinProc
As
Long
Public
Modifiers
As
Long,
uVirtKey
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
If
Msg
=
WM_HOTKEY
Then
If
wParam
=
idHotKey
Then
Dim
lp
As
taLong,
i2
As
t2Int
lpll
=
lParam
LSet
i2
=
lp
If
(i2lWord
=
Modifiers)
And
i2hWord
=
uVirtKey
Then
form1show
End
If
End
If
End
If
Wndproc
=
CallWindowProc(preWinProc,
hwnd,
Msg,
wParam,
lParam)
End
Function

你这个功能其实就是很多影音播放器的老板键功能,给你一段代码参考一下,看看有没有帮助
'---------------------------------------------------------------------------------------
' Author 
' Purpose :vb实现老板键的简单功能
'---------------------------------------------------------------------------------------

Sub Form_Load() Sub Form_Load()
Dim ret As Long
preWinProc = GetWindowLong(Mehwnd, GWL_WNDPROC)
ret = SetWindowLong(Mehwnd, GWL_WNDPROC, AddressOf Wndproc)
idHotKey = 1
'按住ctrl+q实现切换
Modifiers = MOD_CONTROL
uVirtKey = vbKeyQ
ret = ReGISterHotKey(Mehwnd, idHotKey, Modifiers, uVirtKey)
'最小花到托盘
TrayAddIcon frmmain, AppPath & "PBsico", "系统托盘"
End Sub

Sub Form_Unload() Sub Form_Unload(Cancel As Integer)
Dim ret As Long
ret = SetWindowLong(Mehwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Mehwnd, uVirtKey)
'退出时移出托盘图标
TrayRemoveIcon
End Sub

Sub Form_Resize() Sub Form_Resize()

'窗口最小化
If MeWindowstate = vbMinimized Then MeHide

End Sub

Sub Form_MouseMove() Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

'气泡单击时的鼠标事件
Dim Result As Long
Dim cEvent As Single
cEvent = X / ScreenTwipsPERPixelX

Select Case cEvent

Case MouseMove
TrayBalloon frmmain, "一键隐藏程序 v01 By 阿汐", NIIF_INFO
Case LeftUp

Case LeftDown
frmmainWindowstate = 0
frmmainShow
Case LeftDbClick

Case MiddleUp

Case MiddleDown

Case MiddleDbClick

Case RightUp

Case RightDown

Case RightDbClick

Case BalloonClick

End Select

End Sub

Sub Label1_Click() Sub Label1_Click()

End Sub

Sub Label2_Click() Sub Label2_Click()

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/yw/12995245.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-29
下一篇 2023-05-29

发表评论

登录后才能评论

评论列表(0条)

保存