分享
 
 
 

用VB实现井字游戏

王朝厨房·作者佚名  2007-01-04
窄屏简体版  字體: |||超大  

’定义棋盘格子数据结构

Private Type Wells

Wells_X As Long

Wells_Y As Long

Wells_Value As Integer

End Type

’定义棋盘格子的实例数组

Private usrWells(1 To 9) As Wells

’定义响应点击操作的逻辑棋盘格子代号数组

Private intWellsIndex(1 To 3, 1 To 3) As Integer

’定义玩家的玩过的盘数和积分

Private lngPlayerTurn As Integer, lngPlayerScore As Long

’定义游戏开始标志

Private blnGameStart As Boolean

’定义玩家胜利和失败标志

Private blnPlayerWin As Boolean, blnPlayerLost As Boolean

’定义枚举常量标识玩家类型

Private Enum Player

MAN = 0

COMPUTER = 1

End Enum

’该过程用于显示游戏信息

Private Sub Form_Load()

Me.Show

Me.Caption = "BS井字游戏 — (版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")"

End Sub

’该过程用于重新开始开始游戏

Private Sub cmdGameStart_Click()

blnGameStart = True

lngPlayerTurn = lngPlayerTurn + 1

Me.picWells.Cls

Call subGameInitialize

Call subScreenRefresh

End Sub

’该过程用于显示游戏规则

Private Sub CmdGameRules_Click()

Beep

MsgBox " BS井字游戏:一个最简单的智力游戏,您将与机" & Chr(13) & _

"器在9个格子大小的棋盘上一决高下。由您先开始" & Chr(13) & _

"和机器轮流,每次在任意的空格上下一枚棋子。先" & Chr(13) & _

"在棋盘上横向、纵向或对角线上排成三枚相同棋子" & Chr(13) & _

"的一方即可获得游戏的胜利,祝您好运!!", 0 + 64, "游戏规则"

End Sub

’该过程用于显示游戏开发信息

Private Sub cmdAbout_Click()

Beep

MsgBox "BS井字游戏" & "(V-" & App.Major & "." & App.Minor & "版本)" & Chr(13) & Chr(13) & _

"" & Chr(13) & Chr(13) & _

"由PigheadPrince设计制作" & Chr(13) & _

"CopyRight(C)2002,BestSoft.TCG", 0, "关于本游戏"

End Sub

’该过程用于退出游戏

Private Sub cmdExit_Click()

Beep

msg = MsgBox("您要退出本游戏吗?", 4 + 32, "BS井字游戏")

If msg = 6 Then End

End Sub

’该过程用于实现玩家向井字棋盘中下棋子

Private Sub picWells_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim lngGetWells_X As Long, lngGetWells_Y As Long

Dim blnWellsNotFull As Boolean

If Not blnGameStart Then Exit Sub

lngGetWells_X = Int(Y / (Me.picWells.Height / 3)) + 1

lngGetWells_Y = Int(X / (Me.picWells.Width / 3)) + 1

If usrWells(intWellsIndex(lngGetWells_X, lngGetWells_Y)).Wells_Value = 0 Then

usrWells(intWellsIndex(lngGetWells_X, lngGetWells_Y)).Wells_Value = 1

Me.picWells.PaintPicture Me.imgChequer(MAN).Picture, _

usrWells(intWellsIndex(lngGetWells_X, lngGetWells_Y)).Wells_X, _

usrWells(intWellsIndex(lngGetWells_X, lngGetWells_Y)).Wells_Y, _

Me.picWells.Width / 3, Me.picWells.Height / 3

If funPlayerWinIF(MAN) Then

Beep

MsgBox "恭喜,您胜利了!", , "BS井字游戏"

lngPlayerScore = lngPlayerScore + 100

Call subScreenRefresh

blnGameStart = False

Else

blnPlayerTurn = False

For i = 1 To 9

If usrWells(i).Wells_Value = 0 Then blnWellsNotFull = True

Next i

If blnWellsNotFull Then

Call subComputerDoing

Else

Beep

MsgBox "和局!", , "BS井字游戏"

blnGameStart = False

End If

End If

End If

End Sub

’该自定义子过程用于游戏数据初始化

Private Sub subGameInitialize()

intWellsIndex(1, 1) = 1

intWellsIndex(1, 2) = 2

intWellsIndex(1, 3) = 3

intWellsIndex(2, 1) = 4

intWellsIndex(2, 2) = 5

intWellsIndex(2, 3) = 6

intWellsIndex(3, 1) = 7

