Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing TicTacMulti.frm (22.97 KB)
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form TicTacToeMultiForm
BorderStyle = 3 'Fixed Dialog
Caption = "TCP/IP Tic Tac Toe Game"
ClientHeight = 6195
ClientLeft = 45
ClientTop = 615
ClientWidth = 6630
ClipControls = 0 'False
Icon = "TicTacMulti.frx":0000
LinkTopic = "TicTacToeMultiForm"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6195
ScaleWidth = 6630
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame4
Caption = "Status"
Height = 735
Left = 3240
TabIndex = 21
Top = 1200
Width = 3255
Begin VB.Label Msg
AutoSize = -1 'True
Caption = "Host's Turn."
Height = 195
Left = 120
TabIndex = 22
Top = 360
Width = 855
End
End
Begin VB.Frame Frame2
Caption = "Tic Tac Toe - Game 0"
Height = 3255
Left = 120
TabIndex = 11
Top = 120
Width = 3015
Begin VB.Line X2
BorderWidth = 3
Index = 9
Visible = 0 'False
X1 = 2040
X2 = 2640
Y1 = 2145
Y2 = 2745
End
Begin VB.Line X1
BorderWidth = 3
Index = 9
Visible = 0 'False
X1 = 2640
X2 = 2040
Y1 = 2145
Y2 = 2745
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 9
Left = 2040
Shape = 3 'Circle
Top = 2145
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 8
Left = 1200
Shape = 3 'Circle
Top = 2145
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 7
Left = 360
Shape = 3 'Circle
Top = 2145
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 6
Left = 2040
Shape = 3 'Circle
Top = 1305
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 5
Left = 1200
Shape = 3 'Circle
Top = 1305
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 4
Left = 360
Shape = 3 'Circle
Top = 1305
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 3
Left = 2040
Shape = 3 'Circle
Top = 465
Visible = 0 'False
Width = 615
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 2
Left = 1200
Shape = 3 'Circle
Top = 465
Visible = 0 'False
Width = 615
End
Begin VB.Line X1
BorderWidth = 3
Index = 8
Visible = 0 'False
X1 = 1800
X2 = 1200
Y1 = 2145
Y2 = 2745
End
Begin VB.Line X2
BorderWidth = 3
Index = 8
Visible = 0 'False
X1 = 1200
X2 = 1800
Y1 = 2145
Y2 = 2745
End
Begin VB.Line X1
BorderWidth = 3
Index = 7
Visible = 0 'False
X1 = 960
X2 = 360
Y1 = 2145
Y2 = 2745
End
Begin VB.Line X2
BorderWidth = 3
Index = 7
Visible = 0 'False
X1 = 360
X2 = 960
Y1 = 2145
Y2 = 2745
End
Begin VB.Line X1
BorderWidth = 3
Index = 6
Visible = 0 'False
X1 = 2640
X2 = 2040
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X2
BorderWidth = 3
Index = 6
Visible = 0 'False
X1 = 2040
X2 = 2640
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X1
BorderWidth = 3
Index = 5
Visible = 0 'False
X1 = 1800
X2 = 1200
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X2
BorderWidth = 3
Index = 5
Visible = 0 'False
X1 = 1200
X2 = 1800
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X1
BorderWidth = 3
Index = 4
Visible = 0 'False
X1 = 960
X2 = 360
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X2
BorderWidth = 3
Index = 4
Visible = 0 'False
X1 = 360
X2 = 960
Y1 = 1305
Y2 = 1905
End
Begin VB.Line X1
BorderWidth = 3
Index = 3
Visible = 0 'False
X1 = 2640
X2 = 2040
Y1 = 465
Y2 = 1065
End
Begin VB.Line X2
BorderWidth = 3
Index = 3
Visible = 0 'False
X1 = 2040
X2 = 2640
Y1 = 465
Y2 = 1065
End
Begin VB.Line X1
BorderWidth = 3
Index = 2
Visible = 0 'False
X1 = 1800
X2 = 1200
Y1 = 465
Y2 = 1065
End
Begin VB.Line X2
BorderWidth = 3
Index = 2
Visible = 0 'False
X1 = 1185
X2 = 1785
Y1 = 480
Y2 = 1080
End
Begin VB.Line X1
BorderWidth = 3
Index = 1
Visible = 0 'False
X1 = 960
X2 = 360
Y1 = 465
Y2 = 1065
End
Begin VB.Line X2
BorderWidth = 3
Index = 1
Visible = 0 'False
X1 = 360
X2 = 960
Y1 = 465
Y2 = 1065
End
Begin VB.Shape O
BorderWidth = 4
Height = 615
Index = 1
Left = 360
Shape = 3 'Circle
Top = 465
Visible = 0 'False
Width = 615
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 1
Left = 240
TabIndex = 18
Top = 360
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 2
Left = 1080
TabIndex = 19
Top = 360
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 3
Left = 1920
TabIndex = 20
Top = 360
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 5
Left = 1080
TabIndex = 13
Top = 1185
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 6
Left = 1920
TabIndex = 12
Top = 1185
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 4
Left = 240
TabIndex = 17
Top = 1185
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 9
Left = 1920
TabIndex = 14
Top = 2025
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 8
Left = 1080
TabIndex = 15
Top = 2025
Width = 855
End
Begin VB.Label Square
BorderStyle = 1 'Fixed Single
Height = 855
Index = 7
Left = 240
TabIndex = 16
Top = 2025
Width = 855
End
End
Begin VB.Frame Frame3
Caption = "Scores"
Height = 975
Left = 3240
TabIndex = 8
Top = 120
Width = 3255
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Host (X): 0"
Height = 195
Left = 120
TabIndex = 10
Top = 360
Width = 750
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Client (O): 0"
Height = 195
Left = 120
TabIndex = 9
Top = 600
Width = 825
End
End
Begin VB.Timer Timer1
Interval = 1000
Left = 120
Top = 3480
End
Begin VB.Frame Frame1
Caption = "Chat Information"
Height = 1335
Left = 3240
TabIndex = 5
Top = 2040
Width = 3255
Begin VB.ComboBox Combo1
Height = 315
ItemData = "TicTacMulti.frx":000C
Left = 1320
List = "TicTacMulti.frx":0025
Style = 2 'Dropdown List
TabIndex = 1
Top = 840
Width = 1695
End
Begin VB.TextBox Text5
Height = 285
Left = 1320
MaxLength = 20
TabIndex = 0
Top = 360
Width = 1695
End
Begin VB.Label Label3
Caption = "Your Text Color:"
Height = 255
Left = 120
TabIndex = 7
Top = 870
Width = 1215
End
Begin VB.Label Label4
Caption = "Nickname:"
Height = 255
Left = 480
TabIndex = 6
Top = 390
Width = 855
End
End
Begin VB.CommandButton Command1
Caption = "&Send"
Default = -1 'True
Height = 285
Left = 5520
TabIndex = 3
Top = 5760
Width = 975
End
Begin VB.TextBox Text1
Height = 285
Left = 120
MaxLength = 250
TabIndex = 2
Top = 5760
Width = 5295
End
Begin RichTextLib.RichTextBox RichTextBox1
Height = 2175
Left = 120
TabIndex = 4
Top = 3480
Width = 6375
_ExtentX = 11245
_ExtentY = 3836
_Version = 393217
ReadOnly = -1 'True
ScrollBars = 2
TextRTF = $"TicTacMulti.frx":0059
End
Begin VB.Menu File
Caption = "&File"
Begin VB.Menu NewGame
Caption = "&New Game..."
Shortcut = ^N
End
Begin VB.Menu Blank2
Caption = "-"
End
Begin VB.Menu Disconnect
Caption = "&Disconnect"
Shortcut = ^D
End
Begin VB.Menu SendBeep
Caption = "&Send Beep"
Shortcut = ^B
End
Begin VB.Menu Blank1
Caption = "-"
End
Begin VB.Menu ConnTimeDisplay
Caption = "Connection &Time"
Shortcut = ^T
End
Begin VB.Menu SaveChatText
Caption = "Save Game Session Info"
Shortcut = ^S
End
End
Begin VB.Menu ChatMenu
Caption = "&Chat"
Begin VB.Menu ClearChat
Caption = "Clear Chat &Window"
Shortcut = ^W
End
End
Begin VB.Menu OtherMenu
Caption = "&Other"
Begin VB.Menu VisitMindPowerWebsite
Caption = "&Visit MindPower Website..."
End
End
End
Attribute VB_Name = "TicTacToeMultiForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MsgColors()
Dim Min, Sec, ConnTime, GameNum
Dim HostWins, ClientWins
Sub MakeClientMove()
If TCPIPName = "Host" Then Msg.Caption = "Client's Turn."
If TCPIPName = "Client" Then Msg.Caption = "Your Turn."
End Sub
Sub DrawSquare(i As Integer)
Select Case Board(i)
Case PlayerX
X1(i).Visible = True
X2(i).Visible = True
Case PlayerO
O(i).Visible = True
End Select
End Sub
Private Sub ConnTimeDisplay_Click()
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = vbMagenta
RichTextBox1.SelText = "Connection Time: "
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = vbBlack
RichTextBox1.SelText = ConnTime & vbCrLf
End Sub
Private Sub Disconnect_Click()
TicTacToeConnForm.Winsock1.Close
Unload Me
Unload TicTacToeConnForm
End Sub
Private Sub Form_Load()
PlayerX = PLAYER_HOST
PlayerO = PLAYER_CLIENT
If TCPIPName = "Host" Then You = PLAYER_HOST
If TCPIPName = "Client" Then You = PLAYER_CLIENT
HostWins = 0
ClientWins = 0
Combo1.ListIndex = 0
ReDim MsgColors(6)
MsgColors(0) = vbBlack
MsgColors(1) = vbRed
MsgColors(2) = vbYellow
MsgColors(3) = vbGreen
MsgColors(4) = vbBlue
MsgColors(5) = vbCyan
MsgColors(6) = vbMagenta
ConnTime = "00:00"
Min = 0
Sec = 0
GameNum = 0
StartNewGame
End Sub
Function GameOver() As Integer
Dim pl As Integer
pl = Winner()
If pl = PLAYER_NONE Then
GameOver = False
Exit Function
End If
GameInProgress = False
If pl = PlayerX Then
Msg.Caption = "X Wins. (Host)"
HostWins = HostWins + 1
Label1.Caption = "Host (X): " & HostWins
ElseIf pl = PlayerO Then
Msg.Caption = "O Wins. (Client)"
ClientWins = ClientWins + 1
Label2.Caption = "Client (O): " & ClientWins
Else
Msg.Caption = "No One Wins."
End If
Beep
GameOver = True
End Function
Sub MakeHostMove()
If TCPIPName = "Host" Then Msg.Caption = "Your Turn."
If TCPIPName = "Client" Then Msg.Caption = "Host's Turn."
End Sub
Sub PlayerHasMoved()
If NextPlayer = PLAYER_CLIENT Then MakeClientMove
If NextPlayer = PLAYER_HOST Then MakeHostMove
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then
TicTacToeConnForm.Winsock1.Close
Unload Me
Unload TicTacToeConnForm
End If
End Sub
Private Sub NewGame_Click()
If TCPIPName = "Client" Then
MsgBox "Only The Host Can Start A New Game."
Exit Sub
End If
If GameInProgress Then
MsgBox "Cannot Start A New Game When A Game Is In Progress."
Exit Sub
End If
StartNewGame
SendCmd "new_game:"
End Sub
Private Sub SaveChatText_Click()
On Error Resume Next
F = CurDir
If Right(F, 1) <> "\" Then F = F + "\"
F = F + "GameInfo.txt"
M = MsgBox("Save Game Session Info To File: " + F, vbOKCancel + vbQuestion)
If M = 2 Then Exit Sub
L = FileLen(F)
If L > 0 Then
M = MsgBox("File Already Exists, Append To Old File?", vbYesNoCancel + vbQuestion)
If M = 2 Then Exit Sub
If M = 6 Then Open F For Append As #1
End If
If M = 7 Or L = 0 Then Open F For Output As #1
Print #1, "Game Session Info (" + Str$(Time) + " | " + Str$(Date) + "):"
Print #1, "Host: " + HostIP + " (Score: " & HostWins & ")"
Print #1, "Client: " + ClientIP + " (Score: " & ClientWins & ")"
Print #1, "You: " + TCPIPName
Print #1, "Games Played: " & GameNum
Print #1, "Connection Time: " + ConnTime
Print #1, "-----------------"
Print #1, "Chat Window Text:"
Print #1, RichTextBox1.Text
Close #1
End Sub
Private Sub Square_Click(Index As Integer)
If Not GameInProgress And TCPIPName = "Host" Then
SendCmd "new_game:"
StartNewGame
Exit Sub
End If
If Not GameInProgress And TCPIPName = "Client" Then
MsgBox "Only The Host Can Start A New Game."
Exit Sub
End If
If Board(Index) <> PLAYER_NONE Or NextPlayer <> You Then Exit Sub
Board(Index) = NextPlayer
DrawSquare Index
If TCPIPName = "Host" Then NextPlayer = PLAYER_CLIENT
If TCPIPName = "Client" Then NextPlayer = PLAYER_HOST
SendCmd "player_move:" & Index
If GameOver() Then Exit Sub
PlayerHasMoved
End Sub
Sub StartNewGame()
Dim i As Integer
For i = 1 To NUM_SQUARES
Board(i) = PLAYER_NONE
X1(i).Visible = False
X2(i).Visible = False
O(i).Visible = False
Next i
NextPlayer = PlayerX
GameInProgress = True
GameNum = GameNum + 1
Frame2.Caption = "Tic Tac Toe - Game " & GameNum
PlayerHasMoved
End Sub
Function Winner() As Integer
Dim i As Integer
For i = 1 To 7 Step 3
If Board(i) <> PLAYER_NONE Then
If Board(i) = Board(i + 1) And Board(i) = Board(i + 2) Then
Winner = Board(i)
Exit Function
End If
End If
Next i
For i = 1 To 3
If Board(i) <> PLAYER_NONE Then
If Board(i) = Board(i + 3) And Board(i) = Board(i + 6) Then
Winner = Board(i)
Exit Function
End If
End If
Next i
If Board(1) <> PLAYER_NONE Then
If Board(1) = Board(5) And Board(1) = Board(9) Then
Winner = Board(1)
Exit Function
End If
End If
If Board(3) <> PLAYER_NONE Then
If Board(3) = Board(5) And Board(3) = Board(7) Then
Winner = Board(3)
Exit Function
End If
End If
Winner = PLAYER_NONE
For i = 1 To NUM_SQUARES
If Board(i) = PLAYER_NONE Then Exit Function
Next i
Winner = PLAYER_DRAW
End Function
Sub SendCmd(Cmd As String)
TicTacToeConnForm.Winsock1.SendData Cmd
End Sub
Private Sub ClearChat_Click()
RichTextBox1.Text = ""
End Sub
Private Sub Command1_Click()
NN = Text5.Text
On Error Resume Next
If NN = "" Then NN = TCPIPName
SendCmd "ch_msg:" & Combo1.ListIndex & ":" + NN & vbTab & Text1.Text
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = vbBlue
RichTextBox1.SelText = NN + ": "
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = MsgColors(Combo1.ListIndex)
RichTextBox1.SelText = Text1.Text & vbCrLf
Text1.Text = ""
Text1.SetFocus
If Err Then MsgBox "Error: " + Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub SendBeep_Click()
On Error Resume Next
NN = Text5.Text
If NN = "" Then NN = TCPIPName
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = vbBlue
RichTextBox1.SelText = NN + ": "
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelColor = MsgColors(Combo1.ListIndex)
RichTextBox1.SelText = "Beep!" & vbCrLf
Beep
SendCmd "ch_send_beep:" & Combo1.ListIndex & ":" + NN
SendBeep.Enabled = False
End Sub
Private Sub Text1_Click()
Command1.Default = True
End Sub
Private Sub Text5_GotFocus()
Text5.SelStart = 0
Text5.SelLength = Len(Text5.Text)
End Sub
Private Sub Timer1_Timer()
Sec = Sec + 1
If Sec > 59 Then Sec = 0: Min = Min + 1
If Min < 10 Then Min2 = "0"
If Sec < 10 Then Sec2 = "0"
ConnTime = Min2 & Min & ":" + Sec2 & Sec
SendBeep.Enabled = True
End Sub
Private Sub VisitMindPowerWebsite_Click()
On Error GoTo NoF
a$ = "C:\Program Files\Internet Explorer\Iexplore.exe"
L = FileLen(a$)
W = Shell(a$ & " http://mindpower.tytek.net/", 1)
Exit Sub
NoF:
M = MsgBox("Internet Explorer Browser Not Found!", vbOKOnly + vbExclamation, "Error")
End Sub