vb编程游戏

⑴ 姹傝烦妫嬫父鎴广B浠ｇ爜

VB璺虫嬩唬镰:

绐椾綋浠ｇ爜:
Dim ChessBoard(-2 To 10, -2 To 10) As Byte ''妫嬬洏(8绔*8妫)

Dim x(10) As Integer, y(10) As Integer ''鎼灭储镄勬疮绉嶈蛋娉
Dim x1(10) As Integer, y1(10) As Integer ''鎼灭储镄勬疮绉嶈蛋娉旷殑鍙钖冨瓙鍧愭爣

Dim BestLocate As CHESSER

Dim CurrentPlayer As Byte ''褰揿墠鐜╁
Dim CurrentStep As Integer ''褰揿墠姝

Dim 浜烘満妯″纺 As Boolean

Dim cSel As Byte ''鐜╁堕夋嫨浜嗗摢涓妫嫔瓙

Dim tTemp As Boolean

Const MAXDOWNPOINT = 7

Rem 濡傛灉Cer涓1(榛戞柟)锛屽垯杩斿洖2(绾㈡柟),钖﹀垯杩斿姞1(榛戞柟)
Public Function NextCer(ByVal Cer As Byte) As Byte

NextCer = 1
If Cer = 1 Then NextCer = 2

End Function

Rem 妫嬬洏
Private Sub Initial()

Dim i As Integer, j As Integer

For i = 1 To 8: For j = 1 To 8: ChessBoard(i, j) = 0: Next j: Next i

ChessBoard(1, 2) = 201
ChessBoard(1, 4) = 201
ChessBoard(1, 6) = 201
ChessBoard(1, 8) = 201
ChessBoard(2, 1) = 201
ChessBoard(2, 3) = 201
ChessBoard(2, 5) = 201
ChessBoard(2, 7) = 201
ChessBoard(3, 2) = 201
ChessBoard(3, 4) = 201
ChessBoard(3, 6) = 201
ChessBoard(3, 8) = 201

ChessBoard(6, 1) = 101
ChessBoard(6, 3) = 101
ChessBoard(6, 5) = 101
ChessBoard(6, 7) = 101
ChessBoard(7, 2) = 101
ChessBoard(7, 4) = 101
ChessBoard(7, 6) = 101
ChessBoard(7, 8) = 101
ChessBoard(8, 1) = 101
ChessBoard(8, 3) = 101
ChessBoard(8, 5) = 101
ChessBoard(8, 7) = 101

End Sub

Rem 鍙嶆樉绀猴纸灏嗗睆骞曟樉绀虹殑鍐呭瑰瓨鍏ChessBoard鏁扮粍锛
Private Sub ReDisplay()

Dim i As Integer, j As Integer, k As Integer

k = 0

For i = 1 To 8

For j = 1 To 8

If cbText(k).Text = "" Then ChessBoard(i, j) = 0
If cbText(k).Text = "101" Then ChessBoard(i, j) = 101
If cbText(k).Text = "201" Then ChessBoard(i, j) = 201
If cbText(k).Text = "102" Then ChessBoard(i, j) = 102
If cbText(k).Text = "202" Then ChessBoard(i, j) = 202

k = k + 1

Next j

Next i

End Sub

Rem 鏄剧ず锛埚皢ChessBoard鏁扮粍镄勫唴瀹规樉绀哄埌灞忓箷钖庯级
Private Sub Display()

Dim i As Integer, j As Integer, k As Integer

k = 0

For i = 1 To 8

For j = 1 To 8

If ChessBoard(i, j) = 0 Then

cbText(k).Text = ""

Else

cbText(k).Text = ChessBoard(i, j)

End If

k = k + 1

Next j

Next i

Call 鑳滆礋鍒ゆ柇

End Sub

Rem 鑳滆礋鍒ゆ柇
Private Sub 鑳滆礋鍒ゆ柇()

Dim i As Integer, j As Integer
Dim a As Integer, b As Integer

a = 0: b = 0

For i = 1 To 8

For j = 1 To 8

If Int(ChessBoard(i, j) / 100) = 1 Then a = a + 1 ''璁＄畻鐜╁剁殑妫嫔瓙鏁
If Int(ChessBoard(i, j) / 100) = 2 Then b = b + 1 ''璁＄畻鐢佃剳镄勬嫔瓙鏁

