QQ游戏对对碰教程

ype And boxs(i, j).type = boxs(i - 3, j).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
Exit Function
End If
Next j
Next i
'_ 　 情况
For i = 2 To 7
For j = 0 To 6
If boxs(i, j).type = boxs(i - 1, j 1).type And boxs(i, j).type = boxs(i - 2, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j 1).x, boxs(i, j 1).y
Exit Function
End If
Next j
Next i
'　 _ 情况
For i = 2 To 7
For j = 1 To 7
If boxs(i, j).type = boxs(i - 1, j - 1).type And boxs(i, j).type = boxs(i - 2, j - 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
Exit Function
End If
Next j
Next i
'_-- 情况
For i = 1 To 7
For j = 0 To 5
If boxs(i, j).type = boxs(i - 1, j 2).type And boxs(i, j).type = boxs(i - 1, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
Exit Function
End If
Next j
Next i
'-_ _ 情况
For i = 0 To 6
For j = 0 To 5
If boxs(i, j).type = boxs(i 1, j 2).type And boxs(i, j).type = boxs(i 1, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i 1, j).x, boxs(i 1, j).y
Exit Function
End If
Next j
Next i
' -_- 情况
For i = 1 To 7
For j = 1 To 6
If boxs(i, j).type = boxs(i - 1, j - 1).type And boxs(i, j).type = boxs(i - 1, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
Exit Function
End If
Next j
Next i
' _-_ 情况
For i = 0 To 6
For j = 1 To 6
If boxs(i, j).type = boxs(i 1, j - 1).type And boxs(i, j).type = boxs(i 1, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i 1, j).x, boxs(i 1, j).y
Exit Function
End If
Next j
Next i
'　< 情况
For i = 1 To 6
For j = 1 To 7
If boxs(i, j).type = boxs(i 1, j - 1).type And boxs(i, j).type = boxs(i - 1, j - 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
Exit Function
End If
Next j
Next i
'>　 情况
For i = 1 To 6
For j = 0 To 6
If boxs(i, j).type = boxs(i 1, j 1).type And boxs(i, j).type = boxs(i - 1, j 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j 1).x, boxs(i, j 1).y
Exit Function
End If
Next j
Next i
'--_ 情况
For i = 1 To 7
For j = 2 To 7
If boxs(i, j).type = boxs(i - 1, j - 2).type And boxs(i, j).type = boxs(i - 1, j - 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i - 1, j).x, boxs(i - 1, j).y
Exit Function
End If
Next j
Next i
'-- - 情况
For i = 0 To 7
For j = 3 To 7
If boxs(i, j).type = boxs(i, j - 2).type And boxs(i, j).type = boxs(i, j - 3).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j - 1).x, boxs(i, j - 1).y
Exit Function
End If
Next j
Next i
'_ _- 情况
For i = 0 To 6
For j = 2 To 7
If boxs(i, j).type = boxs(i 1, j - 2).type And boxs(i, j).type = boxs(i 1, j - 1).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i 1, j).x, boxs(i 1, j).y
Exit Function
End If
Next j
Next i
'- -- 情况
For i = 0 To 7
For j = 0 To 4
If boxs(i, j).type = boxs(i, j 2).type And boxs(i, j).type = boxs(i, j 3).type Then
mouseClick boxs(i, j).x, boxs(i, j).y
mouseClick boxs(i, j 1).x, boxs(i, j 1).y
Exit Function
End If
Next j
Next i
End Function
这里的鼠标模拟用了鼠标事件.你也可以用sendmessage来实现.
'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:模拟鼠标单击
'方法:mouseClick(ByVal x As Long, ByVal y As Long)
'说明:x -- 方块相对游戏窗口的X; y -- 方块相对游戏窗口的Y;
'返回值:无
'应用于:MainMod模块
'********************************************
Public Sub mouseClick(ByVal x As Long, ByVal y As Long)
Dim po As POINTAPI 'po点击前鼠标位置
Dim kX As Long '方块的绝对X坐标
Dim kY As Long '方块的绝对Y坐标
Dim winRECT As RECT '游戏窗口的RECT
'获得游戏窗口的RECT
GetWindowRect g_WindowHwnd, winRECT
'绝对坐标 = 游戏窗口左上角坐标 游戏中的相对坐标
kX = winRECT.Left x
kY = winRECT.Top y
'获得鼠标点击前位置
GetCursorPos po
'模拟鼠标移动
mouse_event MOUSEEVENTF_MOVE Or MOUSEEVENTF_ABSOLUTE, kX * 65535 / 1024, kY * 65535 / 768, 0&, 0&
'模拟鼠标按下弹起
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE, 0, 0, 0&, 0&
'点击后返回原先位置
SetCursorPos po.x, po.y
End Sub
'**********过程名:DelayTime******************
'作者:Cyril
'书写日期:2004.10.23
'编辑日期:2002.10.23
'目的:取游戏中某点颜色
'方法:getColor(ByVal newX As Long, ByVal newY As Long) As Long
'说明:newX -- 要取颜色的点的X; newY -- 要取颜色的点的Y;(X,Y均相对于游戏窗口)
'返回值:Long
'应用于:MainMod模块
'********************************************
Public Function getColor(ByVal newX As Long, ByVal newY As Long) As Long
Dim windowDC As Long
'获取游戏场景
windowDC = GetDC(g_WindowHwnd)
'取场景中 (newX,newY)坐标的颜色
getColor&n

最新评论