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、向上前進的時候，對代碼進行一個詳解。