[Help] Click chuột bằng hàm trong VB6 [Archive]

huytranaz

20-09-2008, 10:05

Trong VB6 có hàm nào có thể Click trái và Click phải chuột tại một tọa độ nào đó trên màn hình được không ? Nếu được thì các bạn cho mình biết hàm đó với , Cảm ơn nhiều !

Bạn dụng Windows API đi, có 2 cách:

1. Sử dụng hàm mouse_event: Cách này đơn giản, dễ dùng nhưng bị hạn chế là chỉ tương tác mouse chung chung, không chỉ định vào một window handle nào. Thích hợp làm các demo training.
Ví dụ trong API-Guide:

'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

2. Sử dụng hệ thống tương tác message: Cách này phức tạp hơn, nhưng khắc phục được nhược điểm của hàm mouse_event và hầu như không bị chặn bởi chế độ bảo vệ của ứng dụng. Thích hợp làm auto play cho game.
Ví dụ: Mình trích 1 đoạn code điều khiển mouse trong 1 bản auto play mình viết.

'--
Public Function MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long) As Boolean
If mvarHwnd <> 0 Then
SendMessage mvarHwnd, zMakeMsg(Button, iMouseDown), zMakeWParam(Button, Shift), zMakeLParam(x, y)
MouseDown = True
Else
MouseDown = False
End If
End Function
'--
Public Function MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long) As Boolean
If mvarHwnd <> 0 Then
SendMessage mvarHwnd, WM_MOUSEMOVE, zMakeWParam(Button, Shift), zMakeLParam(x, y)
MouseMove = True
Else
MouseMove = False
End If
End Function
'--
Public Function MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long) As Boolean
If mvarHwnd <> 0 Then
SendMessage mvarHwnd, zMakeMsg(Button, iMouseUp), zMakeWParam(Button, Shift), zMakeLParam(x, y)
MouseUp = True
Else
MouseUp = False
End If
End Function

Bạn có thể tham khảo thêm cách sử dụng các hàm API trên mạng hoặc API-Guide.

Chúc cuối tuần vui vẻ,