Free Games Forum: Game Technology: Visual Basic / VB: Tic-Tac-To Coding.


	FORUM HOME	SEARCH POSTS	WHO'S ONLINE	LOG IN	RULES / FAQ REPORT SPAM

Free Games Forum: Game Technology: Visual Basic / VB:
Tic-Tac-To Coding.

Print Thread

Impersonater
Enthusiast

Aug 10, 2005, 8:55 AM

Post #1 of 6 (407 views)
Shortcut

Tic-Tac-To Coding.	Can't Post

Ok so you want a tic-tac-to game of your own? Well here is the code make sure you got all the labels.

Option Explicit
Dim owin As Integer
Dim xwin As Integer
Dim gnum As Integer
Dim tiedg As Integer
Dim moves As Integer
Dim xoro As String
Dim x As String
Dim comp As Integer
Dim kswitch As Integer
Dim diff As Integer
Dim s As Boolean
Dim done As Integer
Dim square As Integer
Dim y As Boolean
Dim yn As String
Dim dblscore As Integer
Private Function cdone()
done = rowcheck()
If (done <> -1) Then
dblscore = dblscore + 1
Call printmsg("row", done)
End If
done = colcheck()
If (done <> -1) Then
dblscore = dblscore + 1
Call printmsg("col", done)
End If
done = diagcheck()
If (done <> -1) Then
dblscore = dblscore + 1
Call printmsg("diag", done)
End If
End Function
Private Function gquit()
Dim ii As Integer
For ii = 0 To 9
Text1(ii).Enabled = False
Next ii
Call win
End Function
Private Function movesf()
If (moves = 10) Then
tiedg = tiedg + 1
MsgBox "The game is a tie."
Text4.Text = Str(tiedg)
Call gquit
End If
End Function
Private Function win()
moves = 0
If (dblscore = 1) Then
If (xoro = "X") Then
xwin = xwin + 1
Text2.Text = Str(xwin)
Else
owin = owin + 1
Text3.Text = Str(owin)
End If
Else
If (xoro = "X") Then
xwin = xwin
Text2.Text = Str(xwin)
Else
owin = owin
Text3.Text = Str(owin)
End If
End If
kswitch = 1
End Function

Private Function rowcheck()
Dim a As Boolean
Dim ii As Integer
rowcheck = -1
For ii = 0 To 6 Step 3
a = (Text1(ii).Text = Text1(ii + 1).Text) And (Text1(ii + 1).Text = Text1(ii + 2).Text)
If (a = True And (Text1(ii).Text <> "")) Then
Text1(ii).BackColor = vbYellow
Text1(ii + 1).BackColor = vbYellow
Text1(ii + 2).BackColor = vbYellow
rowcheck = ii
End If
Next ii
a = (Text1(7).Text = Text1(8).Text) And (Text1(8).Text = Text1(9).Text)
If (a And Text1(7).Text <> "") Then
Text1(7).BackColor = vbYellow
Text1(8).BackColor = vbYellow
Text1(9).BackColor = vbYellow
rowcheck = 12
End If
End Function
Private Function colcheck()
Dim a As Boolean
Dim ii As Integer
colcheck = -1
For ii = 0 To 2 Step 1
a = (Text1(ii).Text = Text1(ii + 3).Text) And (Text1(ii + 3).Text = Text1(ii + 6).Text)
If (a = True And (Text1(ii).Text <> "")) Then
Text1(ii).BackColor = vbYellow
Text1(ii + 3).BackColor = vbYellow
Text1(ii + 6).BackColor = vbYellow
colcheck = ii
End If
Next ii
End Function
Private Function diagcheck()
Dim a As Boolean
diagcheck = -1
a = (Text1(0).Text = Text1(4).Text) And (Text1(4).Text = Text1(8).Text)
If (a = True And (Text1(0).Text <> "")) Then
Text1(0).BackColor = vbYellow
Text1(4).BackColor = vbYellow
Text1(8).BackColor = vbYellow
diagcheck = 0
End If
a = (Text1(2).Text = Text1(4).Text) And (Text1(4).Text = Text1(6).Text)
If (a = True And (Text1(2).Text <> "")) Then
Text1(2).BackColor = vbYellow
Text1(4).BackColor = vbYellow
Text1(6).BackColor = vbYellow
diagcheck = 2
End If
a = (Text1(1).Text = Text1(5).Text) And (Text1(5).Text = Text1(9).Text)
If (a = True And (Text1(1).Text <> "")) Then
Text1(1).BackColor = vbYellow
Text1(5).BackColor = vbYellow
Text1(9).BackColor = vbYellow
diagcheck = 1
End If
End Function
Private Function printmsg(x As String, done As Integer)
Select Case x
Case "row"
If (done < 12) Then
xoro = Text1(done).Text
Else
xoro = Text1(7).Text
End If
MsgBox xoro & " has won by row " & Str(done / 3)
Call gquit
Case "col"
xoro = Text1(done).Text
MsgBox xoro & " has won by col " & Str(done)
Call gquit
Case "diag"
xoro = Text1(done).Text
MsgBox xoro & " has won by diagonal " & Str(done)
Call gquit
End Select
End Function

