SetCapture的问题.

Question

为何鼠标离开窗体就没法捕获了?

Answer 1

SetCapture以后，应该总是可以获取鼠标事件啊。
代码贴出来看看。

Answer 2

'在模块中定义
Declare Function GetCursorPos Lib "user32" (lpPoint As NTZ) As Long
Type NTZ
   x As Long
   y As Long
End Type
'在窗体中
Dim z As NTZPrivate Sub Timer1_Timer()
GetCursorPos z   '
Text1.Text = z.x
Text2.Text = z.y
End Sub

Answer 3

'**********'GO'**********'
Private Sub GoLabel_Click()
    ResultText.Text = ""
    Ddc = GetDC(ZoomPicture.hwnd)
    Sdc = GetDC(0)
    GetNow = True
    GetColorSize = 1
    ReleaseCapture
    SetCapture TmpPicture.hwnd
End Sub'**********' 获得图片放大'**********'
Private Sub TmpPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)        '
        '* 放大
        '
        StretchBlt Ddc, -2, -2, ZoomPicture.Width / Screen.TwipsPerPixelX, ZoomPicture.Height / Screen.TwipsPerPixelY, Sdc, (X + Me.Left) / Screen.TwipsPerPixelX - (ZoomPicture.Width / Screen.TwipsPerPixelX) / 6, (Y + Me.Top) / Screen.TwipsPerPixelY - (ZoomPicture.Height / Screen.TwipsPerPixelY) / 6, (ZoomPicture.Height / Screen.TwipsPerPixelY) / 3, (ZoomPicture.Height / Screen.TwipsPerPixelY) / 3, SRCCOPY
        '
        '* 文本框显示颜色
        '
        If GetColorSize = 1 Then
            ResultText.BackColor = GetPixel(Sdc, (X + Me.Left) / Screen.TwipsPerPixelX, (Y + Me.Top) / Screen.TwipsPerPixelY)
            ResultText.ForeColor = InvRGB(CStr(Hex(GetPixel(Sdc, (X + Me.Left) / Screen.TwipsPerPixelX, (Y + Me.Top) / Screen.TwipsPerPixelY))) & "　" & HexToRGB(CStr(Hex(GetPixel(Sdc, (X + Me.Left) / Screen.TwipsPerPixelX, (Y + Me.Top) / Screen.TwipsPerPixelY)))))
            ResultText.Text = "#" & CStr(Hex(GetPixel(Sdc, (X + Me.Left) / Screen.TwipsPerPixelX, (Y + Me.Top) / Screen.TwipsPerPixelY))) & "　" & HexToRGB(CStr(Hex(GetPixel(Sdc, (X + Me.Left) / Screen.TwipsPerPixelX, (Y + Me.Top) / Screen.TwipsPerPixelY))))
        End If
    
End Sub

Answer 4

捕获鼠标所在位置的窗口句柄： 
  
    Dim pt As POINTAPI
    GetCursorPos pt
    hw = WindowFromPoint(pt.x, pt.y)

Answer 5

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 Type
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, ByVal lpRect As Any, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim Pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
    Dim TextSize As POINTAPI, CX As Long, CY As Long
    'Get the current cursor position
    GetCursorPos Pt
    'Get the window under the cursor
    mWnd = WindowFromPoint(Pt.X, Pt.Y)
    'Get the window's position
    GetWindowRect mWnd, WR
    'Get the window'zs device context
    nDC = GetWindowDC(mWnd)
    'Get the height and width of our text
    GetTextExtentPoint32 nDC, "Hello !", Len("Hello !"), TextSize
    For CX = 1 To WR.Right - WR.Left Step TextSize.X
        For CY = 1 To WR.Bottom - WR.Top Step TextSize.Y
            'Draw the text on the window
            ExtTextOut nDC, CX, CY, 0, ByVal 0&, "Hello !", Len("Hello !"), ByVal 0&
        Next
    Next
End Sub
Private Sub Form_Paint()
    Me.CurrentX = 0
    Me.CurrentY = 0
    Me.Print "Click on this form," + vbCrLf + "Hold the mouse button," + vbCrLf + "drag the mouse over another window," + vbCrLf + "release the mouse button" + vbCrLf + "and see what happens!"
End Sub

Answer 6

给你写了这段代码，测试通过:
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetCapture Me.hwnd
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Debug.Print "X=" & X & ",Y=" & Y
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
End Sub另外，你说的鼠标离了窗体就没法捕获了，这是Windows的机制决定的，windows是这样处理的：当鼠标不在你的程序窗体上并且窗体失去焦点时，不再向该窗体发送鼠标消息。我想只能通过计时器来解决吧！

Answer 7

'上面的例子给错了,下面这个通过测试,没有问题了:鼠标在任何位置都可以捕获到,
''按ALT+F4退出程序.
Private Type POINTAPI
    X As Long
    Y As Long
End Type
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
Dim Pt As POINTAPI
Private Sub Form_Load()
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '获得当前鼠标的坐标
    GetCursorPos Pt
    Me.CurrentX = 0
    Me.CurrentY = 0
    '清屏
    Me.Cls
    Me.Print " 鼠标的坐标:"
    '打印鼠标是坐标
    Me.Print "X:" + Str$(Pt.X) + " Y:" + Str$(Pt.Y)
    Me.Print "(按 ALT+F4退出程序)"
    SetCapture Me.hwnd
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SetCapture Me.hwnd
End Sub

Answer 8

我给的例子并没有错，是需要在窗体上按住鼠标左键，然后移动橱窗体一样可以获得鼠标位置
但是，如果想通过Sendmessage+子类实现，难

Answer 9

//我给的例子并没有错，是需要在窗体上按住鼠标左键，然后移动橱窗体一样可以获得鼠标位置
sakurako(最爱API)
不好意思,是我没有说清楚,不是说你的例子.而是指你上面的那个例子(是我第一次给出的那个!)

Answer 10

//另外，你说的鼠标离了窗体就没法捕获了，这是Windows的机制决定的，windows是这样处
//理的：当鼠标不在你的程序窗体上并且窗体失去焦点时，不再向该窗体发送鼠标消息。我
//想只能通过计时器来解决吧！我说的不对，请不要看，不好意思。嘻嘻