Option Explicit 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 SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Const MOUSEEVENTF_MOVE = &H1 ' mouse move Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down Const MOUSEEVENTF_LEFTUP = &H4 ' left button up Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function ModifyMenu Lib "User32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const SC_MOVE = &HF010& Private Const MF_BYCOMMAND = &H0& Private Const MF_ENABLED = &H0& Private Const MF_GRAYED = &H1& Private Type rect Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As rect) As Long Dim PZG_LEFT&, PZG_TOP& Dim objTimer As New clsWaitableTimer Public isStop As Boolean Private Sub Form_Load() Me.Move Screen.Width - Me.Width - 90, 90 Text1.Text = vbCrLf & "1.先将游戏以窗口模式打开，并打开到休闲花园" & vbCrLf & _ "2.点击本程序的""启动""按钮开始捡金币，捡的过程中请不要操作电脑" & vbCrLf & _ "3.如果要停止捡金币请按快捷键""CTRL+ALT+C""停止检金币" & vbCrLf & _ "4.如果看到需要浇水和施肥请停下程序处理然后再启动捡金币" & vbCrLf & vbCrLf & _ " by sysdzw" & vbCrLf & _ " QQ:171977759" setHotKey Me.hwnd, MOD_ALT + MOD_CONTROL, vbKeyC End Sub Private Sub Form_Unload(Cancel As Integer) Set objTimer = Nothing delHotKey Me.hwnd End End Sub Public Sub Command1_Click() Dim i&, j&, intMaxLine% If Command1.Caption = "启动" Then isStop = False Command1.Caption = "停止" Else isStop = True End If objTimer.Wait 500 Do If Not initLeftTop Then Check1.Enabled = True Command1.Caption = "启动" Exit Sub End If Check1.Enabled = False intMaxLine = 11 If Check1.Value Then intMaxLine = intMaxLine + 1 For i = 1 To intMaxLine '点11行，如果带上蜗牛就再多点一行，变为12行 For j = 1 To 76 '每行点多少列?76 If isStop Then Check1.Enabled = True Command1.Caption = "启动" Exit Sub End If clickPoint PZG_LEFT + j * 10, PZG_TOP + (i - 1) * 30 objTimer.Wait 1 Next Next Check1.Enabled = True objTimer.Wait 5000 Loop End Sub Private Function initLeftTop() As Boolean Dim hwind& Dim rect As rect hwind = FindWindow("MainWindow", "Plants vs. Zombies GOTY ") '获取窗体句柄 GetWindowRect hwind, rect ' MsgBox rect.Left & "," & rect.Top If rect.Left <= 0 Then MsgBox "请将植物大战僵尸游戏以窗口模式打开，并且全部放到屏幕可见范围内。", vbInformation Exit Function End If PZG_LEFT = rect.Left + 20 PZG_TOP = rect.Top + 153 initLeftTop = True End Function Private Sub clickPoint(x1 As Long, y1 As Long, Optional ByVal clickTimes As Integer = 1) SetCursorPos x1, y1 Do While clickTimes > 0 mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 clickTimes = clickTimes - 1 Loop End Sub Private Sub Command2_Click() End End Sub