中国象棋（主体功能）

‘ 这只是一个半成品。作于大三上学期元旦左右。可惜当初没坚持写完啊。

Option Explicit
Dim panmian(240) As Integer
Dim weizhi(32) As Integer
Dim zili(32) As Integer
Dim pos0 As Integer, pos1 As Integer, pos2 As Integer
'开始盘面
Private Sub initboard()
Dim i As Integer
For i = 1 To 240
panmian(i) = 0
Next i
For i = 1 To 32
Picture(i).Visible = True
Next i
panmian(188) = zili(32): panmian(187) = zili(30): panmian(189) = zili(31)
panmian(186) = zili(28): panmian(190) = zili(29): panmian(184) = zili(17)
panmian(192) = zili(18): panmian(185) = zili(19): panmian(191) = zili(20)
panmian(161) = zili(22): panmian(139) = zili(23): panmian(155) = zili(21)
panmian(141) = zili(24): panmian(143) = zili(25): panmian(147) = zili(27)
panmian(145) = zili(26): panmian(53) = zili(16): panmian(52) = zili(14)
panmian(54) = zili(15): panmian(51) = zili(12): panmian(57) = zili(2)
panmian(55) = zili(13): panmian(49) = zili(1): panmian(50) = zili(3)
panmian(56) = zili(4): panmian(80) = zili(5): panmian(86) = zili(6)
panmian(96) = zili(8): panmian(98) = zili(9): panmian(94) = zili(7)
panmian(100) = zili(10): panmian(102) = zili(11)

weizhi(32) = 188: weizhi(30) = 187: weizhi(31) = 189: weizhi(28) = 186
weizhi(29) = 190: weizhi(17) = 184: weizhi(18) = 192: weizhi(19) = 185
weizhi(20) = 191: weizhi(21) = 155: weizhi(22) = 161: weizhi(23) = 139
weizhi(24) = 141: weizhi(25) = 143: weizhi(26) = 145: weizhi(27) = 147
weizhi(16) = 53: weizhi(14) = 52: weizhi(15) = 54: weizhi(12) = 51
weizhi(13) = 55: weizhi(1) = 49: weizhi(2) = 57: weizhi(3) = 50
weizhi(4) = 56: weizhi(5) = 80: weizhi(6) = 86: weizhi(7) = 94
weizhi(8) = 96: weizhi(9) = 98: weizhi(10) = 100: weizhi(11) = 102
End Sub
'产生红方全部合法着手
Private Sub redzoufa(a0(), a1(), a2())
Dim k(19) As Integer, i As Integer, h As Integer, v As Integer, x As Integer
a1(0) = 0
For i = 1 To 16
Select Case i
If weizhi(i) <> 0 Then
Case 16                                                         '红帅
  k(0) = 4
  k(1) = weizhi(16) + 1: k(2) = weizhi(16) - 1
  k(3) = weizhi(16) + 15: k(4) = weizhi(16) - 15
Case 14, 15                                                     '红士
  k(0) = 4
  k(1) = weizhi(i) + 14: k(2) = weizhi(i) + 16
  k(3) = weizhi(i) - 16: k(4) = weizhi(i) - 14
Case 12, 13                                                     '红相
  k(0) = 4
  k(1) = weizhi(i) + 28: k(2) = weizhi(i) + 32
  k(2) = weizhi(i) - 32: k(4) = weizhi(i) - 28
Case 7 To 11                                            '红兵
  k(0) = 3
  k(1) = weizhi(i) + 15: k(2) = weizhi(i) + 1: k(3) = weizhi(i) - 1
Case 3, 4                                                       '红马
  k(0) = 8
  k(1) = weizhi(i) + 13: k(2) = weizhi(i) + 17
  k(3) = weizhi(i) - 17: k(4) = weizhi(i) - 13
  k(5) = weizhi(i) + 29: k(6) = weizhi(i) + 31
  k(7) = weizhi(i) - 31: k(8) = weizhi(i) - 29
Case 1, 2, 5, 6                                               '红车，红炮
  k(0) = 0
  h = (weizhi(i) - 1) Mod 15 + 1
  v = (weizhi(i) - 1) / 15
  For x = 4 To 12                                              '水平移动
   k(0) = k(0) + 1
   k(k(0)) = v * 15 + 1
  Next x
  For x = 3 To 12                                              '垂直移动
   k(0) = k(0) + 1
   k(k(0)) = h + 15 * x
  Next x
