|
|
Private Sub ComboBox1_Change()
On Error GoTo ren
Call 再来一局_Click
ReDim arr2(1 To 1)
arr2(1) = "棋谱"
UserForm2.ListBox1.List = arr2
Dim xi
xi = Sheets("棋谱").Cells(ComboBox1.ListIndex + 1, 2)
ReDim qipu(1 To 10, 1 To 9, 1 To 3, 0 To Len(xi) / 4 + 1)
For i = 1 To 10
For ii = 1 To 9
qipu(i, ii, 1, 0) = arr(i, ii, 1)
qipu(i, ii, 2, 0) = arr(i, ii, 4)
qipu(i, ii, 3, 0) = arr(i, ii, 5)
Next ii
Next i
For i = 1 To Len(xi) / 4
UserForm2.ListBox1.AddItem Fix(i / 2) + 1 & " " & Mid(xi, i * 4 - 3, 4)
ReDim arr1(1 To 10, 1 To 9, 1 To 2)
If Fix(i / 2) = i / 2 Then
For ii = 1 To 10
For iii = 1 To 9
If qipu(ii, iii, 2, i - 1) <> "" Then
arr1(ii, iii, 1) = qipu(ii, iii, 2, i - 1)
arr1(ii, iii, 2) = qipu(ii, iii, 3, i - 1)
qipu(ii, iii, 1, i) = qipu(ii, iii, 1, i - 1)
qipu(ii, iii, 2, i) = qipu(ii, iii, 2, i - 1)
qipu(ii, iii, 3, i) = qipu(ii, iii, 3, i - 1)
End If
Next iii
Next ii
Call 走棋(Mid(xi, i * 4 - 3, 4), arr1, x, y, xx, yy)
qipu(xx, yy, 1, i) = qipu(x, y, 1, i)
qipu(xx, yy, 2, i) = qipu(x, y, 2, i)
qipu(xx, yy, 3, i) = qipu(x, y, 3, i)
qipu(x, y, 1, i) = ""
qipu(x, y, 2, i) = ""
qipu(x, y, 3, i) = ""
Else
For ii = 1 To 10
For iii = 1 To 9
If qipu(ii, iii, 2, i - 1) <> "" Then
arr1(11 - ii, 10 - iii, 1) = qipu(ii, iii, 2, i - 1) * -1
arr1(11 - ii, 10 - iii, 2) = qipu(ii, iii, 3, i - 1)
qipu(ii, iii, 1, i) = qipu(ii, iii, 1, i - 1)
qipu(ii, iii, 2, i) = qipu(ii, iii, 2, i - 1)
qipu(ii, iii, 3, i) = qipu(ii, iii, 3, i - 1)
End If
Next iii
Next ii
Call 走棋(Mid(xi, i * 4 - 3, 4), arr1, x, y, xx, yy)
x = 11 - x
y = 10 - y
xx = 11 - xx
yy = 10 - yy
qipu(xx, yy, 1, i) = qipu(x, y, 1, i)
qipu(xx, yy, 2, i) = qipu(x, y, 2, i)
qipu(xx, yy, 3, i) = qipu(x, y, 3, i)
qipu(x, y, 1, i) = ""
qipu(x, y, 2, i) = ""
qipu(x, y, 3, i) = ""
End If
Next i
Exit Sub
ren:
MsgBox ("错误")
End Sub
Private Sub CommandButton1_Click()
If Me.ListBox1.ListCount < 3 Then Exit Sub
If Me.ListBox1.ListIndex + 1 < Me.ListBox1.ListCount Then
Me.ListBox1.ListIndex = Me.ListBox1.ListIndex + 1
End If
End Sub
Private Sub CommandButton12_Click()
Dim x1
Dim x2
Dim x3
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then Me.Controls(arr(i, ii, 1)).Visible = 0
Next ii
Next i
For ii = 1 To 5
For iii = 1 To 9
x1 = arr(ii, iii, 1)
x2 = arr(ii, iii, 4)
If x2 <> "" Then x2 = x2 * -1
x3 = arr(ii, iii, 5)
arr(ii, iii, 1) = arr(11 - ii, 10 - iii, 1)
arr(ii, iii, 4) = arr(11 - ii, 10 - iii, 4)
If arr(ii, iii, 4) <> "" Then arr(ii, iii, 4) = arr(ii, iii, 4) * -1
arr(ii, iii, 5) = arr(11 - ii, 10 - iii, 5)
arr(11 - ii, 10 - iii, 1) = x1
arr(11 - ii, 10 - iii, 4) = x2
arr(11 - ii, 10 - iii, 5) = x3
Next iii
Next ii
If Me.ListBox1.ListCount > 2 Then
For i = 0 To Me.ListBox1.ListCount
For ii = 1 To 5
For iii = 1 To 9
x1 = qipu(ii, iii, 1, i)
x2 = qipu(ii, iii, 2, i)
If x2 <> "" Then x2 = x2 * -1
x3 = qipu(ii, iii, 3, i)
qipu(ii, iii, 1, i) = qipu(11 - ii, 10 - iii, 1, i)
qipu(ii, iii, 2, i) = qipu(11 - ii, 10 - iii, 2, i)
If qipu(ii, iii, 2, i) <> "" Then qipu(ii, iii, 2, i) = qipu(ii, iii, 2, i) * -1
qipu(ii, iii, 3, i) = qipu(11 - ii, 10 - iii, 3, i)
qipu(11 - ii, 10 - iii, 1, i) = x1
qipu(11 - ii, 10 - iii, 2, i) = x2
qipu(11 - ii, 10 - iii, 3, i) = x3
Next iii
Next ii
Next i
End If
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then
Me.Controls(arr(i, ii, 1)).Left = arr(i, ii, 2)
Me.Controls(arr(i, ii, 1)).Top = arr(i, ii, 3)
Me.Controls(arr(i, ii, 1)).Visible = 1
Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectFlat
End If
Next ii
Next i
End Sub
Private Sub CommandButton2_Click()
If Me.ListBox1.ListCount < 3 Then Exit Sub
If Me.ListBox1.ListIndex > 0 Then
Me.ListBox1.ListIndex = Me.ListBox1.ListIndex - 1
End If
End Sub
Private Sub CommandButton3_Click()
If Me.ListBox1.ListCount < 3 Then Exit Sub
Me.ListBox1.ListIndex = 1
End Sub
Private Sub CommandButton4_Click()
If Me.ListBox1.ListCount < 3 Then Exit Sub
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
End Sub
Private Sub ListBox1_Click()
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then
Me.Controls(arr(i, ii, 1)).Visible = 0
Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectFlat
End If
arr(i, ii, 1) = qipu(i, ii, 1, Me.ListBox1.ListIndex)
arr(i, ii, 4) = qipu(i, ii, 2, Me.ListBox1.ListIndex)
arr(i, ii, 5) = qipu(i, ii, 3, Me.ListBox1.ListIndex)
Next ii
Next i
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then
Me.Controls(arr(i, ii, 1)).Left = arr(i, ii, 2)
Me.Controls(arr(i, ii, 1)).Top = arr(i, ii, 3)
Me.Controls(arr(i, ii, 1)).Visible = 1
If Me.ListBox1.ListIndex > 0 Then
If arr(i, ii, 1) <> qipu(i, ii, 1, Me.ListBox1.ListIndex - 1) Then
Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectBump
End If
End If
End If
Next ii
Next i
End Sub
'加载象棋
Private Sub CommandButton10_Click()
Me.Label4.Caption = "提示:棋谱播放"
Sheets("棋谱").Activate
qipu = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row + 1, 1))
ComboBox1.List = qipu
End Sub
Private Sub CommandButton11_Click()
If a <> 0 Then
For iii = 1 To 10
For iiii = 1 To 9
If arr(iii, iiii, 1) = a Then
x = iii
y = iiii
End If
Next iiii
Next iii
If x = i And y = ii Then Exit Sub
Me.Controls(a).Visible = 0
arr(x, y, 1) = ""
arr(x, y, 4) = ""
arr(x, y, 5) = ""
a = 0
End If
End Sub
Private Sub CommandButton5_Click()
Dim z As Long
z = Sheets("棋谱").Cells(65536, 1).End(xlUp).Row + 1
Sheets("棋谱").Cells(z, 1) = InputBox("请输入名称")
Sheets("棋谱").Cells(z, 2) = kj
End Sub
Private Sub CommandButton6_Click()
Label4.Caption = "提示:人工智能已启动"
End Sub
'悔棋
Private Sub CommandButton7_Click()
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> arrfq(i, ii, 1) Then GoTo ren
Next ii
Next i
ren:
UserForm2.ListBox2.List(UserForm2.ListBox2.ListCount - 1, 0) = ""
If i > 10 Then Exit Sub
kj = Mid(kj, 1, Len(kj) - 8)
arr = arrfq
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then
Me.Controls(arr(i, ii, 1)).Left = arr(i, ii, 2)
Me.Controls(arr(i, ii, 1)).Top = arr(i, ii, 3)
Me.Controls(arr(i, ii, 1)).Visible = 1
Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectFlat
End If
Next ii
Next i
End Sub
Private Sub CommandButton8_Click()
Label4.Caption = "提示:移动棋子"
End Sub
Private Sub Image2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Me.Label4.Caption = "提示:棋谱播放" Then Exit Sub
For i = 1 To 10
For ii = 1 To 9
If x > arr(i, ii, 2) And x < arr(i, ii, 2) + 30 And y > arr(i, ii, 3) And y < arr(i, ii, 3) + 30 Then
If a <> 0 Then
If Label4.Caption = "提示:人工智能已启动" Then
If arr(i, ii, 4) = -1 Then
Me.Controls(a).SpecialEffect = fmSpecialEffectFlat
a = arr(i, ii, 1)
Me.Controls(a).SpecialEffect = fmSpecialEffectBump
Exit Sub
Else
Call gogo(i, ii)
End If
Else
For iii = 1 To 10
For iiii = 1 To 9
If arr(iii, iiii, 1) = a Then
x = iii
y = iiii
End If
Next iiii
Next iii
If x = i And y = ii Then Exit Sub
Call 移动棋子(x, y, i, ii)
End If
Else
If arr(i, ii, 4) = -1 Or (Label4.Caption = "提示:移动棋子" And arr(i, ii, 4) = 1) Then
a = arr(i, ii, 1)
Me.Controls(a).SpecialEffect = fmSpecialEffectBump
End If
End If
End If
Next ii
Next i
End Sub
Private Sub ListBox2_Click()
End Sub
Private Sub OptionButton1_Click()
电脑水平 = 3
End Sub
Private Sub OptionButton2_Click()
电脑水平 = 4
End Sub
Private Sub OptionButton3_Click()
电脑水平 = 5
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ActiveWorkbook.Save
ActiveWorkbook.Close
End
End Sub
Private Sub 再来一局_Click()
Dim i As Long
Dim ii As Long
行宽 = Image1.Width * 0.108
列宽 = Image1.Height * 0.093
ReDim arr(1 To 10, 1 To 9, 1 To 5) '分别记录棋子图片控件名称，位置
For i = 1 To 10
For ii = 1 To 9
arr(i, ii, 2) = 4 + (ii - 1) * 行宽
arr(i, ii, 3) = 11 + (i - 1) * 列宽
Next ii
Next i
'将棋子图片名称载入数据
arr(1, 1, 1) = "Image011"
arr(1, 2, 1) = "Image012"
arr(1, 3, 1) = "Image013"
arr(1, 4, 1) = "Image014"
arr(1, 5, 1) = "Image015"
arr(1, 6, 1) = "Image016"
arr(1, 7, 1) = "Image017"
arr(1, 8, 1) = "Image018"
arr(1, 9, 1) = "Image019"
arr(3, 2, 1) = "Image032"
arr(3, 8, 1) = "Image038"
arr(4, 1, 1) = "Image041"
arr(4, 3, 1) = "Image043"
arr(4, 5, 1) = "Image045"
arr(4, 7, 1) = "Image047"
arr(4, 9, 1) = "Image049"
'1代表红棋
arr(1, 1, 4) = 1
arr(1, 2, 4) = 1
arr(1, 3, 4) = 1
arr(1, 4, 4) = 1
arr(1, 5, 4) = 1
arr(1, 6, 4) = 1
arr(1, 7, 4) = 1
arr(1, 8, 4) = 1
arr(1, 9, 4) = 1
arr(3, 2, 4) = 1
arr(3, 8, 4) = 1
arr(4, 1, 4) = 1
arr(4, 3, 4) = 1
arr(4, 5, 4) = 1
arr(4, 7, 4) = 1
arr(4, 9, 4) = 1
'各棋子的等效值
arr(1, 1, 5) = 999 '车
arr(1, 2, 5) = 500 '马
arr(1, 3, 5) = 300 '相
arr(1, 4, 5) = 400 '士
arr(1, 5, 5) = 80000 '将
arr(1, 6, 5) = 400 '士
arr(1, 7, 5) = 300 '相
arr(1, 8, 5) = 500 '马
arr(1, 9, 5) = 999 '车
arr(3, 2, 5) = 600 '炮
arr(3, 8, 5) = 600 '炮
arr(4, 1, 5) = 100 '兵
arr(4, 3, 5) = 100 '兵
arr(4, 5, 5) = 100 '兵
arr(4, 7, 5) = 100 '兵
arr(4, 9, 5) = 100 '兵
'将棋子图片名称载入数据
arr(10, 1, 1) = "Image101"
arr(10, 2, 1) = "Image102"
arr(10, 3, 1) = "Image103"
arr(10, 4, 1) = "Image104"
arr(10, 5, 1) = "Image105"
arr(10, 6, 1) = "Image106"
arr(10, 7, 1) = "Image107"
arr(10, 8, 1) = "Image108"
arr(10, 9, 1) = "Image109"
arr(8, 2, 1) = "Image082"
arr(8, 8, 1) = "Image088"
arr(7, 1, 1) = "Image071"
arr(7, 3, 1) = "Image073"
arr(7, 5, 1) = "Image075"
arr(7, 7, 1) = "Image077"
arr(7, 9, 1) = "Image079"
'-1代表黑棋
arr(10, 1, 4) = -1
arr(10, 2, 4) = -1
arr(10, 3, 4) = -1
arr(10, 4, 4) = -1
arr(10, 5, 4) = -1
arr(10, 6, 4) = -1
arr(10, 7, 4) = -1
arr(10, 8, 4) = -1
arr(10, 9, 4) = -1
arr(8, 2, 4) = -1
arr(8, 8, 4) = -1
arr(7, 1, 4) = -1
arr(7, 3, 4) = -1
arr(7, 5, 4) = -1
arr(7, 7, 4) = -1
arr(7, 9, 4) = -1
arr(10, 1, 5) = 999 '车
arr(10, 2, 5) = 500 '马
arr(10, 3, 5) = 300 '相
arr(10, 4, 5) = 400 '士
arr(10, 5, 5) = 80000 '将
arr(10, 6, 5) = 400 '士
arr(10, 7, 5) = 300 '相
arr(10, 8, 5) = 500 '马
arr(10, 9, 5) = 999 '车
arr(8, 2, 5) = 600 '炮
arr(8, 8, 5) = 600 '炮
arr(7, 1, 5) = 100 '兵
arr(7, 3, 5) = 100 '兵
arr(7, 5, 5) = 100 '兵
arr(7, 7, 5) = 100 '兵
arr(7, 9, 5) = 100 '兵
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) <> "" Then
Me.Controls(arr(i, ii, 1)).Left = arr(i, ii, 2)
Me.Controls(arr(i, ii, 1)).Top = arr(i, ii, 3)
Me.Controls(arr(i, ii, 1)).Visible = 1
Me.Controls(arr(i, ii, 1)).SpecialEffect = fmSpecialEffectFlat
End If
Next ii
Next i
arrfq = arr
ar1 = arr
ar2 = arr
Sheets("开局").Activate
kjk = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row + 10, 1))
kj = ""
ReDim arr1(1 To 1)
arr1(1) = "棋谱 "
UserForm2.ListBox2.List = arr1
End Sub
Private Sub 退出_Click()
ActiveWorkbook.Save
ActiveWorkbook.Close
End
End Sub
Private Sub UserForm_Activate()
电脑水平 = 5
OptionButton3.Value = 1
Call 再来一局_Click
End Sub
Sub gogo(xx, yy) '是否可以走
arrfq = arr '返回
Dim x As Long
Dim y As Long
Dim pgz As Long
'找到坐标
For i = 1 To 10
For ii = 1 To 9
If arr(i, ii, 1) = a Then
x = i
y = ii
End If
Next ii
Next i
'车
If arr(x, y, 5) = 999 Then
If x = xx Then
If y > yy Then
For i = y - 1 To yy + 1 Step -1
If arr(x, i, 1) <> "" Then Exit Sub
Next i
Else
For i = y + 1 To yy - 1
If arr(x, i, 1) <> "" Then Exit Sub
Next i
End If
End If
If y = yy Then
If x > xx Then
For i = x - 1 To xx + 1 Step -1
If arr(i, y, 1) <> "" Then Exit Sub
Next i
Else
For i = x + 1 To xx - 1
If arr(i, y, 1) <> "" Then Exit Sub
Next i
End If
End If
If x = xx Or y = yy Then
Call 移动棋子(x, y, xx, yy)
End If
End If
'马
If arr(x, y, 5) = 500 Then
If (x - xx = 1 Or xx - x = 1) And (y - yy = 2 Or yy - y = 2) Then
If arr(x, y + (yy - y) / 2, 1) <> "" Then Exit Sub
Call 移动棋子(x, y, xx, yy)
End If
If (x - xx = 2 Or xx - x = 2) And (y - yy = 1 Or yy - y = 1) Then
If arr(x + (xx - x) / 2, y, 1) <> "" Then Exit Sub
Call 移动棋子(x, y, xx, yy)
End If
End If
'相
If arr(x, y, 5) = 300 Then
If (x - xx = 2 Or xx - x = 2) And (y - yy = 2 Or yy - y = 2) Then
If arr(x, y, 4) = 1 And xx > 5 Then Exit Sub
If arr(x, y, 2) = -1 And xx < 6 Then Exit Sub
If arr(x + (xx - x) / 2, y + (yy - y) / 2, 1) <> "" Then Exit Sub
Call 移动棋子(x, y, xx, yy)
End If
End If
'士
If arr(x, y, 5) = 400 Then
If (x - xx = 1 Or xx - x = 1) And (y - yy = 1 Or yy - y = 1) Then
If arr(x, y, 4) = 1 And (yy < 4 Or yy > 6 Or xx > 3) Then Exit Sub
If arr(x, y, 2) = -1 And (yy < 4 Or yy > 6 Or xx < 8) Then Exit Sub
Call 移动棋子(x, y, xx, yy)
End If
End If
'将
If arr(x, y, 5) = 80000 Then
If y = yy And xx < 5 Then
For i = x - 1 To xx Step -1
If arr(i, y, 1) <> "" Then
If arr(i, y, 5) = 80000 Then Call 移动棋子(x, y, xx, yy)
Exit For
End If
Next i
End If
If ((x - xx = 1 Or xx - x = 1) And y = yy) Or (x = xx And (y - yy = 1 Or yy - y = 1)) Then
If arr(x, y, 4) = 1 And (yy < 4 Or yy > 6 Or xx > 3) Then Exit Sub
If arr(x, y, 4) = -1 And (yy < 4 Or yy > 6 Or xx < 8) Then Exit Sub
Call 移动棋子(x, y, xx, yy)
End If
End If
'炮
If arr(x, y, 5) = 600 Then
If arr(xx, yy, 1) = "" Then
If x = xx Then
If y > yy Then
For i = y - 1 To yy + 1 Step -1
If arr(x, i, 1) <> "" Then Exit Sub
Next i
Else
For i = y + 1 To yy - 1
If arr(x, i, 1) <> "" Then Exit Sub
Next i
End If
End If
If y = yy Then
If x > xx Then
For i = x - 1 To xx + 1 Step -1
If arr(i, y, 1) <> "" Then Exit Sub
Next i
Else
For i = x + 1 To xx - 1
If arr(i, y, 1) <> "" Then Exit Sub
Next i
End If
End If
Else
pgz = 0
If x = xx Then
If y > yy Then
For i = y - 1 To yy + 1 Step -1
If arr(x, i, 1) <> "" Then pgz = pgz + 1
Next i
Else
For i = y + 1 To yy - 1
If arr(x, i, 1) <> "" Then pgz = pgz + 1
Next i
End If
End If
If y = yy Then
If x > xx Then
For i = x - 1 To xx + 1 Step -1
If arr(i, y, 1) <> "" Then pgz = pgz + 1
Next i
Else
For i = x + 1 To xx - 1
If arr(i, y, 1) <> "" Then pgz = pgz + 1
Next i
End If
End If
If pgz <> 1 Then Exit Sub
End If
If xx = x Or y = yy Then
Call 移动棋子(x, y, xx, yy)
End If
End If
'兵
If arr(x, y, 5) = 100 Then
If arr(x, y, 4) = 1 And ((xx - x = 1 And y = yy) Or (x = xx And (y - yy = 1 Or yy - y = 1) And x > 5)) Then
Call 移动棋子(x, y, xx, yy)
End If
If arr(x, y, 4) = -1 And ((x - xx = 1 And y = yy) Or (x = xx And (y - yy = 1 Or yy - y = 1) And x < 6)) Then
Call 移动棋子(x, y, xx, yy)
End If
End If
UserForm2.Label2.Caption = "电脑正在思考！"
DoEvents
If a = 0 And Image015.Visible = True And Image105.Visible = True Then Call peng
If Image015.Visible = False Then MsgBox "电脑输了"
If Image105.Visible = False Then MsgBox "你输了"
End Sub
|
|
IP卡
狗仔卡
发表于 2014-3-29 23:54
提升卡
置顶卡
沉默卡
喧嚣卡
变色卡
抢沙发
千斤顶
显身卡
发表于 2014-3-29 23:58
发表于 2014-3-30 10:17
