Игра Крестики - Нолики

Тема в разделе "Visual Basic", создана пользователем androks, 11 дек 2012.

Статус темы:
Закрыта.
  1. androks

    androks Гость

    Привет всем. Это игра крестики нолики, играть можно в режиме 3х3.
    А можно сделать, чтобы был выбор режима , например 3х3, 5х5, 9х9. Если кто знает, как это сделать, напишите сюда пожалуйста.

    Код (Text):
    VERSION 5.00
    Begin VB.Form FrmTTT
    Caption      =  "Ultimate Tic-Tac-Toe"
    ClientHeight    =  4125
    ClientLeft   =  60
    ClientTop     =  360
    ClientWidth  =  4920
    LinkTopic     =  "Form1"
    ScaleHeight  =  4125
    ScaleWidth   =  4920
    StartUpPosition =  3 'Windows Default
    Begin VB.CommandButton Command1
    Caption      =  "Об авторе"
    Height       =  255
    Left            =  240
    TabIndex        =  8
    Top          =  3600
    Width         =  3015
    End
    Begin VB.Frame Scoreframe
    Caption      =  "Scoreboard"
    BeginProperty Font
    Name            =  "MS Sans Serif"
    Size            =  8.25
    Charset      =  204
    Weight       =  700
    Underline     =  0  'False
    Italic       =  0  'False
    Strikethrough  =  0  'False
    EndProperty
    Height       =  1695
    Left            =  3360
    TabIndex        =  3
    Top          =  120
    Width         =  1455
    Begin VB.Label compscore
    Height       =  255
    Left            =  240
    TabIndex        =  7
    Top          =  1200
    Width         =  495
    End
    Begin VB.Label playerscore
    Height       =  255
    Left            =  240
    TabIndex        =  6
    Top          =  600
    Width         =  495
    End
    Begin VB.Label complbl
    Caption      =  "Computer:"
    Height       =  255
    Left            =  120
    TabIndex        =  5
    Top          =  960
    Width         =  735
    End
    Begin VB.Label playerlbl
    Caption      =  "Player:"
    Height       =  255
    Left            =  120
    TabIndex        =  4
    Top          =  360
    Width         =  495
    End
    End
    Begin VB.CommandButton cmdquit
    Caption      =  "Выход"
    Height       =  615
    Left            =  3600
    TabIndex        =  1
    Top          =  3240
    Width         =  975
    End
    Begin VB.CommandButton cmdnewgame
    Caption      =  "Новая игра"
    Height       =  735
    Left            =  3600
    TabIndex        =  0
    Top          =  2040
    Width         =  975
    End
    Begin VB.PictureBox picboard
    BackColor     =  &H00000000&
    DrawWidth     =  4
    FillColor     =  &H00FFFFFF&
    ForeColor     =  &H00FF0000&
    Height       =  975
    Index         =  0
    Left            =  1200
    ScaleHeight  =  915
    ScaleWidth   =  915
    TabIndex        =  2
    Top          =  1080
    Visible      =  0  'False
    Width         =  975
    End
    End
    Attribute VB_Name = "FrmTTT"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Dim Xturn As Boolean, clickedunit(1 To 3, 1 To 3) As String
    Dim X As Byte, Y As Byte, gotwinner As Boolean, numruns As Byte
    Dim way1 As Boolean, way2 As Boolean, gotflag As Boolean
    Dim AIxpos As Byte, AIypos As Byte
    Dim playerscorenum As Byte, compscorenum As Byte

    Private Sub cmdnewgame_Click()
    Dim i As Byte, j As Byte
    Xturn = True
    numruns = 0
    way1 = False
    way2 = False
    For i = 1 To 9
    picboard(i).Cls
    picboard(i).Enabled = True
    Next i
    For i = 1 To 3
    For j = 1 To 3
    clickedunit(i, j) = ""
    Next j
    Next i
    For i = 1 To 9
    picboard(i).Enabled = True
    Next i
    End Sub

    Private Sub cmdquit_Click()
    End
    End Sub
    Private Sub Command1_Click()
    Form1.Show
    End Sub

    Private Sub Form_Load()
    Dim i As Byte, moveX As Single, moveY As Single
    playerscorenum = 0
    compscorenum = 0
    playerscore.Caption = playerscorenum
    compscore.Caption = compscorenum
    way1 = False
    way1 = False
    Xturn = True


    moveX = 300
    moveY = 300
    For i = 1 To 9
    If (i - 1) / 3 = Int((i - 1) / 3) And i <> 1 Then
    moveY = moveY + picboard(0).Height
    moveX = 300
    End If
    Load picboard(i)
    picboard(i).Visible = True
    picboard(i).Move moveX, moveY
    moveX = moveX + picboard(0).Width
    Next i

    End Sub

    Private Sub picboard_Click(index As Integer)
    Call getpos(index)
    If clickedunit(X, Y) = "" Then
    numruns = numruns + 1

    If Xturn = True Then
    picboard(index).ForeColor = vbBlue
    picboard(index).Line (200, 200)-(775, 775)
    picboard(index).Line (775, 200)-(200, 775)
    Xturn = False
    clickedunit(X, Y) = "X"

    Else:
    picboard(index).ForeColor = vbYellow
    picboard(index).Circle (picboard(0).Width / 2, picboard(o).Height / 2), 300
    Xturn = True
    clickedunit(X, Y) = "O"
    End If
    Call checkwin
    End If

    If Xturn = False And gotwinner = False And numruns = 1 Then
    Call AIturn
    ElseIf Xturn = False And gotwinner = False And numruns < 9 Then
    Call AIturnoff
    End If

    If numruns = 9 And gotwinner = False Then
    MsgBox "Nobody wins, nobody loses.", vbOKOnly, "Darn!"
    For X = 1 To 9
    picboard(X).Enabled = False
    Next X
    End If

    End Sub

    Private Sub getpos(index As Integer)

    Select Case index
    Case 1 To 3
    X = index
    Y = 1
    Case 4 To 6
    X = index - 3
    Y = 2
    Case 7 To 9
    X = index - 6
    Y = 3
    End Select
    End Sub

    Private Sub checkwin()
    gotwinner = False

    Y = 0
    Do
    Y = Y + 1
    If clickedunit(1, Y) <> "" And clickedunit(1, Y) = clickedunit(2, Y) And clickedunit(1, Y) = clickedunit(3, Y) Then
    Call wehaveawinner(1, Y)
    End If
    Loop Until Y = 3 Or gotwinner = True


    X = 0
    If gotwinner = False Then
    Do
    X = X + 1
    If clickedunit(X, 1) <> "" And clickedunit(X, 1) = clickedunit(X, 2) And clickedunit(X, 1) = clickedunit(X, 3) Then
    Call wehaveawinner(X, 1)
    End If
    Loop Until X = 3 Or gotwinner = True
    End If


    If gotwinner = False And clickedunit(2, 2) <> "" And clickedunit(1, 1) = clickedunit(2, 2) And clickedunit(1, 1) = clickedunit(3, 3) Then
    Call wehaveawinner(2, 2)
    End If
    If gotwinner = False And clickedunit(2, 2) <> "" And clickedunit(2, 2) = clickedunit(1, 3) And clickedunit(2, 2) = clickedunit(3, 1) Then
    Call wehaveawinner(2, 2)
    gotwinner = True
    End If
    If gotwinner = True Then
    For X = 1 To 9
    picboard(X).Enabled = False
    Next X
    End If
    End Sub

    Private Sub wehaveawinner(a As Byte, b As Byte)
    MsgBox clickedunit(a, b) & " wins the game!", vbOKOnly, "We have a winner!"
    gotwinner = True
    If clickedunit(a, b) = "X" Then
    playerscorenum = playerscorenum + 1
    playerscore.Caption = playerscorenum
    ElseIf clickedunit(a, b) = "O" Then
    compscorenum = compscorenum + 1
    compscore.Caption = compscorenum
    End If
    End Sub


    Private Sub AIturn()

    If clickedunit(2, 2) = "X" Then
    Randomize
    randomnum = Int(4 * Rnd)
    Select Case randomnum
    Case 0
    AIxpos = 1
    AIypos = 1
    Case 1
    AIxpos = 3
    AIypos = 3
    Case 2
    AIxpos = 1
    AIypos = 3
    Case 3
    AIxpos = 3
    AIypos = 1
    End Select
    way1 = True
    gotflag = True
    End If


    If clickedunit(2, 2) = "" Then
    If clickedunit(1, 1) = clickedunit(3, 3) Then
    gotflag = True
    AIxpos = 2
    AIypos = 2
    way2 = True
    ElseIf clickedunit(1, 3) = clickedunit(3, 1) Then
    gotflag = True
    AIxpos = 2
    AIypos = 2
    way2 = True
    End If
    End If

    If gotflag = True Then
    Call picboard_Click((AIypos - 1) * 3 + AIxpos)
    End If

    End Sub

    Private Sub AIturnoff()

    Dim nextchecked As Byte, nextunchecked As Byte
    Dim randomnum As Byte
    gotflag = False


    Y = 0
    Do
    Y = Y + 1
    X = 0
    nextunchecked = 2
    nextchecked = 1
    Do
    X = X + 1
    nextunchecked = nextunchecked + 1
    nextchecked = nextchecked + 1
    If nextunchecked > 3 Then
    nextunchecked = nextunchecked - 3
    End If
    If nextchecked > 3 Then
    nextchecked = nextchecked - 3
    End If
    If clickedunit(X, Y) = "O" And clickedunit(X, Y) = clickedunit(nextchecked, Y) And clickedunit(nextunchecked, Y) = "" Then
    gotflag = True
    AIxpos = nextunchecked
    AIypos = Y
    End If
    Loop Until gotflag = True Or X = 3
    Loop Until gotflag = True Or Y = 3


    If gotflag = False Then
    X = 0
    Do
    X = X + 1
    Y = 0
    nextunchecked = 2
    nextchecked = 1
    Do
    Y = Y + 1
    nextunchecked = nextunchecked + 1
    nextchecked = nextchecked + 1
    If nextunchecked > 3 Then
    nextunchecked = nextunchecked - 3
    End If
    If nextchecked > 3 Then
    nextchecked = nextchecked - 3
    End If
    If clickedunit(X, Y) = "O" And clickedunit(X, Y) = clickedunit(X, nextchecked) And clickedunit(X, nextunchecked) = "" Then
    gotflag = True
    AIxpos = X
    AIypos = nextunchecked
    End If
    Loop Until gotflag = True Or Y = 3
    Loop Until gotflag = True Or X = 3
    End If


    If gotflag = False Then
    If clickedunit(2, 2) = "O" Then
    If clickedunit(2, 2) = clickedunit(1, 1) And clickedunit(3, 3) = "" Then
    gotflag = True
    AIxpos = 3
    AIypos = 3
    ElseIf clickedunit(2, 2) = clickedunit(3, 3) And clickedunit(1, 1) = "" Then
    gotflag = True
    AIxpos = 1
    AIypos = 1
    ElseIf clickedunit(2, 2) = clickedunit(3, 1) And clickedunit(1, 3) = "" Then
    gotflag = True
    AIxpos = 1
    AIypos = 3
    ElseIf clickedunit(2, 2) = clickedunit(1, 3) And clickedunit(3, 1) = "" Then
    gotflag = True
    AIxpos = 3
    AIypos = 1
    End If
    End If
    End If

    If gotflag = True Then
    Call picboard_Click((AIypos - 1) * 3 + AIxpos)
    Else: Call AIturndef
    End If
    End Sub

    Private Sub AIturndef()

    Dim nextchecked As Byte, nextunchecked As Byte
    Dim randomnum As Byte



    Y = 0
    Do
    Y = Y + 1
    X = 0
    nextunchecked = 2
    nextchecked = 1
    Do
    X = X + 1
    nextunchecked = nextunchecked + 1
    nextchecked = nextchecked + 1
    If nextunchecked > 3 Then
    nextunchecked = nextunchecked - 3
    End If
    If nextchecked > 3 Then
    nextchecked = nextchecked - 3
    End If
    If clickedunit(X, Y) <> "" And clickedunit(X, Y) = clickedunit(nextchecked, Y) And clickedunit(nextunchecked, Y) = "" Then
    gotflag = True
    AIxpos = nextunchecked
    AIypos = Y
    End If
    Loop Until gotflag = True Or X = 3
    Loop Until gotflag = True Or Y = 3


    If gotflag = False Then
    X = 0
    Do
    X = X + 1
    Y = 0
    nextunchecked = 2
    nextchecked = 1
    Do
    Y = Y + 1
    nextunchecked = nextunchecked + 1
    nextchecked = nextchecked + 1
    If nextunchecked > 3 Then
    nextunchecked = nextunchecked - 3
    End If
    If nextchecked > 3 Then
    nextchecked = nextchecked - 3
    End If
    If clickedunit(X, Y) <> "" And clickedunit(X, Y) = clickedunit(X, nextchecked) And clickedunit(X, nextunchecked) = "" Then
    gotflag = True
    AIxpos = X
    AIypos = nextunchecked
    End If
    Loop Until gotflag = True Or Y = 3
    Loop Until gotflag = True Or X = 3
    End If


    If gotflag = False Then
    If clickedunit(2, 2) <> "" Then
    If clickedunit(2, 2) = clickedunit(1, 1) And clickedunit(3, 3) = "" Then
    gotflag = True
    AIxpos = 3
    AIypos = 3
    ElseIf clickedunit(2, 2) = clickedunit(3, 3) And clickedunit(1, 1) = "" Then
    gotflag = True
    AIxpos = 1
    AIypos = 1
    ElseIf clickedunit(2, 2) = clickedunit(3, 1) And clickedunit(1, 3) = "" Then
    gotflag = True
    AIxpos = 1
    AIypos = 3
    ElseIf clickedunit(2, 2) = clickedunit(1, 3) And clickedunit(3, 1) = "" Then
    gotflag = True
    AIxpos = 3
    AIypos = 1
    End If
    End If
    End If

    If gotflag = True Then
    Call picboard_Click((AIypos - 1) * 3 + AIxpos)
    Else: Call AIdeadends
    End If
    End Sub

    Private Sub AIdeadends()



    If way1 = True And numruns = 3 Then
    If (AIxpos = 1 And AIypos = 1) Or (AIxpos = 3 And AIypos = 3) Then
    Call randomAIclick(3, 7, 0, 0)
    ElseIf (AIxpos = 1 And AIypos = 3) Or (AIxpos = 3 And AIypos = 1) Then
    Call randomAIclick(1, 9, 0, 0)
    End If
    End If



    If way2 = True And numruns = 3 And gotflag = False Then
    If (clickedunit(1, 1) <> "" And clickedunit(1, 1) = clickedunit(3, 3)) Or clickedunit(1, 3) <> "" And clickedunit(1, 3) = clickedunit(3, 1) Then
    Call randomAIclick(2, 4, 6, 8)
    End If
    End If


    If way2 = True And numruns = 3 And gotflag = False Then
    If clickedunit(2, 1) = "X" And (clickedunit(1, 3) = "X" Or clickedunit(2, 3) = "X" Or clickedunit(3, 3) = "X") Then
    Call randomAIclick(4, 6, 0, 0)
    ElseIf clickedunit(2, 3) = "X" And (clickedunit(1, 1) = "X" Or clickedunit(2, 1) = "X" Or clickedunit(3, 1) = "X") Then
    Call randomAIclick(4, 6, 0, 0)
    ElseIf clickedunit(1, 2) = "X" And (clickedunit(3, 1) = "X" Or clickedunit(3, 2) = "X" Or clickedunit(3, 3) = "X") Then
    Call randomAIclick(2, 8, 0, 0)
    ElseIf clickedunit(3, 2) = "X" And (clickedunit(1, 1) = "X" Or clickedunit(1, 2) = "X" Or clickedunit(1, 3) = "X") Then
    Call randomAIclick(2, 8, 0, 0)
    End If
    End If


    If numruns = 3 And way2 = True And gotflag = False Then
    If clickedunit(2, 1) = "X" And clickedunit(2, 1) = clickedunit(1, 2) Then
    Call randomAIclick(1, 3, 7, 0)
    ElseIf clickedunit(2, 1) = "X" And clickedunit(3, 2) = clickedunit(2, 1) Then
    Call randomAIclick(1, 3, 9, 0)
    ElseIf clickedunit(2, 3) = "X" And clickedunit(1, 2) = clickedunit(2, 3) Then
    Call randomAIclick(1, 7, 9, 0)
    ElseIf clickedunit(2, 3) = "X" And clickedunit(3, 2) = clickedunit(2, 3) Then
    Call randomAIclick(3, 7, 9, 0)
    End If
    End If


    If numruns = 5 And gotflag = False And (clickedunit(2, 1) <> "" And clickedunit(2, 2) <> "" And clickedunit(2, 3) <> "") And (clickedunit(1, 2) <> "" And clickedunit(2, 2) <> "" And clickedunit(3, 2) <> "") Then
    Select Case "O"
    Case Is = clickedunit(2, 1)
    Call randomAIclick(1, 3, 0, 0)
    Case Is = clickedunit(1, 2)
    Call randomAIclick(1, 7, 0, 0)
    Case Is = clickedunit(3, 2)
    Call randomAIclick(3, 9, 0, 0)
    Case Is = clickedunit(2, 3)
    Call randomAIclick(7, 9, 0, 0)
    End Select
    End If


    If numruns = 5 And gotflag = False And (clickedunit(2, 1) <> "" And clickedunit(2, 2) <> "" And clickedunit(2, 3) <> "") Or (clickedunit(1, 2) <> "" And clickedunit(2, 2) <> "" And clickedunit(3, 2) <> "") Then
    If clickedunit(1, 1) = "X" Then
    Call randomAIclick(3, 7, 9, 0)
    ElseIf clickedunit(3, 1) = "X" Then
    Call randomAIclick(1, 7, 9, 0)
    ElseIf clickedunit(3, 3) = "X" Then
    Call randomAIclick(1, 3, 7, 0)
    ElseIf clickedunit(1, 3) = "X" Then
    Call randomAIclick(1, 3, 9, 0)
    End If
    End If
    If gotflag = False Then
    Call AIrandompick
    End If
    End Sub

    Private Sub AIrandompick()
    Dim countavailable As Byte, randomnum As Byte, availcoordinate(1 To 9) As Integer
    countavailable = 0

    For Y = 1 To 3
    For X = 1 To 3
    If clickedunit(X, Y) = "" Then
    countavailable = countavailable + 1
    availcoordinate(countavailable) = ((Y - 1) * 3 + X)
    End If
    Next X
    Next Y

    Randomize
    randomnum = Int(Rnd * countavailable)
    Select Case randomnum
    Case 0
    Call picboard_Click(availcoordinate(1))
    Case 1
    Call picboard_Click(availcoordinate(2))
    Case 2
    Call picboard_Click(availcoordinate(3))
    Case 3
    Call picboard_Click(availcoordinate(4))
    Case 4
    Call picboard_Click(availcoordinate(5))
    Case 5
    Call picboard_Click(availcoordinate(6))
    Case 6
    Call picboard_Click(availcoordinate(7))
    Case 7
    Call picboard_Click(availcoordinate(8))
    Case 8
    Call picboard_Click(availcoordinate(9))
    End Select
    End Sub

    Private Sub randomAIclick(a As Integer, b As Integer, c As Integer, d As Integer)
    Dim randomnum As Byte
    Randomize


    If d = 0 And c = 0 Then
    randomnum = Int(Rnd * 2)
    ElseIf d = 0 Then
    randomnum = Int(Rnd * 3)
    Else: randomnum = Int(Rnd * 3)
    End If

    Select Case randomnum
    Case 0
    Call picboard_Click(a)
    Case 1
    Call picboard_Click(b)
    Case 2
    Call picboard_Click(c)
    Case 3
    Call picboard_Click(d)
    End Select

    gotflag = True
    End Sub
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей