frmttt.frm

Tic Tac Toe程序。可以供一到两个玩家使用。程序中使用了visual basic 计时器

        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic1.Print "  ";
      pic1.FontSize = 36
      pic1.Print "O"
      xTurn = True
      topLeft = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic2_Click()
  If Not gameOver Then
  If topMiddle = 0 Then
    taken(2) = True
    turnTime = 0
    If xTurn Then
      pic2.Print "    ";
      pic2.FontSize = 36
      pic2.Print "X"
      xTurn = False
      topMiddle = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic2.Print "  ";
      pic2.FontSize = 36
      pic2.Print "O"
      xTurn = True
      topMiddle = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic3_Click()
  If Not gameOver Then
  If topRight = 0 Then
    taken(3) = True
    turnTime = 0
    If xTurn Then
      pic3.Print "    ";
      pic3.FontSize = 36
      pic3.Print "X"
      xTurn = False
      topRight = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic3.Print "  ";
      pic3.FontSize = 36
      pic3.Print "O"
      xTurn = True
      topRight = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic4_Click()
  If Not gameOver Then
  If midLeft = 0 Then
    taken(4) = True
    turnTime = 0
    If xTurn Then
      pic4.Print "    ";
      pic4.FontSize = 36
      pic4.Print "X"
      xTurn = False
      midLeft = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic4.Print "  ";
      pic4.FontSize = 36
      pic4.Print "O"
      xTurn = True
      midLeft = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic5_Click()
  If Not gameOver Then
  If center = 0 Then
    taken(5) = True
    turnTime = 0
    If xTurn Then
      pic5.Print "    ";
      pic5.FontSize = 36
      pic5.Print "X"
      xTurn = False
      center = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic5.Print "  ";
      pic5.FontSize = 36
      pic5.Print "O"
      xTurn = True
      center = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic6_Click()
  If Not gameOver Then
  If midRight = 0 Then
    taken(6) = True
    turnTime = 0
    If xTurn Then
      pic6.Print "    ";
      pic6.FontSize = 36
      pic6.Print "X"
      xTurn = False
      midRight = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic6.Print "  ";
      pic6.FontSize = 36
      pic6.Print "O"
      xTurn = True
      midRight = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic7_Click()
  If Not gameOver Then
  If bottomLeft = 0 Then
    taken(7) = True
    turnTime = 0
    If xTurn Then
      pic7.Print "    ";
      pic7.FontSize = 36
      pic7.Print "X"
      xTurn = False
      bottomLeft = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic7.Print "  ";
      pic7.FontSize = 36
      pic7.Print "O"
      xTurn = True
      bottomLeft = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic8_Click()
  If Not gameOver Then
  If bottomMiddle = 0 Then
    taken(8) = True
    turnTime = 0
    If xTurn Then
      pic8.Print "    ";
      pic8.FontSize = 36
      pic8.Print "X"
      xTurn = False
      bottomMiddle = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic8.Print "  ";
      pic8.FontSize = 36
      pic8.Print "O"
      xTurn = True
      bottomMiddle = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub


Private Sub pic9_Click()
  If Not gameOver Then
  If bottomRight = 0 Then
    taken(9) = True
    turnTime = 0
    If xTurn Then
      pic9.Print "    ";
      pic9.FontSize = 36
      pic9.Print "X"
      xTurn = False
      bottomRight = 1
      If Not TTT Then
        lblMesg = "O's Turn."
      End If
      If Not gameOver And onePlayer Then
        Call compPlay
      End If
    Else
      pic9.Print "  ";
      pic9.FontSize = 36
      pic9.Print "O"
      xTurn = True
      bottomRight = 2
      If Not TTT Then
        lblMesg = "X's Turn."
      End If
    End If
  End If
  End If
End Sub

