获取其他应用程序窗口坐标(含句柄、系统热键)并复制坐标到剪贴板
又是我这个新手,下面分享一个--------------------------------华丽的分割线------------------------------------------------------------'模块代码:
Option Explicit
Dim zb As POINTAPI
Dim hwind As Long
Dim id As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'获取鼠标当前坐标,返回POINTAPI
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'获取坐标处的窗口句柄
Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
'获取窗口内坐标
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
'创建时钟
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
'关闭时钟
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
'取消热键并释放占用的资源
Public Type POINTAPI '自定义x,y
x As Long
y As Long
End Type
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 '如果是我们的定义的热键...
Form1.热键 '执行隐藏鼠标所指项目
End If
End If '如果不是热键,或者不是我们设置的热键,交还控制权给系统,继续监测热键
WndProc = CallWindowProc(preWinProc, hWnd, Msg, wParam, lParam)
End Function '最关键的项目隐藏过程
Public Sub 注册热键()
Dim Modifiers As Long
preWinProc = GetWindowLong(Form1.hWnd, GWL_WNDPROC)
SetWindowLong Form1.hWnd, GWL_WNDPROC, AddressOf WndProc
uVirtKey = vbKeyF1 '设置热键
RegisterHotKey Form1.hWnd, 1, Modifiers, uVirtKey
End Sub
Public Sub 卸载热键()
SetWindowLong Form1.hWnd, GWL_WNDPROC, preWinProc
UnregisterHotKey Form1.hWnd, uVirtKey '取消系统级热键,释放资源
End Sub
Public Sub 窗口坐标()
GetCursorPos zb
hwind = WindowFromPoint(zb.x, zb.y)
ScreenToClient hwind, zb
Form1.Caption = Str(zb.x) + "," + Str(zb.y)
End Sub
Sub Timer()
id = SetTimer(0, 0, 200, AddressOf 窗口坐标)
End Sub
Sub unTimer()
KillTimer 0, id
End Sub
--------------------------------华丽的分割线------------------------------------------------------------
'窗口代码:
Private Sub Form_Load()
Call 注册热键
Call Timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call 卸载热键
Call unTimer
End Sub
Sub 热键()
Clipboard.Clear
Clipboard.SetText Form1.Caption
End Sub
'按F1键试一下
'设置热键是在上面模块的子程序注册热键中
'热键执行的内容在上面模块中的 “窗体的子程序或代码”修改