Option Explicit
'
' Win32 API Declarations
'
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
'
' Win32 API Structures
'
Private Type POINTAPI
x As Long
y As Long
End Type
'
' Form-level member variables
'
Private m_hWnd As Long
Private m_Picking As Boolean
Private Sub Command1_Click()
'
' Attempt to paste something into
' selected window.
'
If m_hWnd Then
Clipboard.Clear
Clipboard.SetText Text1.Text, vbCFText
Call SetForegroundWindow(m_hWnd)
SendKeys "^v", True
End If
End Sub
Private Sub Form_Load()
'
' Assign dragging pointer
'
Picture1.Picture = Picture1.DragIcon
Me.MouseIcon = Picture1.DragIcon
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' Clear picture and turn on dragging mousepointer.
'
Me.MousePointer = vbCustom
Set Picture1.Picture = Nothing
'
' Remember that we're currently picking a window.
'
m_Picking = True
'
' Capture all mousemovements from this point until
' the user releases the mouse button.
'
Call SetCapture(Picture1.hwnd)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Static pt As POINTAPI
Static hwnd As Long
'
' If user is picking a window, check window is
' under the cursor whenever it moves. If it's
' a different window than previously, update the
' display to that effect.
'
If m_Picking Then
Call GetCursorPos(pt)
hwnd = WindowFromPointXY(pt.x, pt.y)
If hwnd <> m_hWnd Then
m_hWnd = hwnd
Me.Caption = "窗口或控件的句柄:" + Hex(m_hWnd)
End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' We're done picking now
'
m_Picking = False
'
' Restore dragging icon to picture box,
' and return mousepointer to normal.
'
Picture1.Picture = Picture1.DragIcon
Me.MousePointer = vbDefault
'
' Don't need to be notified anymore.
'
Call ReleaseCapture
'
' The chosen window is already stored in m_hWnd!
'
MsgBox "你选择的窗口或控件句柄是: " & vbCrLf & " " & Hex(m_hWnd) _
& vbCrLf & vbCrLf & "请按“发送文本”按钮发送!", vbInformation
End Sub