intWellsIndex(3, 2) = 8

intWellsIndex(3, 3) = 9

For i = 1 To 7 Step 3

usrWells(i).Wells_X = 0

Next i

For i = 2 To 8 Step 3

usrWells(i).Wells_X = Me.picWells.Width * (1 / 3)

Next i

For i = 3 To 9 Step 3

usrWells(i).Wells_X = Me.picWells.Width * (2 / 3)

Next i

For i = 1 To 3 Step 1

usrWells(i).Wells_Y = 0

Next i

For i = 4 To 6 Step 1

usrWells(i).Wells_Y = Me.picWells.Height * (1 / 3)

Next i

For i = 7 To 9 Step 1

usrWells(i).Wells_Y = Me.picWells.Height * (2 / 3)

Next i

For i = 1 To 9

usrWells(i).Wells_Value = 0

Next i

End Sub

’该自定义子过程用于游戏开始时刷新屏幕

Private Sub subScreenRefresh()

Me.lblPlayerTurns.Caption = lngPlayerTurn

Me.lblPlayerScore.Caption = lngPlayerScore

Me.picWells.Line (0, Me.picWells.Height * (1 / 3))-(Me.picWells.Width, Me.picWells.Height * (1 / 3)), vbBlack

Me.picWells.Line (0, Me.picWells.Height * (2 / 3))-(Me.picWells.Width, Me.picWells.Height * (2 / 3)), vbBlack

Me.picWells.Line (Me.picWells.Width * (1 / 3), 0)-(Me.picWells.Width * (1 / 3), Me.picWells.Height), vbBlack

Me.picWells.Line (Me.picWells.Width * (2 / 3), 0)-(Me.picWells.Width * (2 / 3), Me.picWells.Height), vbBlack

End Sub

’该自定义子过程用于执行机器的下子

Private Sub subComputerDoing()

Randomize

Dim lngGetWells_X As Long, lngGetWells_Y As Long

Dim intPCFirstWells As Integer

Dim blnPCWellsExists As Boolean

Dim intPCWells As Integer

For i = 1 To 9 Step 1

If usrWells(i).Wells_Value = -1 Then

blnPCWellsExists = True

End If

Next i

If Not blnPCWellsExists Then

GoTo GetPCFirstWells:

Else

GoTo GetPCNextWells:

End If

GetPCFirstWells: ’随机获得机器的第一个落子位置

intPCFirstWells = Int((9 - 1 + 1) * Rnd + 1)

If usrWells(intPCFirstWells).Wells_Value <> 0 Then

GoTo GetPCFirstWells:

Else

intPCWells = intPCFirstWells

End If

GoTo GoOn:

GetPCNextWells: ’获得机器下一步的落子位置

intPCWells = funGetPCWells

GoOn: ’绘制落子并判断胜利

usrWells(intPCWells).Wells_Value = -1

lngGetWells_X = usrWells(intPCWells).Wells_X

lngGetWells_Y = usrWells(intPCWells).Wells_Y

Me.picWells.PaintPicture Me.imgChequer(COMPUTER).Picture, lngGetWells_X, lngGetWells_Y, _

Me.picWells.Width / 3, Me.picWells.Height / 3

If funPlayerWinIF(COMPUTER) Then

Beep

MsgBox "抱歉,您失败了!", , "BS井字游戏"

lngPlayerScore = lngPlayerScore - 100

If lngPlayerScore < 0 Then lngPlayerScore = 0

Call subScreenRefresh

blnGameStart = False

Else

blnPlayerTurn = True

End If

End Sub

’该自定义函数用于判断玩家是否胜利

Private Function funPlayerWinIF(PlayerType As Integer) As Boolean

Dim intWinCase(1 To 8) As Integer

intWinCase(1) = usrWells(1).Wells_Value + usrWells(2).Wells_Value + usrWells(3).Wells_Value

intWinCase(2) = usrWells(4).Wells_Value + usrWells(5).Wells_Value + usrWells(6).Wells_Value

intWinCase(3) = usrWells(7).Wells_Value + usrWells(8).Wells_Value + usrWells(9).Wells_Value

intWinCase(4) = usrWells(1).Wells_Value + usrWells(4).Wells_Value + usrWells(7).Wells_Value

intWinCase(5) = usrWells(2).Wells_Value + usrWells(5).Wells_Value + usrWells(8).Wells_Value

intWinCase(6) = usrWells(3).Wells_Value + usrWells(6).Wells_Value + usrWells(9).Wells_Value

