【按键精灵】中国象棋脚本详解
Dim LTX, LTY, mapLTX, mapLTY, mapRBX, mapRBY// 窗口左上角坐标；棋盘左上角、右下角坐标
Dim xPosArr, yPosArr// 各交点横纵坐标数组
Dim myColor, oppositeColor// 我方颜色、对方颜色，w：红，b：黑
Dim map// 二维数组（已根据红黑方排序）
Dim mapX, mapY// 数字对应的行，字母对应的列
Dim round// 走棋方，w：红，b：黑
Dim fen // FEN局面代码
Call 地图初始化
Sub 地图初始化
Hwnd = Plugin.Window.Find(0, "QQ新中国象棋")
sRect = Plugin.Window.GetClientRect(Hwnd)
LTX = split(sRect, "|")(0) // 默认448
LTY = split(sRect, "|")(1)// 默认165
mapLTX = LTX + 219
mapLTY = LTY + 35
mapRBX = LTX + 774
mapRBY = LTY + 652
L9 = Array("r", "n", "b", "a", "k", "a", "b", "n", "r")
L8 = Array("", "", "", "", "", "", "", "", "")
L7 = Array("", "c", "", "", "", "", "", "c", "")
L6 = Array("p", "", "p", "", "p", "", "p", "", "p")
L5 = Array("", "", "", "", "", "", "", "", "")
L4 = Array("", "", "", "", "", "", "", "", "")
L3 = Array("P", "", "P", "", "P", "", "P", "", "P")
L2 = Array("", "C", "", "", "", "", "", "C", "")
L1 = Array("", "", "", "", "", "", "", "", "")
L0 = Array("R", "N", "B", "A", "K", "A", "B", "N", "R")
xPosArr = Array(LTX + 269, LTX + 326, LTX + 383, LTX + 440, LTX + 497, LTX + 554, LTX + 611, LTX + 668, LTX + 725)
yPosArr = Array(LTY + 87, LTY + 144, LTY + 201, LTY + 258, LTY + 315, LTY + 372, LTY + 429, LTY + 486, LTY + 543, LTY + 600)
Call 判断先手
End Sub
Sub 判断先手
IfColor LTX + 501, LTY + 595, "0020AC", 0 Then
// 我方先手
myColor = "w"
oppositeColor = "b"
map = Array(L9, L8, L7, L6, L5, L4, L3, L2, L1, L0)
mapX = Array("a", "b", "c", "d", "e", "f", "g", "h", "i")
mapY = Array("9", "8", "7", "6", "5", "4", "3", "2", "1", "0")
Else
// 对方先手
myColor = "b"
oppositeColor = "w"
map = Array(L0, L1, L2, L3, L4, L5, L6, L7, L8, L9)
mapX = Array("i", "h", "g", "f", "e", "d", "c", "b", "a")
mapY = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
End If
round = "w"
Call 生成FEN局面代码
End Sub
Sub 生成FEN局面代码
fen = ""
For i = 0 To 9
blankCount = 0 // 此行空白位置计数
For j = 0 To 8
If map(i)(j) = "" Then
blankCount = blankCount + 1// 此位置无棋，计数+1
ElseIf blankCount > 0 Then// 此位置有有棋，前面无棋，插入数字后拼接棋码，并重新计数
fen = fen & blankCount & map(i)(j)
blankCount = 0
ElseIf blankCount = 0 Then // 此位置有有棋，前面也有棋，直接拼接棋码
fen = fen & map(i)(j)
End If
Next
If blankCount > 0 Then // 换行前拼接数字
fen = fen & blankCount
End If
If i < 9 Then
fen = fen & "/" // 普通换行拼接斜杠
End If
Next
If myColor = "b" Then
fen = StrReverse(fen)
End If
fen = fen & " " & round
TracePrint fen
If round = myColor Then
Call 我方走棋
Else
Call 等待对方走棋
End If
End Sub
Sub 我方走棋
Dim move // 走棋代码
Dim rowIndex_1, colIndex_1, rowIndex_2, colIndex_2 // 走棋点1、走棋点2在地图中的行列下标
Set querybest = CreateObject("Msxml2.ServerXMLHTTP.3.0")
querybest.Open "Get", "http://www.chessdb.cn/chessdb.php?action=querybest&board=" & fen, False
querybest.Send
If querybest.readyState=4 Then
TracePrint querybest.responsetext
If InStr(querybest.responsetext, "invalid board") > 0 Then // 非法局面代码
EndScript
ElseIf InStr(querybest.responsetext, "nobestmove") > 0 Then // 没有最佳着法，查询思考细节
Set querypv = CreateObject("Msxml2.ServerXMLHTTP.3.0")
querypv.Open "Get", "http://www.chessdb.cn/chessdb.php?action=querypv&board=" & fen, False
querypv.Send
If querypv.readyState = 4 Then
TracePrint querypv.responsetext
If InStr(querypv.responsetext, "unknown") > 0 Then
EndScript
End If
move = Right(split(querypv.responsetext, "|")(0), 4) // 不一定有|，但不影响运算结果
End If
querypv.abort
Set querypv = Nothing
Else // 正常返回
move = Right(querybest.responsetext, 5)
End If
// 遍历行
For i = 0 To 9
If mapY(i) = Mid(move, 2, 1) Then
rowIndex_1 = i // 起始行下标
moveY_1 = yPosArr(i) // 起始行纵坐标
End If
If mapY(i) = Mid(move, 4, 1) Then
rowIndex_2 = i // 目标行下标
moveY_2 = yPosArr(i) // 目标行纵坐标
End If
Next
// 遍历列
For i = 0 To 8
If mapX(i) = Mid(move, 1, 1) Then
colIndex_1 = i // 起始列下标
moveX_1 = xPosArr(i) // 起始列横坐标
End If
If mapX(i) = Mid(move, 3, 1) Then
colIndex_2 = i // 目标列下标
moveX_2 = xPosArr(i) // 目标列横坐标
End If
Next
End If
querybest.abort
Set querybest = Nothing
MoveTo moveX_1, moveY_1
Delay 100
LeftClick 1
MoveTo moveX_2, moveY_2
Delay 100
LeftClick 1
Call 刷新二维数组(rowIndex_1, colIndex_1, rowIndex_2, colIndex_2)
End Sub
Sub 等待对方走棋
Delay 2000
While True
IfColor LTX + 183, LTY + 471, "5A7A7A", 1 Then
Call 计算对方走棋点
End If
Wend
End Sub
Sub 计算对方走棋点
FindColor mapLTX, mapLTY, mapRBX, mapRBY, "0000FF", intX_1, intY_1
If intX_1 > 0 And intY_1 > 0 Then
Dim rowIndex_1, colIndex_1, rowIndex_2, colIndex_2// 走棋点1、走棋点2在地图中的行列下标
// 确定走棋点1在地图中的行列下标
For i = 0 To 9
If yPosArr(i) > intY_1 Then
rowIndex_1 = i
Exit For
End If
Next
For i = 0 To 8
If xPosArr(i) > intX_1 Then
colIndex_1 = i
Exit For
End If
Next
// 确定走棋点2在地图中的行列下标
FindColor intX_1 + 52, intY_1, mapRBX, intY_1, "0000FF", intX_2, intY_2
If intX_2 > 0 And intY_2 > 0 Then // 在正右方找到走棋点2
rowIndex_2 = rowIndex_1
For i = colIndex_1 + 1 To 8
If xPosArr(i) > intX_2 Then
colIndex_2 = i
Exit For
End If
Next
Else // 正右方没有，在下方找走棋点2
FindColor mapLTX, intY_1 + 52, mapRBX, mapRBY, "0000FF", intX_2, intY_2
If intX_2 > 0 And intY_2 > 0 Then
For i = rowIndex_1 + 1 To 9
If yPosArr(i) > intY_2 Then
rowIndex_2 = i
Exit For
End If
Next
For i = 0 To 8
If xPosArr(i) > intX_2 Then
colIndex_2 = i
Exit For
End If
Next
End If
End If
End If
Call 刷新二维数组(rowIndex_1, colIndex_1, rowIndex_2, colIndex_2)
End Sub
Sub 刷新二维数组(rowIndex_1, colIndex_1, rowIndex_2, colIndex_2)
TracePrint rowIndex_1 & colIndex_1 & rowIndex_2 & colIndex_2
If map(rowIndex_2)(colIndex_2) = "" Then // 走棋点2本身无子，从1走到2
map(rowIndex_2)(colIndex_2) = map(rowIndex_1)(colIndex_1)
map(rowIndex_1)(colIndex_1) = ""
ElseIf InStr("rnbakcp", map(rowIndex_1)(colIndex_1)) > 0 And map(rowIndex_1)(colIndex_1) <> "" And round = "b" Then// 黑色方走棋，且走棋点1本身是黑子，从1走到2（黑吃红）
map(rowIndex_2)(colIndex_2) = map(rowIndex_1)(colIndex_1)
map(rowIndex_1)(colIndex_1) = ""
ElseIf InStr("RNBAKCP", map(rowIndex_1)(colIndex_1)) > 0 And map(rowIndex_1)(colIndex_1) <> "" And round = "w" Then// 红色方走棋，且走棋点1本身是红子，从1走到2（红吃黑）
map(rowIndex_2)(colIndex_2) = map(rowIndex_1)(colIndex_1)
map(rowIndex_1)(colIndex_1) = ""
Else // 2走到1
map(rowIndex_1)(colIndex_1) = map(rowIndex_2)(colIndex_2)
map(rowIndex_2)(colIndex_2) = ""
End If
// 交换回合
If round = myColor Then
round = oppositeColor
Else
round = myColor
End If
Call 生成FEN局面代码
End Sub