Next j

Next i

If a = 0 Then Call MsgBox("鎴戣耽浜嗭紒", vbOKOnly + 32, "鎻愮ず锛"): Exit Sub
If b = 0 Then Call MsgBox("鎴戣よ緭浜嗭紒", vbOKOnly + 32, "鎻愮ず锛"): Exit Sub

End Sub

Rem 杩斿洖浼板
Private Function CurrentValue(Cer As Byte) As Integer

Dim i As Integer, j As Integer

CurrentValue = 0

For i = 1 To 8

For j = 1 To 8

If Int(ChessBoard(i, j) / 100) = Cer Then _
CurrentValue = CurrentValue + ChessBoard(i, j) Mod 100 * 100 + 100 ''鏄鎴戞柟镄勬嫔瓙,妫嫔瓙涓1锷100鍒,妫嫔瓙涓2锷200鍒

If Int(ChessBoard(i, j) / 100) = NextCer(Cer) Then _
CurrentValue = CurrentValue - (ChessBoard(i, j) Mod 100 * 100 + 100) ''瀵规柟镄勬嫔瓙,妫嫔瓙涓1鍑100鍒,妫嫔瓙涓2鍑200鍒

Next j

Next i

End Function

Rem 濡傛灉Cer鏂筰,j镄勬嫔瓙杩桦彲浠ュ悆瀛愬垯杩斿洖True
Private Function IsLine(Cer As Byte, i As Byte, j As Byte) As Boolean

Dim x As Byte, y As Byte, x1 As Byte, y1 As Byte

IsLine = False

''寮濮嬫悳绱㈡嬬洏

''濡傛灉鏄疌er鏂圭殑妫嫔瓙
If Int(ChessBoard(i, j) / 100) = Cer Then