Private Sub Command1_Click()
Dim ii As Integer
dblscore = 0
kswitch = 0
moves = 0
gnum = gnum + 1
Text5.Text = gnum
For ii = 0 To 9
Text1(ii).Text = ""
Text1(ii).BackColor = vbGreen
Text1(ii).Enabled = True
Next ii
xoro = InputBox("who goes first X or O?", "tic tac toe", "X")
xoro = UCase(xoro)
Do While (xoro <> "X") And (xoro <> "O")
MsgBox "sorry, your choices are X or O"
xoro = InputBox("who goes first X or O?", , "X")
Loop
y = (yn = 1) And (xoro = "O")
If (y = True) And (moves = 0) Then
comp = 1
moves = moves + 1
Text1(4).Text = "O"
Text1(4).BackColor = vbRed
xoro = "X"
Else
If (yn = 1) Then
comp = 1
Option1.Enabled = True
Option2.Enabled = True
Else
comp = 0
Option1.Enabled = False
Option2.Enabled = False
End If
End If
End Sub

Private Sub Command2_Click()
Dim ii As Integer
Text2.Text = "0"
Text3.Text = "0"
Text4.Text = "0"
Text5.Text = "0"
For ii = 0 To 9
Text1(ii).Text = ""
Text1(ii).BackColor = vbGreen
Next ii
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
'fix that damn "X" bug
Form1.Caption = "Tic Tac Toe"
Form1.Show
dblscore = 0
diff = 1
comp = 0
kswitch = 0
gnum = 1
moves = 0
xwin = 0
owin = 0
tiedg = 0
yn = InputBox("Select number of players.", "Player Number", "1")
Do While (yn <> "1") And (yn <> "2")
MsgBox "Sorry, must be 1 or 2."
yn = InputBox("Number or players?", "Player Number", "1")
Loop
xoro = InputBox("who goes first X or O?", "tic tac toe", "X")
xoro = UCase(xoro)
Do While (xoro <> "X") And (xoro <> "O")
MsgBox "Sorry, your choices are X or O"
xoro = InputBox("Who goes first X or O?", "tic tac toe", "X")
Loop
y = (yn = 1) And (xoro = "O")
If (y = True) And (moves = 0) Then
comp = 1
moves = moves + 1
Text1(4).Text = "O"
Text1(4).BackColor = vbRed
xoro = "X"
Else
If (yn = 1) Then
comp = 1
Option1.Enabled = True
Option2.Enabled = True
Else
comp = 0
Option1.Enabled = False
Option2.Enabled = False
End If
End If
End Sub

Private Sub Option1_Click()
diff = 1
End Sub

Private Sub Option2_Click()
diff = 2
End Sub

