抛砖引玉——配合那个搬运棋子的代码

stud3

跟那个工具的模拟点击棋盘功能一样，，，不同处是我这个是前台的，比较轻灵，但容易出错电脑有EXCEL的，会写宏的，可以参考下


类模块代码
Public dm As dmsoft
Public sdX As Long, sdY As Long
Public Type GoScr
    GoL As Long
    GoR As Long
    GoT As Long
    GoB As Long
End Type
Sub Main()
    Set dm = New dmsoft
End Sub

Function Delay(N)
    StarTimer = Timer
    Do While Timer - StarTimer < N / 1000
        DoEvents
    Loop
End Function

窗口代码
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Dim HD As Long
Dim HB As Boolean
Dim cs As Long
Dim Scr As M.GoScr
Dim Flag As Long, EndFlag As Boolean
Dim xTime, yTime
Private Sub Command1_Click()
    Delay 1000
    下棋
End Sub

Private Sub Command2_Click()
    dm_ret = M.dm.FindPic(0, 0, M.dm.GetScreenWidth(), M.dm.GetScreenHeight(), "C:\Users\a\Desktop\LT.bmp", "000000", 1, 0, intX, intY)
    If intX >= 0 And intY >= 0 Then
        Scr.GoL = intX + 5
        Scr.GoT = intY + 6
    End If
    dm_ret = M.dm.FindPic(0, 0, M.dm.GetScreenWidth(), M.dm.GetScreenHeight(), "C:\Users\a\Desktop\BR.bmp", "000000", 1, 0, intX, intY)
    If intX >= 0 And intY >= 0 Then
        Scr.GoR = intX + 14
        Scr.GoB = intY + 12
    End If

    Timer1.Interval = 200
End Sub

Private Sub Form_Load()
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
    xTime = Time
    yTime = Time
    Main
End Sub

Private Sub HScroll1_Change()
    Label1.Caption = HScroll1.Value & "秒"
End Sub

Private Sub Timer1_Timer()
    If Not EndFlag Then Exit Sub
    sc = DateDiff("s", xTime, Time)
    If DateDiff("s", yTime, Time) >= HScroll1.Value Then
        dm_ret = M.dm.FindPic(Scr.GoL, Scr.GoT, Scr.GoR, Scr.GoB, "C:\Users\a\Desktop\1.bmp", "000000", 0.9, 0, intX, intY)
        If intX >= 0 And intY >= 0 Then
            HB = False
        End If

        dm_ret = M.dm.FindPic(Scr.GoL, Scr.GoT, Scr.GoR, Scr.GoB, "C:\Users\a\Desktop\2.bmp", "000000", 0.9, 0, intX, intY)
        If intX >= 0 And intY >= 0 Then
            HB = True
        End If

        If HB And Check1.Value = 0 Then
            下棋
        End If
        If Not HB And Check1.Value = 1 Then
            下棋
        End If
        If HB And Check1.Value = 1 Then
            xTime = Time
        End If
        If Not HB And Check1.Value = 0 Then
            xTime = Time
        End If
    End If
End Sub

Sub 下棋()
    On Error Resume Next
    If DateDiff("s", xTime, Time) < 3 Then
        Exit Sub
    End If
    M.dm.GetCursorPos X, Y
    oneW = (Scr.GoR - Scr.GoL) / 18
    M.dm.MoveTo sdX, sdY
    M.dm.LeftClick
    Delay 50

    M.dm.KeyDown 17
    Delay 50
    M.dm.KeyPress 67
    Delay 50
    M.dm.KeyUp 17

    txt = M.dm.GetClipboard()
    If txt = "" Then
        MsgBox "可能出错了，没读到AI坐标"
        Delay 5000
        Exit Sub
    End If
    tt = Split(txt, "贴目") 'Chr(13))
    有坐标的一段 = tt(UBound(tt) - 0)
    'Debug.Print 有坐标的一段
    ttt = Split(Split(有坐标的一段, " pv ")(1), " ")(0)
    If Err.Number > 0 Then
        MsgBox "可能出错了，没读到AI坐标"
        Delay 5000
        Err.Clear
        Exit Sub
    End If


    zbX = Left(ttt, 1)
    zbY = Scr.GoB - Replace(ttt, zbX, "") * oneW + oneW
    zbX = Asc(zbX) - 65

    If zbX > 8 Then
        zbX = zbX - 1
    End If
    zbX = zbX * oneW + Scr.GoL
    M.dm.MoveTo zbX, zbY
    M.dm.LeftClick
    Flag = 1
    yTime = Time
    xTime = Time
    M.dm.MoveTo X, Y
End Sub

Sub GetNum()
    On Error Resume Next
    '棋盘大小等
    dm_ret = M.dm.FindPic(0, 0, M.dm.GetScreenWidth(), M.dm.GetScreenHeight(), "C:\Users\a\Desktop\LT.bmp", "000000", 1, 0, intX, intY)
    If intX >= 0 And intY >= 0 Then
        Scr.GoL = intX + 5
        Scr.GoT = intY + 6
    End If
    dm_ret = M.dm.FindPic(0, 0, M.dm.GetScreenWidth(), M.dm.GetScreenHeight(), "C:\Users\a\Desktop\BR.bmp", "000000", 1, 0, intX, intY)
    If intX >= 0 And intY >= 0 Then
        Scr.GoR = intX + 14
        Scr.GoB = intY + 12
    End If
    '设置浮动棋盘大小位置
    HD = M.dm.FindWindow("", "浮动大棋盘")
    Size = 300
    M.dm.SetWindowSize HD, Size, Size
    sdX = Screen.Width / Screen.TwipsPerPixelX - Size / 20
    sdY = Size / 20
    M.dm.MoveWindow HD, Screen.Width / Screen.TwipsPerPixelX - Size, 0
    M.dm.MoveTo sdX, sdY

    If Err.Number > 0 Then
        MsgBox "没读到棋盘信息,不要遮挡棋盘"
        Exit Sub
    End If
End Sub

Private Sub BeginBot_Click()
    EndFlag = True
    GetNum
    Timer1.Interval = 200
End Sub

Private Sub EndBot_Click()
    EndFlag = False
    Timer1.Interval = 0
End Sub

Private Sub 结束_Click()
    EndFlag = False
    Timer1.Interval = 0
End Sub

Private Sub 开始_Click()
    EndFlag = True
    GetNum
    Timer1.Interval = 200
End Sub