End Select
For x = 1 To k(0)
If hefa(i, weizhi(i), k(i), panmian(), weizhi()) Then
  a1(0) = a1(0) + 1
  a0(a1(0)) = i
  a1(a1(0)) = weizhi(i)
  a2(a1(0)) = k(i)
End If
Next x: End If: Next i
End Sub
'产生黑方全部合法着手
Private Sub blackzoufa(a0(), a1(), a2())
Dim k(19) As Integer, i As Integer, h As Integer, v As Integer, x As Integer
a1(0) = 0
For i = 17 To 32
Select Case i
If weizhi(i) <> 0 Then
Case 32                                                      '黑将
  k(0) = 4
  k(1) = weizhi(32) + 1: k(2) = weizhi(32) - 1
  k(3) = weizhi(32) + 15: k(4) = weizhi(32) - 15
Case 30, 31                                                    '黑士
  k(0) = 4
  k(1) = weizhi(i) + 14: k(2) = weizhi(i) + 16
  k(3) = weizhi(i) - 16: k(4) = weizhi(i) - 14
Case 28, 29                                                   '黑相
  k(0) = 4
  k(1) = weizhi(i) + 28: k(2) = weizhi(i) + 32
  k(2) = weizhi(i) - 32: k(4) = weizhi(i) - 28
Case 23 To 27                                            '黑卒
  k(0) = 3
  k(1) = weizhi(i) - 15: k(2) = weizhi(i) + 1: k(3) = weizhi(i) - 1
Case 19, 20                                                    '黑马
  k(0) = 8
  k(1) = weizhi(i) + 13: k(2) = weizhi(i) + 17
  k(3) = weizhi(i) - 17: k(4) = weizhi(i) - 13
  k(5) = weizhi(i) + 29: k(6) = weizhi(i) + 31
  k(7) = weizhi(i) - 31: k(8) = weizhi(i) - 29
Case 17, 18, 21, 22                                        '黑车，黑炮
  k(0) = 0
  h = (weizhi(i) - 1) Mod 15 + 1
  v = (weizhi(i) - 1) / 15
  For x = 4 To 12                                          '水平移动
   k(0) = k(0) + 1
   k(k(0)) = v * 15 + 1
  Next x
  For x = 3 To 12                                           '垂直移动
   k(0) = k(0) + 1
   k(k(0)) = h + 15 * x
  Next x
End Select
For x = 1 To k(0)
If hefa(i, weizhi(i), k(i), panmian(), weizhi()) Then
  a1(0) = a1(0) + 1
  a0(a1(0)) = i
  a1(a1(0)) = weizhi(i)
  a2(a1(0)) = k(i)
End If
Next x: End If: Next i
End Sub