Private Sub Text1_Click(Index As Integer)
Dim ii As Integer
If (comp = 0) Then
moves = moves + 1
If (Text1(Index).Text = "") Then
Text1(Index).Text = xoro
Text1(Index).BackColor = vbRed
Call cdone
If xoro = "X" Then
xoro = "O"
Else
xoro = "X"
End If
Else
MsgBox "Sorry, already selected."
moves = moves - 1
End If
End If
If (comp = 1) Then
moves = moves + 1
If xoro = "X" And Text1(Index).Text = "" Then
If (moves = 10) Then
Text1(Index).Text = "X"
Text1(Index).BackColor = vbRed
kswitch = 1
Else
Text1(Index).Text = "X"
Text1(Index).BackColor = vbRed
End If
Call cdone
If kswitch = 1 Then
Call movesf
xoro = "X"
Exit Sub
Else
xoro = "O"
End If
Else
MsgBox "Sorry, already selected."
moves = moves - 1
xoro = "X"
Exit Sub
End If
End If
s = (comp = 1) And (xoro = "O")
If (s = True) And (diff >= 1) Then
Dim i As Integer
Dim a As Boolean
If (diff = 2) Then
For i = 0 To 6 Step 3
a = (Text1(i).Text = "") And (Text1(i + 1).Text = Text1(i + 2).Text)
If (a = True) And (Text1(i + 1).Text = "X" Or Text1(i + 1).Text = "O") Then
Text1(i).Text = "O"
Text1(i).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 6 Step 3
a = (Text1(i + 1).Text = "") And (Text1(i).Text = Text1(i + 2).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 1).Text = "O"
Text1(i + 1).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 6 Step 3
a = (Text1(i + 2).Text = "") And (Text1(i).Text = Text1(i + 1).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 2).Text = "O"
Text1(i + 2).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 1 Step 1
a = (Text1(i).Text = "") And (Text1(i + 4).Text = Text1(i + 8).Text)
If (a = True) And (Text1(i + 4).Text = "X" Or Text1(i + 4).Text = "O") Then
Text1(i).Text = "O"
Text1(i).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 1 Step 1
a = (Text1(i + 8).Text = "") And (Text1(i).Text = Text1(i + 4).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 8).Text = "O"
Text1(i + 8).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 1 Step 1
a = (Text1(i + 4).Text = "") And (Text1(i).Text = Text1(i + 8).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 4).Text = "O"
Text1(i + 4).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 2 Step 1
a = (Text1(i).Text = "") And (Text1(i + 3).Text = Text1(i + 6).Text)
If (a = True) And (Text1(i + 3).Text = "X" Or Text1(i + 3).Text = "O") Then
Text1(i).Text = "O"
Text1(i).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 2 Step 1
a = (Text1(i + 3).Text = "") And (Text1(i).Text = Text1(i + 6).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 3).Text = "O"
Text1(i + 3).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
For i = 0 To 2 Step 1
a = (Text1(i + 6).Text = "") And (Text1(i).Text = Text1(i + 3).Text)
If (a = True) And (Text1(i).Text = "X" Or Text1(i).Text = "O") Then
Text1(i + 6).Text = "O"
Text1(i + 6).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
Next i
a = (Text1(2).Text = "") And (Text1(4).Text = Text1(6).Text)
If (a = True) And (Text1(4).Text = "X" Or Text1(4).Text = "O") Then
Text1(2).Text = "O"
Text1(2).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
a = (Text1(4).Text = "") And (Text1(2).Text = Text1(6).Text)
If (a = True) And (Text1(2).Text = "X" Or Text1(2).Text = "O") Then
Text1(4).Text = "O"
Text1(4).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
a = (Text1(6).Text = "") And (Text1(2).Text = Text1(4).Text)
If (a = True) And (Text1(2).Text = "X" Or Text1(2).Text = "O") Then
Text1(6).Text = "O"
Text1(6).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
a = (Text1(7).Text = "") And (Text1(8).Text = Text1(9).Text)
If (a = True) And (Text1(8).Text = "X" Or Text1(8).Text = "O") Then
Text1(7).Text = "O"
Text1(7).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
a = (Text1(8).Text = "") And (Text1(7).Text = Text1(9).Text)
If (a = True) And (Text1(7).Text = "X" Or Text1(7).Text = "O") Then
Text1(8).Text = "O"
Text1(8).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
a = (Text1(9).Text = "") And (Text1(7).Text = Text1(8).Text)
If (a = True) And (Text1(7).Text = "X" Or Text1(7).Text = "O") Then
Text1(9).Text = "O"
Text1(9).BackColor = vbRed
moves = moves + 1
xoro = "X"
Call cdone
Call movesf
Exit Sub
End If
squ:
Randomize
square = Int(Rnd * 10)
If s = True And (Text1(square).Text = "") Then
moves = moves + 1
Text1(square).Text = "O"
Text1(square).BackColor = vbRed
Call cdone
Call movesf
xoro = "X"
Else
GoTo squ
End If
Exit Sub
Else
sq:
Randomize
square = Int(Rnd * 10)
If s = True And (Text1(square).Text = "") Then
moves = moves + 1
Text1(square).Text = "O"
Text1(square).BackColor = vbRed
Call cdone
xoro = "X"
Else
GoTo sq
End If
xoro = "X"
Call movesf
End If
End If
End Sub

-------> WOOT im a Enthusiast! <----------

Jakestah
Veteran

Aug 10, 2005, 8:56 AM

Post #2 of 6 (404 views)
Shortcut

Re: [Impersonater] Tic-Tac-To Coding. [In reply to]	Can't Post

Hmm. That's allot of code for a simple tic tac toe game lol

Lotus Lecetoy
Veteran

Aug 10, 2005, 2:19 PM

Post #3 of 6 (397 views)
Shortcut

Re: [Impersonater] Tic-Tac-To Coding. [In reply to]	Can't Post

If you use the code tags it's a lot more appealing to the eye and easier to read.

______
http://freewebs.com/matthewlecetoy

"The only rules that really matter are these: what a man can do and what a man can't do."

Impersonater
Enthusiast

Aug 10, 2005, 3:17 PM

Post #4 of 6 (394 views)
Shortcut

Re: [Lotus Lecetoy] Tic-Tac-To Coding. [In reply to]	Can't Post

Lol get over it. I made it real good Wink

And you know it Pirate

-------> WOOT im a Enthusiast! <----------

Deltastone
Member

Aug 24, 2005, 4:13 PM

Post #5 of 6 (361 views)
Shortcut

Re: [Impersonater] Tic-Tac-To Coding. [In reply to]	Can't Post

I was going to read through it, but its just way too much.

____________________________

"The diffrence between fiction and reality, is that fiction has to make sense."-Tom Clancy

hexscript
Member

Nov 21, 2005, 2:18 PM

Post #6 of 6 (282 views)
Shortcut

Re: [Deltastone] Tic-Tac-To Coding. [In reply to]	Can't Post

i was gunna read through it and i was like [Expletive Deleted] i fergot i cant read lol Tongue

========================================
-'`'-.,.-'` NoT ThE SmArTeSt EGGO In ThE FREEzR`'-.,.-'`'-

Print Thread

Search for (options)

Web Design by Web Ideas - Page loaded in: 0.17 s on (CGI/1.1)