''钖冨瓙寮忚蛋娉1锛氩嵆濡傛灉锘烘湰璧版硶镄勪綅缃链夊规柟镄勬嫔瓙鍒椤彲浠ヨ烦钖(璧版硶闄愬埗锛欳er涓1鎴栨嫔瓙涓哄姞寮烘嬫墠鍙璧)
If Int(ChessBoard(i - 1, j - 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i - 1) - 1 ''鐩镙囧潗镙
y = (j - 1) - 1
x1 = i - 1 ''钖冨瓙鍧愭爣
y1 = j - 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉2
If Int(ChessBoard(i - 1, j + 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i - 1) - 1
y = (j + 1) + 1
x1 = i - 1
y1 = j + 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉3
If Int(ChessBoard(i + 1, j - 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i + 1) + 1
y = (j - 1) - 1
x1 = i + 1
y1 = j - 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉4
If Int(ChessBoard(i + 1, j + 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i + 1) + 1
y = (j + 1) + 1
x1 = i + 1
y1 = j + 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

End If

End Function

Rem 濡傛灉Cer鏂圭殑妫嫔瓙杩桦彲浠ュ悆瀛愬垯杩斿洖True
Private Function IsLine2(Cer As Byte) As Boolean

Dim x As Byte, y As Byte, x1 As Byte, y1 As Byte
Dim i As Integer, j As Integer

IsLine2 = False

''寮濮嬫悳绱㈡嬬洏
For i = 1 To 8

For j = 1 To 8

''濡傛灉鏄疌er鏂圭殑妫嫔瓙
If Int(ChessBoard(i, j) / 100) = Cer Then

''钖冨瓙寮忚蛋娉1锛氩嵆濡傛灉锘烘湰璧版硶镄勪綅缃链夊规柟镄勬嫔瓙鍒椤彲浠ヨ烦钖(璧版硶闄愬埗锛欳er涓1鎴栨嫔瓙涓哄姞寮烘嬫墠鍙璧)
If Int(ChessBoard(i - 1, j - 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i - 1) - 1 ''鐩镙囧潗镙
y = (j - 1) - 1
x1 = i - 1 ''钖冨瓙鍧愭爣
y1 = j - 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine2 = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉2
If Int(ChessBoard(i - 1, j + 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i - 1) - 1
y = (j + 1) + 1
x1 = i - 1
y1 = j + 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine2 = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉3
If Int(ChessBoard(i + 1, j - 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i + 1) + 1
y = (j - 1) - 1
x1 = i + 1
y1 = j - 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine2 = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

''钖冨瓙寮忚蛋娉4
If Int(ChessBoard(i + 1, j + 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x = (i + 1) + 1
y = (j + 1) + 1
x1 = i + 1
y1 = j + 1

If x > 0 And y > 0 And x < 9 And y < 9 And ChessBoard(x, y) = 0 Then IsLine2 = True '链夊彲钖冨瓙锛岃繑锲泺rue

End If

End If

Next j

Next i

End Function

Rem 鎼灭储绋嫔簭
Private Function Search(Cer As Byte, Steps As Integer, IsTop As Boolean, UpMax As Integer)

Dim a As Integer, b As Integer, b1 As Integer, b2 As Integer, i As Integer, j As Integer, k As Integer, l As Integer, v As Integer
Dim MaxValue As Integer
Dim Sc(40) As CHESSER
Dim IsEat(7) As Boolean ''鎼灭储鍒扮殑7绉嶈蛋娉曟湁娌℃湁钖冨瓙
Dim EAT As Boolean ''链夋病链夊悆瀛

If IsTop Then

List1.Clear

For i = 0 To 40: Sc(i).Allow = False: Next i ';榛樿ゆ儏鍐典笅镓链夎蛋娉旷殕涓嶅厑璁革纴濡傛灉镓链夊煎潎涓篎alse鍒欑殕鍏佽

End If

EAT = False
For i = 0 To 7: IsEat(7) = False: Next i ''榛樿ゆ儏鍐垫墍链夋悳绱㈠埌镄勮蛋娉曢兘娌℃湁钖冨瓙

Steps = Steps - 1

If Steps < 1 And IsLine2(Cer) = False Then

''濡傛灉鎴戞柟镞犲瓙鍙钖冩椂镓嶈繑锲炰及鍊

Search = -CurrentValue(Cer) ''杩斿洖浼板

Exit Function

End If

k = 0

''寮濮嬫悳绱㈡嬬洏
For i = 1 To 8

For j = 1 To 8

''濡傛灉鏄疌er鏂圭殑妫嫔瓙
If Int(ChessBoard(i, j) / 100) = Cer Then

For i1 = 1 To MAXDOWNPOINT: x(i1) = 0: x1(i1) = 0: Next ''x璁拌浇镓链夎蛋娉曪纴娓呯┖x

''鍒楀嚭镓链夎蛋娉

''锘烘湰璧版硶锛氢笂宸︺佷笂鍙炽佷笅宸︺佷笅鍙
x(0) = i - 1: y(0) = j - 1
x(1) = i - 1: y(1) = j + 1
x(2) = i + 1: y(2) = j - 1
x(3) = i + 1: y(3) = j + 1

''妫嫔瓙琛ㄧず鏂规硶锛氱槠妫 101(鏅阃)銆102 (杩囧簳镄勫▉锷涙)
'' 绾㈡ 201(鏅阃)銆202 (杩囧簳镄勫▉锷涙)

''涓嬩竴鍙ヨВ閲婏细濡傛灉鏄锏芥(101銆102)锛屼笉鍏佽稿悗阃锛埚垹闄x(2)銆亁(3)锛
If Cer = 1 And ChessBoard(i, j) Mod 100 <> 2 Then x(2) = -2: x(3) = -2

''涓嬩竴鍙ヨВ閲婏细濡傛灉鏄绾㈡(201銆202)锛屼笉鍏佽稿悗阃锛埚垹闄x(0)銆亁(1)锛
If Cer = 2 And ChessBoard(i, j) Mod 100 <> 2 Then x(0) = -2: x(1) = -2

''钖冨瓙寮忚蛋娉1锛氩嵆濡傛灉锘烘湰璧版硶镄勪綅缃链夊规柟镄勬嫔瓙鍒椤彲浠ヨ烦钖(璧版硶闄愬埗锛欳er涓1鎴栨嫔瓙涓哄姞寮烘嬫墠鍙璧)
If Int(ChessBoard(i - 1, j - 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x(4) = (i - 1) - 1 ''鐩镙囧潗镙
y(4) = (j - 1) - 1
x1(4) = i - 1 ''钖冨瓙鍧愭爣
y1(4) = j - 1

If x(4) > 0 And y(4) > 0 And x(4) < 9 And y(4) < 9 And ChessBoard(x(4), y(4)) = 0 Then _
EAT = True: IsEat(4) = True ''链夊彲钖冨瓙锛屽繀闇璧版ゆワ纴鍏朵綑璧版硶镞犳晥

End If

''钖冨瓙寮忚蛋娉2
If Int(ChessBoard(i - 1, j + 1) / 100) = NextCer(Cer) And (Cer = 1 Or ChessBoard(i, j) Mod 100 = 2) Then

x(5) = (i - 1) - 1
y(5) = (j + 1) + 1
x1(5) = i - 1
y1(5) = j + 1

If x(5) > 0 And y(5) > 0 And x(5) < 9 And y(5) < 9 And ChessBoard(x(5), y(5)) = 0 Then _
EAT = True: IsEat(5) = True ''链夊彲钖冨瓙锛屽繀闇璧版ゆワ纴鍏朵綑璧版硶镞犳晥

End If

''钖冨瓙寮忚蛋娉3
If Int(ChessBoard(i + 1, j - 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x(6) = (i + 1) + 1
y(6) = (j - 1) - 1
x1(6) = i + 1
y1(6) = j - 1

If x(6) > 0 And y(6) > 0 And x(6) < 9 And y(6) < 9 And ChessBoard(x(6), y(6)) = 0 Then _
EAT = True: IsEat(6) = True ''链夊彲钖冨瓙锛屽繀闇璧版ゆワ纴鍏朵綑璧版硶镞犳晥

End If

''钖冨瓙寮忚蛋娉4
If Int(ChessBoard(i + 1, j + 1) / 100) = NextCer(Cer) And (Cer = 2 Or ChessBoard(i, j) Mod 100 = 2) Then

x(7) = (i + 1) + 1
y(7) = (j + 1) + 1
x1(7) = i + 1
y1(7) = j + 1

If x(7) > 0 And y(7) > 0 And x(7) < 9 And y(7) < 9 And ChessBoard(x(7), y(7)) = 0 Then _
EAT = True: IsEat(7) = True ''链夊彲钖冨瓙锛屽繀闇璧版ゆワ纴鍏朵綑璧版硶镞犳晥

End If

''濡傛灉链夊悆瀛愯蛋娉曪纴鍒犻櫎娌℃湁钖冨瓙镄勫叾瀹冭蛋娉
If EAT = True Then

For a = 0 To 7

If IsEat(a) = False Then x(a) = -1

Next a

End If

''瀛桦叆Sc(璧版硶琛)涓
For a = 0 To 7

'If x(a) = 5 And y(a) = 2 Then Stop
''濡傛灉瓒呰繃妫嬬洏灏嗕笉鑳借蛋
If x(a) > 0 And y(a) > 0 And x(a) < 9 And y(a) < 9 Then

''濡傛灉鐩镙囨湁妫嫔瓙鍒欎笉鑳借蛋锛屼负0镓嶅瓨鍏
If ChessBoard(x(a), y(a)) = 0 Then
''灏呜蛋娉曞瓨鍏モ滆蛋娉曡〃钬
Sc(k).Initx = i
Sc(k).Inity = j
Sc(k).ObjX = x(a)
Sc(k).ObjY = y(a)

Sc(k).x1 = x1(a) ''琚钖冨瓙浣岖疆
Sc(k).y1 = y1(a)

If IsEat(a) = True Then Sc(k).Allow = True ''濡傛灉链夊悆瀛愶纴鍒椤厑璁告ょ潃璧版硶

k = k + 1

End If

End If

Next a

'If EAT = True Then i = 100: j = 100 ''濡傛灉链夊悆瀛愬垯涓嶅繀鍐嶆悳绱

End If

Next j

Next i

MaxValue = -30000 ''褰揿墠鍒嗘暟

tTemp = False

''鎼灭储鏄钖︽湁鍏佽歌蛋娉曪纴濡傛灉娌℃湁鍒欐墍链夎蛋娉旷殕鍏佽
For i = 0 To k - 1

If Sc(i).Allow = True Then tTemp = True

Next i

''濡傛灉链夊厑璁歌蛋娉曪纴鍒欓櫎鍏佽歌蛋娉曞栵纴鍏朵綑璧版硶镄嗕笉鍏佽歌蛋
If tTemp = False Then

For i = 0 To k - 1: Sc(i).Allow = True: Next i

End If

''璇曡蛋姣忕嶈蛋娉
For i = 0 To k - 1

If Sc(i).Allow = True Then

b1 = ChessBoard(Sc(i).Initx, Sc(i).Inity) ''璁板綍璧风偣妫嫔瓙鍜岀粓镣规嫔瓙
b2 = ChessBoard(Sc(i).ObjX, Sc(i).ObjY)
b = ChessBoard(Sc(i).x1, Sc(i).y1) ''璁板綍琚钖冨瓙浣岖疆镄勬嫔瓙

ChessBoard(Sc(i).Initx, Sc(i).Inity) = 0 ''娓呴櫎璧风偣镄勬嫔瓙
ChessBoard(Sc(i).ObjX, Sc(i).ObjY) = b1 ''璇曚笅妫
ChessBoard(Sc(i).x1, Sc(i).y1) = 0 ''娓呴櫎琚钖冨瓙浣岖疆镄勬嫔瓙

''濡傛灉鍒拌竟鐣屽垯濞佸姏锷犲己

''涓嫔彞锛氩傛灉鏄榛戞柟(101銆102)
If Cer = 1 Then

''涓嫔彞锛氩傛灉璧板埌绗涓琛屽垯妫嫔瓙鍙樻垚102锛屽▉锷涘姞寮
If Sc(i).ObjX = 1 Then ChessBoard(Sc(i).ObjX, Sc(i).ObjY) = 102

End If

''涓嫔彞锛氩傛灉鏄绾㈡柟(201銆202)
If Cer = 2 Then

''涓嫔彞锛氩傛灉璧板埌绗鍏琛屽垯妫嫔瓙鍙樻垚202锛屽▉锷涘姞寮
If Sc(i).ObjX = 8 Then ChessBoard(Sc(i).ObjX, Sc(i).ObjY) = 202

End If

If b > 0 And IsLine(Cer, Sc(i).ObjX, Sc(i).ObjY) = True And EAT = True Then

''濡傛灉鍙杩炵画钖冨瓙
v = CurrentValue(Cer) + 300 ''V涓哄綋鍓嶅眬闱浠峰煎姞300鍒

Else

v = Search(NextCer(Cer), Steps - 1, False, -UpMax) ''娌℃湁杩炵画鍙钖冨瓙锛岀户缁鎼灭储

End If

''鎭㈠嶆嬬洏
ChessBoard(Sc(i).x1, Sc(i).y1) = b ''鎭㈠嶈钖冨瓙
ChessBoard(Sc(i).Initx, Sc(i).Inity) = b1 ''璁板綍璧风偣妫嫔瓙鍜岀粓镣规嫔瓙
ChessBoard(Sc(i).ObjX, Sc(i).ObjY) = b2

'' 鏄剧ず姣忕嶈蛋娉旷殑寰楀垎
If IsTop Then

List1.AddItem "浠" & Str(Sc(i).Initx) & "," & Str(Sc(i).Inity) & _
"鍒" & Str(Sc(i).ObjX) & "," & Str(Sc(i).ObjY) & "寰楀垎锛" & Str(v)

End If

'濡傛灉杩欑嶈蛋娉曞垎鏁伴珮,璁板綍
If IsTop And (v > MaxValue Or MaxValue = -30000) Then

BestLocate.Initx = Sc(i).Initx
BestLocate.Inity = Sc(i).Inity
BestLocate.ObjX = Sc(i).ObjX
BestLocate.ObjY = Sc(i).ObjY
BestLocate.x1 = Sc(i).x1
BestLocate.y1 = Sc(i).y1
MaxValue = v

End If

If v > MaxValue Then MaxValue = v

'涓嫔彞锛 濡傛灉 MaxValue >= -UpMax //伪-尾鍓鏋, 绗﹀悎鍓鏋濇浔浠剁殑灏盋ut鎺夈俇pMax涓轰笂灞傜殑MaxValue
If IsTop = False And MaxValue >= -UpMax Then i = 100 ''鍓鏋濈▼搴

End If

Next i

If IsTop = False Then Search = -MaxValue Else Search = MaxValue

End Function

Private Sub cbText_Click(Index As Integer)

Dim i As Integer, j As Integer, C As Integer ''C璁拌浇钖冨瓙
Dim Temp As String, Temp2 As String, Temp3 As String
Dim x As Byte, y As Byte, x2 As Byte, y2 As Byte

If cbText(Index).BackColor <> &HC0E0FF Then Call MsgBox("钀芥嬫棤鏁堬紒", vbOKOnly + 32, "鎻愮ず锛"): Exit Sub

If cSel = 0 And Trim(cbText(Index).Text) > "" Then cSel = Index: cbText(cSel).ForeColor = QBColor(12): Exit Sub ''濡傛灉鐜╁朵竴涓涔熸病鍏堜笖褰揿墠妫嬬洏浣岖疆链夋嫔瓙锛屽垯镙囩ず鐜╁堕夋嫨姝ゆ嫔瓙
If cSel <> 0 And Val(cbText(Index).Text) = Val(cbText(cSel).Text) Then cbText(cSel).ForeColor = H80000008&: cSel = 0: Exit Sub ''濡傛灉鐜╁朵袱娆￠夋嫨鐩稿悓镄勬嫔瓙鍒椤彇娑堥夋嫨

If cSel <> 0 Then

''涓嬫
cbText(Index).Text = cbText(cSel).Text

''鍒ゆ柇鏄钖﹀彲鍙樻垚锷犲己妫
k = Val(cbText(Index).Text)

If Int(k / 100) = 1 And Index < 8 Then cbText(Index).Text = "102" ''濡傛灉1鏂硅蛋鍒伴《绔灏卞彉鎴愬姞寮烘
If Int(k / 100) = 2 And Index > 55 Then cbText(Index).Text = "202" ''濡傛灉2鏂硅蛋鍒伴《绔灏卞彉鎴愬姞寮烘

cbText(cSel).Text = ""
cbText(cSel).ForeColor = H80000008&

''鍒ゆ柇链夋病链夊悆瀛

''钖戜笂宸︽枩
If Index - cSel = -18 Then

cbText(Index + 9).Text = "": ''琚钖冨瓙
C = Index + 9

End If

''钖戜笂鍙虫枩
If Index - cSel = -14 Then

cbText(Index + 7).Text = "": ''琚钖冨瓙
C = Index + 7

End If

''钖戜笅宸︽枩
If Index - cSel = 14 Then

cbText(Index - 7).Text = "": ''琚钖冨瓙
C = Index - 7

End If

''钖戜笅鍙虫枩
If Index - cSel = 18 Then

cbText(Index - 9).Text = "": ''琚钖冨瓙
C = Index - 9

End If

''瀛桦偍璧版硶
k = 0: Temp = "": Temp2 = "": Temp = ""
For i = 1 To 8

For j = 1 To 8

If k = cSel Then Temp = "浠" & Str(i) + "," + Str(j)
If k = Index Then Temp2 = " 鍒" + Str(i) + "," + Str(j): x = i: y = j
If k = C Then Temp3 = "钖冨瓙 " & Str(i) & "," & Str(j): x2 = i: y2 = j
k = k + 1

Next j

Next i

List2.AddItem "绗" & Str(CurrentStep) & "镓 " & Str(CurrentPlayer) + "鏂" + Temp + Temp2 + Temp3
CurrentStep = CurrentStep + 1

Text3.Text = Temp + Temp2

cSel = 0
Call ReDisplay

''涓嫔彞锛氩傛灉鏄浜烘満妯″纺骞朵笖鐜╁惰缮娌℃湁鍙钖冨瓙
If 浜烘満妯″纺 = True And (IsLine(CurrentPlayer, x, y) = True And x2 > 1 And y2 > 2) = False Then
'If 浜烘満妯″纺 = True Then

''鐪嬬帺瀹惰蛋浜嗗摢鏂圭殑妫嫔瓙锛屽氨杩愮畻鍙︿竴鏂圭殑妫嫔瓙
CurrentPlayer = NextCer(Int(Val(cbText(Index).Text) / 100))
Call Command2_Click ''濡傛灉鏄浜烘満妯″纺鍒栾╃数鑴戣繍闀

End If

End If

End Sub

Private Sub Command1_Click()

List2.Clear ''娓呴櫎妫嬭氨

CurrentStep = 1

Call Initial
Call Display

End Sub

Private Sub Command2_Click()

Dim t As Boolean

Command2.Enabled = False

t:
Text1.Text = Str(Search(CurrentPlayer, Val(Text2.Text), True, 0))

Command2.Enabled = True

With BestLocate

t = DownChess(.Initx, .Inity, .ObjX, .ObjY, .x1, .y1)
Call Display

If t = True And IsLine(CurrentPlayer, .ObjX, .ObjY) Then Call MsgBox("鎴戣缮𨱍冲啀钖冧竴涓"): GoTo t ''濡傛灉镓涓嬩箣妫嬭缮鑳藉悆瀛愶纸杩炵画钖冿级鍒椤啀杩愮畻

End With

CurrentPlayer = NextCer(CurrentPlayer)

End Sub

Rem 绉绘
Rem Sx,Sy:璧风偣妫嫔瓙 Ex,Ey:缁堢偣妫嫔瓙 Ax,Ay:琚钖冨瓙
Rem 濡傛灉链夊悆瀛愬垯杩斿洖True
Private Function DownChess(Sx As Byte, Sy As Byte, ex As Byte, ey As Byte, Ax As Byte, Ay As Byte) As Boolean

ChessBoard(ex, ey) = ChessBoard(Sx, Sy)
ChessBoard(Sx, Sy) = 0
ChessBoard(Ax, Ay) = 0 ''娓呴櫎琚钖冨瓙

If Ax <> 0 And Ay <> 0 Then DownChess = True Else DownChess = False

Text3.Text = "绗" & Str(CurrentStep) & "镓 " & Str(CurrentPlayer) + "鏂逛粠" & Str(Sx) + "," + Str(Sy) + "鍒" + Str(ex) + "," + Str(ey) & _
"钖冨瓙 " & Str(Ax) & "," & Str(Ay)
CurrentStep = CurrentStep + 1
List2.AddItem Text3.Text

''涓嫔彞锛氩傛灉鏄榛戞柟(101銆102)
If Int(ChessBoard(ex, ey) / 100) = 1 Then

''涓嫔彞锛氩傛灉璧板埌绗涓琛屽垯妫嫔瓙鍙樻垚102锛屽▉锷涘姞寮
If ex = 1 Then ChessBoard(ex, ey) = 102

End If

''涓嫔彞锛氩傛灉鏄绾㈡柟(201銆202)
If Int(ChessBoard(ex, ey) / 100) = 2 Then

''涓嫔彞锛氩傛灉璧板埌绗鍏琛屽垯妫嫔瓙鍙樻垚202锛屽▉锷涘姞寮
If ex = 8 Then ChessBoard(ex, ey) = 202

End If

End Function

Rem 杩愮畻涓
Private Sub Command3_Click()

CurrentPlayer = 1
Call Command2_Click

End Sub

Rem 杩愮畻浜
Private Sub Command4_Click()

CurrentPlayer = 2
Call Command2_Click

End Sub

Private Sub Command5_Click()

Call ReDisplay

End Sub

Private Sub Command6_Click()

If 浜烘満妯″纺 = False Then 浜烘満妯″纺 = True Else 浜烘満妯″纺 = False

If 浜烘満妯″纺 = False Then Command6.Caption = " 浜烘満妯″纺": Command6.ToolTipText = "褰揿墠妯″纺锛氢汉浜哄规垬" Else Command6.Caption = " 浼戞伅妯″纺": Command6.ToolTipText = "褰揿墠妯″纺锛氢汉链哄规垬"

End Sub

Private Sub Command7_Click()

End

End Sub

Rem 瀛樿氨
Private Sub Command8_Click()

On Error GoTo e

Dim i As Integer

Open InputBox("璇疯緭鍏ユ枃浠跺悕:") For Output As #1

For i = 0 To List2.ListCount - 1

Print #1, List2.List(i)

Next i

Close #1
Exit Sub

e:
Call MsgBox("瀛桦偍阌栾!", vbOKOnly + 32, "鎻愮ず:")
Err.Clear
Exit Sub

End Sub

Private Sub Form_Load()

浜烘満妯″纺 = False

cSel = 0
CurrentPlayer = 1

Call Command1_Click

End Sub

妯″潡浠ｇ爜:

Type CHESSER

Chess As Byte ''涓轰綍妫,鍦˙estLocate鍒欐爣鏄庝负浣曟暟缁
Initx As Byte ''璧峰埯妫嬬殑浣岖疆
Inity As Byte
ObjX As Byte ''缁忚繍绠楀悗镄勮惤妫嬬偣
ObjY As Byte
x1 As Byte
y1 As Byte
Allow As Boolean ''鏄钖﹀厑璁

End Type

⑵ 如何用VB程序设计打地鼠游戏

下面是源代码：
Form1:
Private Sub Form_Load() Dim temp As Integer Randomize
temp = Int(Rnd * 3) + 1
Form1.Picture = LoadPicture("C:\Users\Administrator\Desktop\打地鼠\picture" & temp & ".jpg") WindowsMediaPlayer1.URL = "C:\Users\Administrator\Desktop\打地鼠\Heaven's Devils.wma" End Sub
Private Sub Label1_Click() Form2.Show Form2.num = -1 Form1.Hide
WindowsMediaPlayer1.URL = ""
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作 Close #1
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2 Close #2
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3 Close #3 End Sub
Private Sub Label2_Click() End End Sub
Form2:
Dim allnum As Integer, oknum As Integer '定义变化次数 打中次数 Public num As Integer '判别是否第一次开始游戏 Dim flags1 As Boolean '判别文件是否保存 Public flags As Boolean '判别是否播放声音 Private Sub countine_Click() pause.Enabled = True Timer1.Enabled = True countine.Enabled = False WLXZ.Enabled = True End Sub
Private Sub exit_Click() Dim X As Integer Dim tt As Integer
X = MsgBox("是否真的退出？", vbYesNo, "退出游戏框")
If X = 6 Then
tt = MsgBox("退出游戏之前,是否保存", vbYesNo, "保存提示") If tt = 6 Then
If flags1 = True Then End Else
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If End End If End Sub
Private Sub Form_Load() Form4.Check1.Value = 1
WindowsMediaPlayer1.Controls.stop countine.Enabled = False pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left flags1 = False flags = True End Sub
Private Sub help_Click() Form3.Show End Sub
Private Sub new_game_Click() num = num + 1 Dim t As Integer
If (num > 0) Then
t = MsgBox("新游戏开始之前,是否保存", vbYesNo, "保存提示") If t = 6 Then
flags1 = True
If Timer1.Interval = 1000 Then
Open "C:\Users\Administrator\Desktop\打地鼠\primary.dat" For Append As #1 '写操作
Print #1, Text1.Text + " " + Format(Date, "M/d/yy") Close #1
ElseIf Timer1.Interval = 500 Then
Open "C:\Users\Administrator\Desktop\打地鼠\intermediate.dat" For Append As #2
Print #2, Text1.Text + " " + Format(Date, "M/d/yy") Close #2 Else
Open "C:\Users\Administrator\Desktop\打地鼠\advanced.dat" For Append As #3
Print #3, Text1.Text + " " + Format(Date, "M/d/yy") Close #3 End If End If End If
Call Form_Load
allnum = 0 '变化次数初始为0 oknum = 0 '打中次数初始为0 Timer1.Enabled = True pause.Enabled = True WLXZ.Enabled = True End Sub
Private Sub options_Click() Timer1.Enabled = False Form4.Show
WLXZ.Enabled = False countine.Enabled = True End Sub
Private Sub pause_Click() Dim r, g, b As Integer Timer1.Enabled = False countine.Enabled = True pause.Enabled = False WLXZ.Enabled = False
Form5.Top = Form2.Top + 700 Form5.Left = Form2.Left Form5.Show

⑶ 怎样用vb编写贪吃蛇游戏

1、向上前进的时候，对代码进行一个详解。