'判断着手是否合法
Function hefa(ByRef c, ByRef dest, ByRef obj) As Boolean
Dim h1 As Integer, v1 As Integer, h2 As Integer, v2 As Integer
Dim i As Integer, j As Integer
hefa = False
If c = 0 Or dest = 0 Or obj = 0 Then Exit Function
If dest = obj Then Exit Function
If c < 17 And panmian(obj) > 0 Then Exit Function
If c > 16 And panmian(obj) < 0 Then Exit Function
h1 = (dest - 1) Mod 15 + 1: v1 = (dest - 1) / 15 + 1
h2 = (obj - 1) Mod 15 + 1: v2 = (obj - 1) / 15 + 1
Select Case c
 Case 14, 15                                                     '红士
  If h2 < 7 Or h2 > 9 Or v2 < 4 Or v2 > 6 Then Exit Function
  If Abs(dest - obj) <> 14 And Abs(dest - obj) <> 16 Then Exit Function
 Case 30, 31                                                      '黑士
  If h2 < 7 Or h2 > 9 Or v2 < 11 Or v2 > 13 Then Exit Function
  If Abs(dest - obj) <> 14 And Abs(dest - obj) <> 16 Then Exit Function
 Case 12, 13                                                      '红相
  If (obj <> 51) And (obj <> 55) And (obj <> 79) And (obj <> 83) And (obj <> 87) _
  And (obj <> 111) And (obj <> 115) Then Exit Function
  If Abs(h1 - h2) <> 2 Or Abs(v1 - v2) <> 2 Then Exit Function
  If panmian((dest + obj) / 2) <> 0 Then Exit Function
 Case 28, 29                                                       '黑相
  If (obj <> 126) And (obj <> 130) And (obj <> 154) And (obj <> 158) And (obj <> 162) _
  And (obj <> 186) And (obj <> 190) Then Exit Function
  If Abs(h1 - h2) <> 2 Or Abs(v1 - v2) <> 2 Then Exit Function
  If panmian((dest + obj) / 2) <> 0 Then Exit Function
 Case 3, 4, 19, 20                                                 '红马和黑马
  If Abs(h1 - h2) <> 1 And Abs(v1 - v2) <> 1 Or Abs(h1 - h2) <> 2 And Abs(v1 - v2) <> 2 Then Exit Function
  If h2 - h1 = 2 And panmian(dest + 1) <> 0 Then Exit Function
  If v2 - v1 = 2 And panmian(dest + 15) <> 0 Then Exit Function
  If h1 - h2 = 2 And panmian(dest - 1) <> 0 Then Exit Function
  If v1 - v2 = 2 And panmian(dest - 15) <> 0 Then Exit Function
 Case 7 To 11                                                  '红兵
  If dest - obj = 15 Then Exit Function
  If dest < 118 And obj - dest <> 15 Then Exit Function
  If dest > 118 And obj - dest <> 15 And Abs(obj - dest) <> 1 Then Exit Function
 Case 23 To 27                                                  '黑卒
  If obj - dest = 15 Then Exit Function
  If dest > 123 And dest - obj <> 15 Then Exit Function
  If dest < 123 And dest - obj <> 15 And Abs(dest - obj) <> 1 Then Exit Function
 Case 1, 2, 17, 18                                              '红车和黑车
  If (h1 <> h2) And (v1 <> v2) Then Exit Function
  If v1 = v2 Then                               '水平移动
   If h1 < h2 Then
    For i = dest + 1 To obj
     If panmian(i) <> 0 Then j = j + 1
    Next i
   Else
    For i = obj To dest - 1
     If panmian(i) <> 0 Then j = j + 1
    Next i
   End If
  If j > 1 Then Exit Function
  End If
  If h1 = h2 Then                              '垂直移动
   If v1 < v2 Then
    For i = (dest + 15) To obj Step 15
     If panmian(i) <> 0 Then j = j + 1
    Next i
   Else
    For i = obj To (dest - 15) Step 15
     If panmian(i) <> 0 Then j = j + 1
    Next i
   End If
  If j > 1 Then Exit Function
  End If
 Case 5, 6, 21, 22                                            '红炮和黑炮
  If (h1 <> h2) And (v1 <> v2) Then Exit Function
  If v1 = v2 Then                               '水平移动
   If h1 < h2 Then
    For i = dest + 1 To obj
     If panmian(i) <> 0 Then j = j + 1
    Next i
   Else
    For i = obj To dest - 1
     If panmian(i) <> 0 Then j = j + 1
    Next i
   End If
  If j <> 0 And i <> 2 Then Exit Function
  End If
  If h1 = h2 Then                              '垂直移动
   If v1 < v2 Then
    For i = (dest + 15) To obj Step 15
     If panmian(i) <> 0 Then j = j + 1
    Next i
   Else
    For i = obj To (dest - 15) Step 15
     If panmian(i) <> 0 Then j = j + 1
    Next i
   End If
  If j <> 0 And j <> 2 Then Exit Function
  End If
 Case 16                                             '红帅
  If h2 < 7 Or h2 > 9 Or v2 < 4 Or v2 > 6 Then Exit Function
  If Abs(dest - obj) <> 1 And Abs(dest - obj) <> 15 Then Exit Function
  If (obj - 1) Mod 15 = (weizhi(32) - 1) Mod 15 Then     '不可对面笑
   For i = obj + 15 To (weizhi(32) - 15) Step 15
   If panmian(i) <> 0 Then hefa = True: Exit Function
   Next i
  End If
 Case 32                                             '黑将
  If h2 < 7 Or h2 > 9 Or v2 < 11 Or v2 > 13 Then Exit Function
  If Abs(dest - obj) <> 1 And Abs(dest - obj) <> 15 Then Exit Function
  If (weizhi(16) - 1) Mod 15 = (obj - 1) Mod 15 Then         '不可对面笑
   For i = weizhi(16) + 15 To (obj - 15) Step 15
   If panmian(i) <> 0 Then hefa = True: Exit Function
   Next i
  End If
End Select
hefa = True
End Function

