<form id="hz9zz"></form>
  • <form id="hz9zz"></form>

      <nobr id="hz9zz"></nobr>

      <form id="hz9zz"></form>

    1. 明輝手游網中心:是一個免費提供流行視頻軟件教程、在線學習分享的學習平臺!

      用VB完成井字游戲

      [摘要]'定義棋盤格子數據結構Private Type Wells Wells_X As Long Wells_Y As Long Wells_Value As IntegerEn...
      '定義棋盤格子數據結構
      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


      日韩精品一区二区三区高清