紧急，如何扑捉屏幕上的鼠标所在位置的坐标和记录下来,并判断鼠标的左键还是右键动作记录下来

Question

如何扑捉屏幕上的鼠标所在位置的坐标和记录下来,并判断鼠标的左键还是右键动作记录下来，代码详细点，在线等，能达到要求马上结贴，谢谢mymail:   [email protected]

Answer 1

chenhui530(陈辉):
钩子现在不会~~ 

Answer 2

我前段时间写了个你自己修改下吧下面是窗体代码
Option Explicit
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End TypePrivate Sub cmdExit_Click()
    Unload Me
End SubPrivate Sub cmdLeave_Click()
    Dim lngStart As Long, lngStartButton As Long, objPoint As POINTAPI, objRect As RECT
    Me.Hide
    lngStart = FindWindow("Shell_TrayWnd", vbNullString)
    SetParent lngCmdhWnd, lngStart
    lngStartButton = FindWindowEx(lngStart, 0, "button", vbNullString)
    'ClientToScreen lngStartButton, objPoint
    GetClientRect lngStartButton, objRect
    MoveWindow lngCmdhWnd, 0, 0, objRect.Right - objRect.Left, objRect.Bottom - objRect.Top, 1
End SubPublic Sub cmdSend_Click()
'    MessageBox Me.hwnd, "我能响应事件！！", "哈哈！！", vbInformation
'    ShowWindow Me.hwnd, 5
'    SetParent lngCmdhWnd, Me.hwnd
'    cmdSend.Move 1800, 2880, cmdExit.Width, cmdExit.Height
    PopupMenu Me.mnuOpen
End SubPrivate Sub cmdSend_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        SetParent lngCmdhWnd, Me.hwnd
        cmdSend.Move 1800, 2880, cmdExit.Width, cmdExit.Height
        Me.Show
    End If
End SubPrivate Sub Form_Load()
    lngCmdhWnd = Me.cmdSend.hwnd
    hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
End SubPrivate Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End SubPrivate Sub mnuCalc_Click()
    Shell "calc", vbNormalFocus
End SubPrivate Sub mnuNote_Click()
    Shell "Notepad.exe", vbNormalFocus
End Sub

Answer 3

下面是模块代码
Option Explicit
Public Const WH_MOUSE = 7
Public Const WH_MOUSE_DLL = 14
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_FINDSTRING = &H18FPrivate Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long
        dwExtraInfo As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public hHook As Long
Private objMOUSEMSG As MOUSEHOOKSTRUCT
Public lngCmdhWnd As LongPublic Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim p As POINTAPI, strClassName As String * 260, lnghWnd As Long, lngRet As Long
    If idHook < 0 Then
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        CopyMemory objMOUSEMSG, ByVal lParam, LenB(objMOUSEMSG)
        lnghWnd = WindowFromPoint(objMOUSEMSG.pt.X, objMOUSEMSG.pt.Y)
        
        lngRet = GetClassName(lnghWnd, strClassName, 260)
        If (Left(strClassName, lngRet) = "ThunderCommandButton" Or Left(strClassName, lngRet) = "ThunderRT6CommandButton") Then
            If wParam = 514 And lnghWnd = lngCmdhWnd Then
                frmMain.cmdSend_Click
            End If
        End If
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    End If
End Function

Answer 4

其中POINTAPI这个结构是存放鼠标位置的

Answer 5

to mmyyxx88() 1.只要能在所有控件都能得到坐标就可以，也可能说就是全屏幕吧，移动时得到的坐标X,Y在标签控件里显示一下就可以了，不用记录下来，我心里有素就行，但一定要这个功能2.关于鼠标左键右键事件，最好能像picture.mousedown鼠标击了有个响应，我可以在里面写下面的类似代码
msgbox "你在屏幕的" & x & "," & y & "按了" & "鼠标左键"(或右键)3.我的程序是最大化状态下运行的，上面有图片框，也有标签，也有文本框，都希望在鼠标移动到控件上都有一个相对屏幕像素的一个坐，我讲得挺罗索的，说到就是鼠标在全屏幕状态下移动的坐标4.非常感谢你的回复

Answer 6

to mmyyxx88() 你说的就是我想要的，就是全屏幕啦，期待你的代码救我。我都不行了:(

Answer 7

to chenhui530(陈辉)谢谢你的回复,对api不是太熟悉，我仔仔研究一下

Answer 8

如果你不懂API那么有个变通的方法
用一个API加TIMER也可以实现，把TIMER时间设置短些
然后用Private Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
获取坐标信息

Answer 9

看看这个!
http://www.hexi5.com/bbs/dispbbs.asp?boardID=6&ID=35&page=1

Answer 10

To mmyyxx88() 你好，能帮我实现吗?

Answer 11

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Dim MyPos As POINTAPI
Private Sub Timer1_Timer()
    GetCursorPos MyPos              '获取光标位置
    Text1 = MyPos.X
    Text2 = MyPos.Y
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Button
        Case vbLeftButton
            Debug.Print "你在屏幕" & MyPos.X & "," & MyPos.Y & " 按鼠标左键"
        Case vbRightButton
            Debug.Print "你在屏幕" & MyPos.X & "," & MyPos.Y & "按鼠标右键"
    End Select
End Sub

Answer 12

其实chenhui530(陈辉)的程序已经包含了你要求解决的问题。
API还是不能缺，上述代码经过运行。控件Timer1.Interval = 100（ms），作为定时读取位置坐标，你可以调整合适的时间。左右键的问题，既然你的是全屏，我猜想你关心的应该是你窗体内的位置，窗体内的控件基本上都有MouseDown事件，你可以每个控件都写一遍MouseDown事件的处理代码。其实你最关心的应该是指定区域内的MouseDown事件，比如一幅画面。这里用一个Picture1给你举例。对左右键问题有不满意，或者还有其他要求再提出来，但要更详细表述清楚。