Solución:detectar mouse fuera form y realizar clic
Publicado por SRSocket (1 intervención) el 27/01/2009 21:54:18
Subo el código para detectar el movimiento del ratón fuera del form así como para que realize un click., por si alguien algun dia lo necesita.
Para el siguiente código es necesario 4 labels , 1 timer y un commandbutton.
El código esta bastante bien explicado para si alguien solo quiere alguna función.
*El programa esta ralizado con vb6.
' Empieza el códgio útil
' 27/01/09 SRSocket Begin.Método para la detección y el click del ratón fuera del formulario estandar de VBA
' Declaración de las librerias
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Type POINTAPI
x As Long
Y As Long
End Type
Dim a As POINTAPI
Dim b As Long
Dim c As Long
Dim posX As Long
Dim posY As Long
Dim blnUP As Boolean
Dim active As Integer 'Variable que nos servira para conocer cuando el ratón esta encima del botón y deshabilite la función para obtener la posición
Private Sub Command1_Click() 'Eventos para el botón
Dim ret, x As Integer
ret = SetCursorPos(posX, posY) 'Nos situara el cursor en la posición correcta
For x = 0 To 1 'Con esto simularemos el dobleclik del ratón,si se desea un click borrar esta línea
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, posX, posY, 0, 0 'Función que simula el click del ratón
DoEvents
Next x 'Si se desea un unico click borrar esta línea
active = 0
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
active = 1
End Sub
Private Sub Form_Load()
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
mousepos 'Llamaremos a la función mousepos
End Sub
Private Sub mousepos()
Dim ret As Integer
If active = 0 Then
ret = GetCursorPos(a)
b = a.x 'asiganaremos la posición del cursor
c = a.Y 'a las variables
Label1.Caption = b 'mostraremos las posiciones
Label2.Caption = c 'en los labels
If GetAsyncKeyState(1) <> 0 Then 'Función que determina si una tecla está o no pulsada
Label3.Caption = b
Label4.Caption = c
posX = b
posY = c
End If
End If
End Sub
' End
' Final del código útil
salu2 a to2 los foreros
Para el siguiente código es necesario 4 labels , 1 timer y un commandbutton.
El código esta bastante bien explicado para si alguien solo quiere alguna función.
*El programa esta ralizado con vb6.
' Empieza el códgio útil
' 27/01/09 SRSocket Begin.Método para la detección y el click del ratón fuera del formulario estandar de VBA
' Declaración de las librerias
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Type POINTAPI
x As Long
Y As Long
End Type
Dim a As POINTAPI
Dim b As Long
Dim c As Long
Dim posX As Long
Dim posY As Long
Dim blnUP As Boolean
Dim active As Integer 'Variable que nos servira para conocer cuando el ratón esta encima del botón y deshabilite la función para obtener la posición
Private Sub Command1_Click() 'Eventos para el botón
Dim ret, x As Integer
ret = SetCursorPos(posX, posY) 'Nos situara el cursor en la posición correcta
For x = 0 To 1 'Con esto simularemos el dobleclik del ratón,si se desea un click borrar esta línea
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, posX, posY, 0, 0 'Función que simula el click del ratón
DoEvents
Next x 'Si se desea un unico click borrar esta línea
active = 0
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
active = 1
End Sub
Private Sub Form_Load()
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
mousepos 'Llamaremos a la función mousepos
End Sub
Private Sub mousepos()
Dim ret As Integer
If active = 0 Then
ret = GetCursorPos(a)
b = a.x 'asiganaremos la posición del cursor
c = a.Y 'a las variables
Label1.Caption = b 'mostraremos las posiciones
Label2.Caption = c 'en los labels
If GetAsyncKeyState(1) <> 0 Then 'Función que determina si una tecla está o no pulsada
Label3.Caption = b
Label4.Caption = c
posX = b
posY = c
End If
End If
End Sub
' End
' Final del código útil
salu2 a to2 los foreros
Valora esta pregunta


0