| |  |  | Miembros: Mensajes: Temas: Online: Ultimo Miembro: | | |  | | |
 | 
03-03-2007, 00:28:39
| | Un Nuevo Amigo | | Registrado: feb 2007 Posts: 22
| | Simular Click Hola, bueno hasta ahora hice el siguiente codigo que me da la pocicion X e Y del cursor: Código: Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim Mouse As POINTAPI
Private Sub Timer1_Timer()
Call GetCursorPos(Mouse)
Text1.Text = Mouse.X
Text2.Text = Mouse.Y
End Sub
Ahora necesitaria ayuda para simular el click, esuche que se puede usar el siguiente evento "mouse_event" pero la verdad no tengo idea de como hacerlo, podria alguien explicarme? Eh buscado pero no supe que hacer con el codigo... | 
04-03-2007, 10:17:21
| | Gran Participación en el Foro | | Registrado: oct 2003 Posts: 438
| | Código: 'Before you start this program, I suggest you save everything that wasn't saved yet.
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 Sub Form_Activate()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Do
'Simulate a mouseclick on the cursor's position
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, cButt, dwEI
DoEvents
Loop
End Sub Código: 'Example by Daniel Kaufmann (daniel@i.com.uy)
'Paste this code in a Form
'with a Menu named menu1 which has a menuitem named menu2
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 GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemRect Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal uItem As Long, lprcItem As RECT) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
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)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0 'X Size of screen
Const SM_CYSCREEN = 1 'Y Size of Screen
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim mWnd As Long
mWnd = Me.hwnd
Dim hMenu As Long, hSubMenu As Long
hMenu = GetMenu(mWnd) 'Get the Menu of the Window(MenuBar)
ClickMenuItem mWnd, hMenu, 0 'Click on the first SubMenu
hSubMenu = GetSubMenu(hMenu, 0) 'Get its submenu
ClickMenuItem mWnd, hSubMenu, 0 'Click on the first MenuItem of the Submenu
End Sub
Private Sub ScreenToAbsolute(lpPoint As POINTAPI)
lpPoint.x = lpPoint.x * (&HFFFF& / GetSystemMetrics(SM_CXSCREEN))
lpPoint.y = lpPoint.y * (&HFFFF& / GetSystemMetrics(SM_CYSCREEN))
End Sub
Private Sub Click(p As POINTAPI)
'p.X and p.Y in absolute coordinates
'Put the mouse on the point
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, p.x, p.y, 0, GetMessageExtraInfo()
'Mouse Down
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, GetMessageExtraInfo()
'Mouse Up
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, GetMessageExtraInfo()
End Sub
Private Sub ClickMenuItem(ByVal mWnd As Long, ByVal hMenu As Long, ByVal Pos As Long)
Dim ret As Long
Dim r As RECT, p As POINTAPI
ret = GetMenuItemRect(mWnd, hMenu, Pos, r)
If ret = 0 Then Exit Sub
p.x = (r.Left + r.Right) / 2
p.y = (r.Top + r.Bottom) / 2
ScreenToAbsolute p
'Click on p
Click p
End Sub
Private Sub Form_Load()
Dim mWnd As Long, p As POINTAPI
mWnd = Me.hwnd
Dim hMenu As Long, hSubMenu As Long
hMenu = GetMenu(mWnd) 'Get the Menu of the Window(MenuBar)
ClickMenuItem mWnd, hMenu, 0 'Click on the first SubMenu
hSubMenu = GetSubMenu(hMenu, 0) 'Get its submenu
ClickMenuItem mWnd, hSubMenu, 0 'Click on the first MenuItem of the Submenu
p.x = &HFFFF& / 2
p.y = &HFFFF& / 2
Click p
Me.AutoRedraw = True
Me.BackColor = vbWhite
Print "Press any key"
End Sub
Private Sub menu2_Click()
MsgBox "Click"
End Sub | 
04-03-2007, 10:42:27
| | Un Nuevo Amigo | | Registrado: ene 2006 Ubicación: Olesa de Montserrat / Barcelona Posts: 28
| | BUenas, las constanes que utiliza la api "mouse_event" son: Código: Global Const MOUSEEVENTF_MOVE = &H1 ' movimiento del mouse
Global Const MOUSEEVENTF_LEFTDOWN = &H2 ' botón izquierdo presionado
Global Const MOUSEEVENTF_LEFTUP = &H4 ' botón izquierdo soltado
Global Const MOUSEEVENTF_RIGHTDOWN = &H8 ' botón derecho presionado
Global Const MOUSEEVENTF_RIGHTUP = &H10 ' botón derecho soltado
Global Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' botón central presionado
Global Const MOUSEEVENTF_MIDDLEUP = &H40 ' botón central soltado
Global Const MOUSEEVENTF_ABSOLUTE = &H8000 ' movimiento absoluto Para llamar a la api y simular 1 pulsacion: Código: mouse_event MOUSEEVENTF_LEFTDOWN, Posicion.X, Posicion.Y, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, Posicion.X, Posicion.Y, 0, 0
__________________
Saludos
| 
04-03-2007, 14:27:42
| | Un Nuevo Amigo | | Registrado: feb 2007 Posts: 22
| | Gracias, lo probare! | | Herramientas | | | | Desplegado | Mode Lineal |
Normas de Publicación
| no Puedes crear nuevos temas no Puedes responder a temas no Puedes adjuntar archivos no Puedes editar tus mensajes Código [IMG] está habilitado Código HTML está deshabilitado | | | La franja horaria es GMT. Ahora son las 02:14:06.
Powered by vBulletin® Version 3.6.8 Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO 3.1.0
A vBSkinworks Design
|  |