Dim blnControl As BooleanPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim lngCtrlDown&
lngCtrlDown = (Shift And vbCtrlMask) > 0 If lngCtrlDown Then blnControl = True End If End SubPrivate Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) blnControl = False End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If blnControl Then Label1.Caption = "X:" & X & " Y: " & Y End If End Sub
calss1: Option Explicit Public Type ProcData AppHwnd As Long title As String Placement As String Left As Long Top As Long Right As Long Bottom As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type POINTAPI X As Long Y As Long End Type Public Const WM_GETTEXT = &HD Public Const WM_GETTEXTLENGTH = &HE Public Const WM_SETTEXT = &HC Public Const MOUSEEVENTF_LEFTDOWN = &H2 Public Const MOUSEEVENTF_LEFTUP = &H4 Public Const GW_CHILD = 5 Public Const GW_HWNDNEXT = 2 Public Const GW_HWNDFIRST = 0 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function GetForegroundWindow& Lib "user32" () Public Declare Function SetCursorPos& Lib "user32" (ByVal X As Long, ByVal Y As Long) Public Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI) Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
form1: Option Explicit Dim i As Integer Private Sub Command1_Click() MsgBox "ddd"End SubPrivate Sub Command2_Click() Dim dl& Dim NewPoint As POINTAPI Dim myrect As RECT Dim i As Integer dl& = GetWindowRect(Command1.hwnd, myrect) 'dl& = GetCursorPos(OldPoint) '获取当前鼠标位置 NewPoint.X = myrect.Left + (myrect.Right - myrect.Left) \ 2 NewPoint.Y = myrect.Top + (myrect.Bottom - myrect.Top) \ 2 SetCursorPos NewPoint.X, NewPoint.Y mouse_event MOUSEEVENTF_LEFTDOWN, NewPoint.X, NewPoint.Y, 0, 0 For i = 0 To 10 '延时 Sleep 20 DoEvents Next mouse_event MOUSEEVENTF_LEFTUP, NewPoint.X, NewPoint.Y, 0, 0 End Sub
.Moudle Option ExplicitDeclare 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 LongPublic Const WM_HOTKEY = &H312 Public Const MOD_ALT = &H1 Public Const MOD_CONTROL = &H2 Public Const MOD_SHIFT = &H4 Public Const GWL_WNDPROC = (-4) Public Const BM_CLICK = &HF5 Public preWinProc As Long Public Modifiers As Long, uVirtKey As Long, idHotKey As LongPrivate Type taLong ll As Long End TypePrivate Type t2Int lWord As Integer hWord As Integer End Type Public iii As Long Public hWndlong 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 = idHotKey Then Dim lp As taLong, i2 As t2Int lp.ll = lParam LSet i2 = lp If (i2.lWord = Modifiers) And i2.hWord = uVirtKey Then '*你想做的事 End If End If End If Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
.Form1 Private Sub Form_Load() Dim ret As Long preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC) ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)
idHotKey = 1 Modifiers = MOD_CONTROL uVirtKey = 0& ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey) End SubPrivate Sub Form_Unload(Cancel As Integer) Dim ret As Long ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc) Call UnregisterHotKey(Me.hwnd, uVirtKey) End Sub
TO:pigpag(噼里啪啦 - 阿弥陀佛,祝福各位同仁高考成绩美丽) 大概是这样的 Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerFunction XX(DG) XX = (GetAsyncKeyState(DG) < 0) End FunctionPrivate Sub Timer2_Timer() If XX(vbKeyEscape) Then 'End****** End If If XX(vbKeyTab) Then '******* End If End Sub
Dim lngCtrlDown&
lngCtrlDown = (Shift And vbCtrlMask) > 0
If lngCtrlDown Then
blnControl = True
End If
End SubPrivate Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
blnControl = False
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If blnControl Then
Label1.Caption = "X:" & X & " Y: " & Y
End If
End Sub
关键是按你要求还需要定义全局热键,我不知道可不可以把单独一个Ctrl键定义成全局热键
用过的一些奇迹外挂都是ctrl+F12的.呵呵
Option Explicit
Public Type ProcData
AppHwnd As Long
title As String
Placement As String
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_SETTEXT = &HC
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDFIRST = 0
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetForegroundWindow& Lib "user32" ()
Public Declare Function SetCursorPos& Lib "user32" (ByVal X As Long, ByVal Y As Long)
Public Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
form1:
Option Explicit
Dim i As Integer
Private Sub Command1_Click()
MsgBox "ddd"End SubPrivate Sub Command2_Click()
Dim dl&
Dim NewPoint As POINTAPI
Dim myrect As RECT
Dim i As Integer
dl& = GetWindowRect(Command1.hwnd, myrect)
'dl& = GetCursorPos(OldPoint) '获取当前鼠标位置
NewPoint.X = myrect.Left + (myrect.Right - myrect.Left) \ 2
NewPoint.Y = myrect.Top + (myrect.Bottom - myrect.Top) \ 2
SetCursorPos NewPoint.X, NewPoint.Y
mouse_event MOUSEEVENTF_LEFTDOWN, NewPoint.X, NewPoint.Y, 0, 0
For i = 0 To 10 '延时
Sleep 20
DoEvents
Next
mouse_event MOUSEEVENTF_LEFTUP, NewPoint.X, NewPoint.Y, 0, 0
End Sub
Option ExplicitDeclare 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 LongPublic Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const GWL_WNDPROC = (-4)
Public Const BM_CLICK = &HF5
Public preWinProc As Long
Public Modifiers As Long, uVirtKey As Long, idHotKey As LongPrivate Type taLong
ll As Long
End TypePrivate Type t2Int
lWord As Integer
hWord As Integer
End Type
Public iii As Long
Public hWndlong 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 = idHotKey Then
Dim lp As taLong, i2 As t2Int
lp.ll = lParam
LSet i2 = lp
If (i2.lWord = Modifiers) And i2.hWord = uVirtKey Then
'*你想做的事
End If
End If
End If
Wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
Private Sub Form_Load()
Dim ret As Long
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Wndproc)
idHotKey = 1
Modifiers = MOD_CONTROL
uVirtKey = 0&
ret = RegisterHotKey(Me.hwnd, idHotKey, Modifiers, uVirtKey)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim ret As Long
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKey)
End Sub
大概是这样的
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerFunction XX(DG)
XX = (GetAsyncKeyState(DG) < 0)
End FunctionPrivate Sub Timer2_Timer()
If XX(vbKeyEscape) Then
'End******
End If
If XX(vbKeyTab) Then
'*******
End If
End Sub