1. <wbr id="m8vu6"></wbr>

      <del id="m8vu6"><center id="m8vu6"><source id="m8vu6"></source></center></del>
        <p id="m8vu6"><sub id="m8vu6"></sub></p>

        VB.net 2010 視頻教程 VB.net 2010 視頻教程 VB.net 2010 視頻教程
        SQL Server 2008 視頻教程 c#入門經典教程 Visual Basic從門到精通視頻教程
        當前位置:
        首頁 > 編程開發 > vb >
        • vb教程之用VB實現井字游戲

        • 2017-09-21 16:29 來源:未知
        '定義棋盤格子數據結構
        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
        相關教程
        免费看成年人视频大全_免费看成年人视频在线观看