'Check for tic tac toe
Private Function TTT() As Boolean
  If topLeft = 1 And topMiddle = 1 And topRight = 1 Or _
     midLeft = 1 And center = 1 And midRight = 1 Or _
     bottomLeft = 1 And bottomMiddle = 1 And bottomRight = 1 Or _
     topLeft = 1 And midLeft = 1 And bottomLeft = 1 Or _
     topMiddle = 1 And center = 1 And bottomMiddle = 1 Or _
     topRight = 1 And midRight = 1 And bottomRight = 1 Or _
     topLeft = 1 And center = 1 And bottomRight = 1 Or _
     topRight = 1 And center = 1 And bottomLeft = 1 Then
       gameOver = True
       xScore = xScore + 1
       lblX.Caption = "X's Score: " + Str(xScore)
       lblMesg.Caption = "X wins this game!"
  ElseIf topLeft = 2 And topMiddle = 2 And topRight = 2 Or _
     midLeft = 2 And center = 2 And midRight = 2 Or _
     bottomLeft = 2 And bottomMiddle = 2 And bottomRight = 2 Or _
     topLeft = 2 And midLeft = 2 And bottomLeft = 2 Or _
     topMiddle = 2 And center = 2 And bottomMiddle = 2 Or _
     topRight = 2 And midRight = 2 And bottomRight = 2 Or _
     topLeft = 2 And center = 2 And bottomRight = 2 Or _
     topRight = 2 And center = 2 And bottomLeft = 2 Then
       gameOver = True
       oScore = oScore + 1
       lblO.Caption = "O's Score: " + Str(oScore)
       lblMesg.Caption = "O wins this game!"
  ElseIf allFull Then
     gameOver = True
     lblMesg.Caption = "Nobody wins this game!"
     draw = draw + 1
     lblDraw.Caption = "Tie Games: " + Str(draw)
  End If
  TTT = gameOver
End Function

Private Function allFull() As Boolean
  If topLeft = 0 Or topMiddle = 0 Or topRight = 0 Or midLeft = 0 Or center = 0 Or midRight = 0 Or bottomLeft = 0 Or bottomMiddle = 0 Or bottomRight = 0 Then
    allFull = False
  Else
    allFull = True
  End If
End Function

Private Sub compPlay()
  'first see if computer can win; if not, try to block human win
  Select Case compWinPosition
    Case 1
      Call pic1_Click
    Case 2
      Call pic2_Click
    Case 3
      Call pic3_Click
    Case 4
      Call pic4_Click
    Case 5
      Call pic5_Click
    Case 6
      Call pic6_Click
    Case 7
      Call pic7_Click
    Case 8
      Call pic8_Click
    Case 9
      Call pic9_Click
    Case 0 'this case is for when neither human nor computer can win
      Dim choice As Integer
      Do
        choice = Int(Rnd * 9) + 1
      Loop Until Not taken(choice)
  
      Select Case choice
        Case 1
          Call pic1_Click
        Case 2
          Call pic2_Click
        Case 3
          Call pic3_Click
        Case 4
          Call pic4_Click
        Case 5
          Call pic5_Click
        Case 6
          Call pic6_Click
        Case 7
          Call pic7_Click
        Case 8
          Call pic8_Click
        Case 9
          Call pic9_Click
      End Select
  End Select
  
  xTurn = True
  If Not gameOver Then
    lblMesg.Caption = "X's Turn."
  End If
End Sub

Private Sub tmrCompTime_Timer()

End Sub

Private Sub tmrTimer_Timer()
  If Not gameOver Then
    lblTime.Caption = "Time: " + FormatNumber(turnTime, 1)
    turnTime = turnTime + 0.1
  End If
  
  If turnTime >= maxTime Then
    lblTime.Caption = "Time: " + FormatNumber(maxTime, 1)
    gameOver = True
    tmrTimer.Enabled = False
    If xTurn Then
      oScore = oScore + 1
      lblO.Caption = "O's Score: " + Str(oScore)
      lblMesg.Caption = "O wins this game!"
    Else
      xScore = score + 1
      lblX.Caption = "X's Score: " + Str(xScore)
      lblMesg.Caption = "X wins this game!"
    End If
  End If
End Sub

