http://social.msdn.microsoft.com/Forums/en-US/Vsexpressvb/thread/d4d99ad3-4cb2-423d-9f9d-18df47c7d164
Co wraz z innym postem pozwalającym na monitorowanie pozycji kursora i wyświetlanie jej w opisie okna dało taki rezultat:
Imports System.Runtime.InteropServices
Public Class Form1
Private Shared Function SendInput( _
ByVal cInputs As Integer, _
ByVal pInputs() As INPUT, _
ByVal cbSize As Integer) As Integer
End Function
Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByRef lParam As IntPtr) As IntPtr
End Function
Shared Function WindowFromPoint(ByVal pnt As Point) As IntPtr
End Function
Private Structure INPUT
Public dwType As Integer
Public mi As MOUSEINPUT
End Structure
Private Structure MOUSEINPUT
Public dx As Integer
Public dy As Integer
Public mouseData As UInteger
Public dwFlags As UInteger
Public time As UInteger
Public dwExtraInfo As IntPtr
End Structure
Private Structure MSLLHOOKSTRUCT
Public pt As Point
Public mouseData As Int32
Public flags As Int32
Public time As Int32
Public extra As IntPtr
End Structure
Const INPUT_MOUSE As Integer = 0
Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
Const MOUSEEVENTF_LEFTUP As Integer = &H4
Const MOUSEEVENTF_MIDDLEDOWN As Integer = &H20
Const MOUSEEVENTF_MIDDLEUP As Integer = &H40
Const MOUSEEVENTF_MOVE As Integer = &H1
Const MOUSEEVENTF_ABSOLUTE As Integer = &H8000
Const MOUSEEVENTF_RIGHTDOWN As Integer = &H8
Const MOUSEEVENTF_RIGHTUP As Integer = &H10
Private _mouseHook As IntPtr
Private Const WH_MOUSE_LL As Int32 = 14
Private Delegate Function CallBack(ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
Private Declare Function SetWindowsHookExW Lib "user32.dll" (ByVal idHook As Int32, ByVal HookProc As CallBack, ByVal hInstance As IntPtr, ByVal wParam As Int32) As IntPtr
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hook As IntPtr) As Boolean
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal idHook As Int32, ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Integer
Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal fakezero As IntPtr) As IntPtr
Public Function InstallHook() As Boolean
If _mouseHook = IntPtr.Zero Then
_mouseProc = New CallBack(AddressOf MouseHookProc)
_mouseHook = SetWindowsHookExW(WH_MOUSE_LL, _mouseProc, GetModuleHandleW(IntPtr.Zero), 0)
End If
Return _mouseHook <> IntPtr.Zero
End Function
Public Sub RemoveHook()
If _mouseHook = IntPtr.Zero Then Return
UnhookWindowsHookEx(_mouseHook)
_mouseHook = IntPtr.Zero
End Sub
Private Shared Function MouseHookProc(ByVal nCode As Int32, ByVal wParam As IntPtr, ByRef lParam As MSLLHOOKSTRUCT) As Int32
Debug.Print("Message = {0}, x={1}, y={2}", wParam.ToInt32, lParam.pt.X, lParam.pt.Y)
' Get the current cursor coordinate
Form1.Text = "Current Point: " & lParam.pt.X & " " & lParam.pt.Y
Return CallNextHookEx(WH_MOUSE_LL, nCode, wParam, lParam)
End Function
Private Sub Form1_FormClosed(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed
RemoveHook()
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
InstallHook()
'Timer1.Enabled = True
HotKeyCheckTimer.Enabled = True
ClickTimer.Interval = 5000
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ClickTimer.Tick
Dim inputs(2) As INPUT
For i As Integer = 0 To inputs.Length - 1
inputs(i).dwType = INPUT_MOUSE
Next
' First move the mouse...
inputs(0).mi.dwFlags = MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE
' Get the start button location.
Dim newMousePosition As New System.Drawing.Point
Dim oldMousePosition As New System.Drawing.Point
' remember current pos
newMousePosition.X = TB_X.Text
newMousePosition.Y = TB_Y.Text
' We'll move it with the api. This ensures it happens with the other mouse input
' The api uses weird co-ordinates. translate and set.
inputs(0).mi.dx = CInt(newMousePosition.X * (65535 / Screen.PrimaryScreen.Bounds.Width))
inputs(0).mi.dy = CInt(newMousePosition.Y * (65535 / Screen.PrimaryScreen.Bounds.Height))
' Then send the buttons.
inputs(1).mi.dwFlags = MOUSEEVENTF_LEFTDOWN
inputs(2).mi.dwFlags = MOUSEEVENTF_LEFTUP
Dim cbSize As Integer = Marshal.SizeOf(inputs(0))
Dim result As Integer = SendInput(inputs.Length, inputs, cbSize)
If result = 0 Then
Throw New System.ComponentModel.Win32Exception
End If
TB_X.Text = TB_X.Text + 10
TB_Y.Text = TB_Y.Text + 10
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
ClickTimer.Stop()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
ClickTimer.Start()
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
TextBox1.Text = TextBox1.Text + 1
End Sub
Private Sub B_SetInterval_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles B_SetInterval.Click
ClickTimer.Interval = TB_TimerInterval.Text
End Sub
Private Sub HotKeyCheckTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles HotKeyCheckTimer.Tick
Dim hotkey As Boolean
hotkey = GetAsyncKeyState(Keys.F1)
Dim hotkey1 As Boolean
hotkey1 = GetAsyncKeyState(Keys.F2)
If hotkey = True Then
ClickTimer.Start()
TB_Status.BackColor = Color.Green
End If
If hotkey1 = True Then
ClickTimer.Stop()
TB_Status.BackColor = Color.Red
End If
End Sub
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
End Class
Brak komentarzy:
Prześlij komentarz