'红方树状查找
Function minmax_red(ByRef upsc, x, ByRef m1, ByRef m2, level) As Integer
Dim m As Integer, sc As Integer, n As Integer, k As Integer, l As Integer
Dim j As Integer, j0 As Integer, j1 As Integer, j2 As Integer
Select Ca** *
 Ca** * > level
  minmax_red = shenju(panmian(), weizhi())
  Exit Function
 Case 1, 3, 5, 7, 9
   m = -32767
   ReDim a0(1 To 90), a1(90), a2(1 To 90)
   Call redzoufa(a0(), a1(), a2())
   For j = 1 To a1(0)
    j0 = a0(j)
    j1 = a1(j)
    j2 = a2(j)
    If j2 = weizhi(32) Then             '判断是否吃掉黑将
      minmax_red = 32760
      m1 = j1
      m2 = j2
    Exit Function
    End If
    k = panmian(j2)               '记下目的位置的值
    panmian(j2) = panmian(j1)
    panmian(j1) = 0
    l = 0                            '移动棋子
    weizhi(j0) = j2
    For i = 17 To 36
     If weizhi(i) = j2 Then          '判断是否吃子
       weizhi(i) = 0
       l = i
       Exit For
     End If
    Next i
    sc = minmax_red(m, x + 1, X1, X2, level)
    If sc > m Then
     n = j0
     m1 = a1(j)
     m2 = a2(j)
     m = sc
    End If
    panmian(j1) = panmian(j2)
    panmian(j2) = k
    weizhi(j0) = j1               '放回移动的棋子
    weizhi(l) = j2                '放回被吃的棋子
   If m > upsc And upsc <> -32767 Then Exit For
   Next j
 Case 2, 4, 6, 8, 10
    m = 32767
    ReDim a0(1 To 90), a1(90), a2(1 To 90)
   Call blackzoufa(a0(), a1(), a2())
   For j = 1 To a1(0)
    j0 = a0(j)
    j1 = a1(j)
    j2 = a2(j)
    If j2 = weizhi(16) Then             '判断是否吃掉红帅
      minmax_red = -32760
      m1 = j1
      m2 = j2
    Exit Function
    End If
    k = panmian(j2)               '记下目的位置的值
    panmian(j2) = panmian(j1)
    panmian(j1) = 0
    l = 0                            '移动棋子
    weizhi(j0) = j2
    For i = 17 To 36
     If weizhi(i) = j2 Then          '判断是否吃子
       weizhi(i) = 0
       l = i
       Exit For
     End If
    Next i
    sc = minmax_red(m, x + 1, X1, X2, level)
    If sc < m Then
     n = j0
     m1 = a1(j)
     m2 = a2(j)
     m = sc
    End If
    panmian(j1) = panmian(j2)
    panmian(j2) = k
    weizhi(j0) = j1               '放回移动的棋子
    weizhi(l) = j2                '放回被吃的棋子
   If m < upsc And upsc <> 32767 Then Exit For '不等于32767是因为第一节点不考察
   Next j
End Function
'移动棋子
Private Sub movechess(m1 As Integer, m2 As Integer)
Dim i As Integer
panmian(m2) = panmian(m1)
panmian(m1) = 0
For i = 1 To 16
 If weizhi(i) = m1 Then
  weizhi(i) = m2
 End If
Next i
For i = 17 To 32
 If weizhi(i) = m2 Then
  weizhi(i) = 0
  Picture(i).Visible = flase
 End If
Next i
Call showboard  '更新盘面
End Sub
'更新盘面
Private Sub showboard()
Dim i As Integer, h As Integer, v As Integer
For i = 1 To 32
  h = (((weizhi(i) - 1) Mod 15) - 3) * 33
  v = (((weizhi(i) - 1) / 15) - 3) * 33
  picutre(i).Left = h
  picutre(i).Top = v
End Sub
'审局函数
Private Function shenju() As Integer
Dim i As Integer
For i = 1 To 32
 shenju = shenju + zili(i)
Next i
End Function
'用鼠标走棋子
Private Sub Picture1_Click(Index As Integer)
Select Case Index
Case 1 To 16
 pos2 = weizhi(Index)
 If hefa(pos0, pos1, pos2) Then
   Call movechess(pos1, pos2)
   weizhi(Index) = 0
   Picture(Index).Visible = False
   Call red
 End If
Case 17 To 32
 pos0 = Index
 pos1 = weizhi(Index)
 pos2 = 0
End Select
End Sub