'this function returns the potential win position for the computer, O
Private Function compWinPosition() As Integer
  If topLeft = 0 And (topMiddle = 2 And topRight = 2 _
    Or center = 2 And bottomRight = 2 Or midLeft = 2 And bottomLeft = 2) Then
      compWinPosition = 1
  ElseIf topMiddle = 0 And (topLeft = 2 And topRight = 2 _
    Or center = 2 And bottomMiddle = 2) Then
      compWinPosition = 2
  ElseIf topRight = 0 And (topLeft = 2 And topMiddle = 2 _
    Or bottomLeft = 2 And center = 2 Or midRight = 2 And bottomRight = 2) Then
      compWinPosition = 3
  ElseIf midLeft = 0 And (topLeft = 2 And bottomLeft = 2 _
    Or center = 2 And midRight = 2) Then
      compWinPosition = 4
  ElseIf center = 0 And (topLeft = 2 And bottomRight = 2 _
    Or bottomLeft = 2 And topRight = 2 Or topMiddle = 2 And bottomMiddle = 2 _
    Or midLeft = 2 And midRight = 2) Then
      compWinPosition = 5
  ElseIf midRight = 0 And (topRight = 2 And bottomRight = 2 _
    Or midLeft = 2 And center = 2) Then
      compWinPosition = 6
  ElseIf bottomLeft = 0 And (topLeft = 2 And midLeft = 2 _
    Or center = 2 And topRight = 2 Or bottomMiddle = 2 And bottomRight = 2) Then
      compWinPosition = 7
  ElseIf bottomMiddle = 0 And (topMiddle = 2 And center = 2 _
    Or bottomLeft = 2 And bottomRight = 2) Then
      compWinPosition = 8
  ElseIf bottomRight = 0 And (topLeft = 2 And center = 2 _
    Or topRight = 2 And midRight = 2 Or bottomLeft = 2 And bottomMiddle = 2) Then
      compWinPosition = 9
  Else
    'if no found win position for computer, make sure the human player won't win
    compWinPosition = xWinPosition
  End If
End Function

'this function returns the potential win position for the human player, X
Private Function xWinPosition() As Integer
  If topLeft = 0 And (topMiddle = 1 And topRight = 1 _
    Or center = 1 And bottomRight = 1 Or midLeft = 1 And bottomLeft = 1) Then
      xWinPosition = 1
  ElseIf topMiddle = 0 And (topLeft = 1 And topRight = 1 _
    Or center = 1 And bottomMiddle = 1) Then
      xWinPosition = 2
  ElseIf topRight = 0 And (topLeft = 1 And topMiddle = 1 _
    Or bottomLeft = 1 And center = 1 Or midRight = 1 And bottomRight = 1) Then
      xWinPosition = 3
  ElseIf midLeft = 0 And (topLeft = 1 And bottomLeft = 1 _
    Or center = 1 And midRight = 1) Then
      xWinPosition = 4
  ElseIf center = 0 And (topLeft = 1 And bottomRight = 1 _
    Or bottomLeft = 1 And topRight = 1 Or topMiddle = 1 And bottomMiddle = 1 _
    Or midLeft = 1 And midRight = 1) Then
      xWinPosition = 5
  ElseIf midRight = 0 And (topRight = 1 And bottomRight = 1 _
    Or midLeft = 1 And center = 1) Then
      xWinPosition = 6
  ElseIf bottomLeft = 0 And (topLeft = 1 And midLeft = 1 _
    Or center = 1 And topRight = 1 Or bottomMiddle = 1 And bottomRight = 1) Then
      xWinPosition = 7
  ElseIf bottomMiddle = 0 And (topMiddle = 1 And center = 1 _
    Or bottomLeft = 1 And bottomRight = 1) Then
      xWinPosition = 8
  ElseIf bottomRight = 0 And (topLeft = 1 And center = 1 _
    Or topRight = 1 And midRight = 1 Or bottomLeft = 1 And bottomMiddle = 1) Then
      xWinPosition = 9
  Else
    'if no found win position for X
    xWinPosition = 0
  End If
End Function