intWinCase(7) = usrWells(1).Wells_Value + usrWells(5).Wells_Value + usrWells(9).Wells_Value

intWinCase(8) = usrWells(3).Wells_Value + usrWells(5).Wells_Value + usrWells(7).Wells_Value

Select Case PlayerType

Case MAN

If intWinCase(1) = 3 Or intWinCase(2) = 3 Or intWinCase(3) = 3 Or intWinCase(4) = 3 Or _

intWinCase(5) = 3 Or intWinCase(6) = 3 Or intWinCase(7) = 3 Or intWinCase(8) = 3 Then

blnPlayerWin = True

blnPlayerLost = False

funPlayerWinIF = blnPlayerWin

End If

Case COMPUTER

If intWinCase(1) = -3 Or intWinCase(2) = -3 Or intWinCase(3) = -3 Or intWinCase(4) = -3 Or _

intWinCase(5) = -3 Or intWinCase(6) = -3 Or intWinCase(7) = -3 Or intWinCase(8) = -3 Then

blnPlayerWin = False

blnPlayerLost = True

funPlayerWinIF = blnPlayerLost

End If

End Select

End Function

’该自定义函数用于返回机器的落子

Private Function funGetPCWells() As Integer

Dim intWells(1 To 8) As Integer, intPCRandomWells As Integer

intWells(1) = usrWells(1).Wells_Value + usrWells(2).Wells_Value + usrWells(3).Wells_Value

intWells(2) = usrWells(4).Wells_Value + usrWells(5).Wells_Value + usrWells(6).Wells_Value

intWells(3) = usrWells(7).Wells_Value + usrWells(8).Wells_Value + usrWells(9).Wells_Value

intWells(4) = usrWells(1).Wells_Value + usrWells(4).Wells_Value + usrWells(7).Wells_Value

intWells(5) = usrWells(2).Wells_Value + usrWells(5).Wells_Value + usrWells(8).Wells_Value

intWells(6) = usrWells(3).Wells_Value + usrWells(6).Wells_Value + usrWells(9).Wells_Value

intWells(7) = usrWells(1).Wells_Value + usrWells(5).Wells_Value + usrWells(9).Wells_Value

intWells(8) = usrWells(3).Wells_Value + usrWells(5).Wells_Value + usrWells(7).Wells_Value

’ 如果任何一线已有机器的两个子并且另外一格仍空,机器方即将成一线

’ 机器落子的结果等于该空格

If intWells(1) = -2 Then

For i = 1 To 3 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(2) = -2 Then

For i = 4 To 6 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(3) = -2 Then

For i = 7 To 9 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(4) = -2 Then

For i = 1 To 7 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(5) = -2 Then

For i = 2 To 8 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(6) = -2 Then

For i = 3 To 9 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(7) = -2 Then

For i = 1 To 9 Step 4

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(8) = -2 Then

For i = 3 To 7 Step 2

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

End If

’如果任何一线已有玩家方两个子并且另外一格仍空,防止玩家方作成一线

’机器落子的结果等于该空格

If intWells(1) = 2 Then

For i = 1 To 3 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(2) = 2 Then

For i = 4 To 6 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(3) = 2 Then

For i = 7 To 9 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(4) = 2 Then

For i = 1 To 7 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(5) = 2 Then

For i = 2 To 8 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(6) = 2 Then

For i = 3 To 9 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(7) = 2 Then

For i = 1 To 9 Step 4

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(8) = 2 Then

For i = 3 To 7 Step 2

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

End If

’如果任何一线已有机器方一个子并且另外两格仍空,作成机器方的两个子

’机器落子的结果等于该空格

If intWells(1) = -1 Then

For i = 1 To 3 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(2) = -1 Then

For i = 4 To 6 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(3) = -1 Then

For i = 7 To 9 Step 1

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(4) = -1 Then

For i = 1 To 7 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(5) = -1 Then

For i = 2 To 8 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(6) = -1 Then

For i = 3 To 9 Step 3

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(7) = -1 Then

For i = 1 To 9 Step 4

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

ElseIf intWells(8) = -1 Then

For i = 3 To 7 Step 2

If usrWells(i).Wells_Value = 0 Then

funGetPCWells = i

Exit Function

End If

Next i

End If

’面临和局,随机在空白的格子内落子

GetRandomWells:

Randomize

intPCRandomWells = Int((9 - 1 + 1) * Rnd + 1)

If usrWells(intPCRandomWells).Wells_Value = 0 Then

funGetPCWells = intPCRandomWells

Else

GoTo GetRandomWells:

End If

End Function

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有