VERSION 5.00 Begin VB.Form frmTictactoe BackColor = &H80000012& BorderStyle = 1 'Fixed Single Caption = "Tic Tac Toe" ClientHeight = 5880 ClientLeft = 120 ClientTop = 390 ClientWidth = 9930 ForeColor = &H8000000E& LinkTopic = "Form1" MaxButton = 0 'False Moveable = 0 'False ScaleHeight = 7167.753 ScaleMode = 0 'User ScaleWidth = 10802.62 StartUpPosition = 2 'CenterScreen Begin VB.TextBox txtEndGame Appearance = 0 'Flat BackColor = &H80000008& BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 435 Left = 6360 Locked = -1 'True TabIndex = 25 Top = 4020 Width = 3495 End Begin VB.CommandButton cmdCont Caption = "Keep Playing" Height = 735 Left = 7032 TabIndex = 24 ToolTipText = "Play new game using current values" Top = 120 Width = 735 End Begin VB.TextBox txtDiff Appearance = 0 'Flat BackColor = &H80000008& BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H000080FF& Height = 375 Left = 6360 Locked = -1 'True TabIndex = 23 Text = " " Top = 1805 Width = 3495 End Begin VB.CommandButton cmdReset Caption = "Restart" Height = 735 Left = 6251 TabIndex = 22 ToolTipText = "Start over with new values" Top = 120 Width = 735 End Begin VB.TextBox txtWho Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000006& BeginProperty Font Name = "Times New Roman" Size = 9.75 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000A& Height = 390 Left = 480 Locked = -1 'True TabIndex = 21 Text = " " Top = 0 Width = 5699 End Begin VB.TextBox txtHCTurn Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000012& BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H0000FFFF& Height = 375 Left = 6360 Locked = -1 'True TabIndex = 14 Text = " " Top = 1080 Width = 3495 End Begin VB.CommandButton cmdBegin Caption = "Ready" Height = 735 Left = 7813 TabIndex = 13 ToolTipText = "Start the game" Top = 120 Width = 735 End Begin VB.CommandButton cmddoneturn Caption = "Exit" Height = 372 Left = 8880 TabIndex = 11 Top = 5400 Width = 972 End Begin VB.OptionButton Opto Caption = "O" Height = 369 Left = 9376 TabIndex = 10 Top = 492 Width = 460 End Begin VB.OptionButton Optx Caption = "X" Height = 369 Left = 9376 TabIndex = 9 Top = 123 Width = 460 End Begin VB.Label lblTies Alignment = 2 'Center BackColor = &H80000007& Caption = "Ties" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 8365 TabIndex = 20 Top = 2625 Width = 915 End Begin VB.Label lblTiesNum Alignment = 2 'Center BackColor = &H80000007& Caption = "0" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 8365 TabIndex = 19 Top = 3281 Width = 915 End Begin VB.Label lblLossNum Alignment = 2 'Center BackColor = &H80000007& Caption = "0" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 7354 TabIndex = 18 Top = 3281 Width = 919 End Begin VB.Label lblWinNum Alignment = 2 'Center BackColor = &H80000007& Caption = "0" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 6343 TabIndex = 17 Top = 3281 Width = 919 End Begin VB.Label lblLosses Alignment = 2 'Center BackColor = &H80000007& Caption = "Losses" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 7354 TabIndex = 16 Top = 2625 Width = 919 End Begin VB.Label lblWins Alignment = 2 'Center BackColor = &H80000007& Caption = "Wins" BeginProperty Font Name = "Times New Roman" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H8000000B& Height = 330 Left = 6360 TabIndex = 15 Top = 2625 Width = 915 End Begin VB.Label lblHP BorderStyle = 1 'Fixed Single Caption = "Select X or O:" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 750 Left = 8640 TabIndex = 12 Top = 120 Width = 750 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1428 Index = 8 Left = 4596 TabIndex = 8 Top = 4080 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1433 Index = 7 Left = 2526 TabIndex = 7 Top = 4093 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1428 Index = 6 Left = 480 TabIndex = 6 Top = 4092 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1433 Index = 5 Left = 4593 TabIndex = 5 Top = 2251 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1428 Index = 4 Left = 2526 TabIndex = 4 Top = 2251 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1425 Index = 3 Left = 480 TabIndex = 3 Top = 2250 Width = 1605 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1433 Index = 2 Left = 4593 TabIndex = 2 Top = 409 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1433 Index = 1 Left = 2526 TabIndex = 1 Top = 409 Width = 1608 End Begin VB.Label lbl Alignment = 2 'Center BackColor = &H80000009& BorderStyle = 1 'Fixed Single Caption = " " BeginProperty Font Name = "Comic Sans MS" Size = 48 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 1440 Index = 0 Left = 480 TabIndex = 0 Top = 405 Width = 1605 End Begin VB.Menu mnutttfile Caption = "&File" Begin VB.Menu mnuFileChangename Caption = "&Change Name" End Begin VB.Menu mnuFileSep1 Caption = "-" End Begin VB.Menu mnuTttfileexit Caption = "E&xit" End End Begin VB.Menu mnuDiff Caption = "Select &Difficulty" Begin VB.Menu mnuDiffEasy Caption = "&Easy" End Begin VB.Menu mnuDiffMed Caption = "&Medium" End Begin VB.Menu mnuDiffHard Caption = "&Hard - DO NOT USE YET!!!" End End End Attribute VB_Name = "frmTictactoe" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim Human As String Dim Computer As String Dim Wins As Integer Dim Losses As Integer Dim Ties As Integer Dim Player As String Dim Title As String Private Difficulty As Integer '1= easy,2=med,3=hard Option Explicit Private Sub cmdBegin_Click() With Optx .Enabled = True .Visible = True End With With Opto .Enabled = True .Visible = True End With lblHP.Visible = True End Sub Private Sub cmdCont_Click() Dim i As Integer For i = 0 To 8 lbl(i) = " " Next txtHCTurn.Text = Player & "'s Turn" txtWho.Text = Title & " " & Player & " is " & Human lblWinNum.Caption = Wins lblLossNum = Losses lblTiesNum = Ties If Wins = 0 And Losses = 0 And Ties = 0 Then Title = "Newbie" End If If Wins > 10 And Losses < 3 And Ties < 5 Then Title = "Student" End If If Wins > 20 And Losses < 5 And Ties < 10 Then Title = "Master" End If If Wins > 50 And Losses < 10 And Ties < 20 Then Title = IIf(Difficulty = 3, "Tic Tac Toe God", "Lord") End If If Wins = 0 And Losses > 10 And Ties > 10 Then Title = "Loser Supreme" End If Select Case Player Case Is = "Bill" Title = "Big Boss" Case "Justin" Title = "The Great" Case "Jen" Title = "Sexy" Case Is = "" Title = "That which cannot be named" Case " " Title = "That which cannot be named" End Select End Sub Private Sub cmddoneturn_Click() ' frmMain.Show ????? MsgBox "Thank you for playing Just I-Names.com Tic Tac Toe!" Unload Me End Sub Private Sub cmdReset_Click() With Optx .Enabled = True .Visible = True End With With Opto Enabled = True Visible = True End With Unload Me frmTictactoe.Show lblHP.Visible = True Player = "" Wins = 0 Losses = 0 Ties = 0 End Sub Private Sub Form_Load() Player = InputBox("Please enter the name you wish to be known as", "Enter your name") MsgBox "OK, " & Player & ", if you are ready to start playing, select your desired difficulty level, press the Ready button and select your X or O." Beep Optx.Enabled = False Opto.Enabled = False Human = " " lblWinNum.Caption = Wins lblLossNum = Losses lblTiesNum = Ties End Sub Private Sub lbl_Click(index As Integer) If Human <> "0" And Human <> "X" Then MsgBox "Choose X or 0" Exit Sub End If If lbl(index).Caption = " " Then lbl(index).Caption = Human If Win_Check(Human) = True Then Winner "Player" Exit Sub End If Select Case Difficulty Case 1 compturn (1) GoTo HumanTurn Case 2 GoTo CTB1 Case 3 ' GoTo CTK1 Case Else GoTo DiffCheck End Select End If DiffCheck: If Difficulty = 0 Then MsgBox "Please select a difficulty level before playing!" frmTictactoe.Show Else: GoTo CapCheck End If CapCheck: If lbl(index).Caption = Human Or lbl(index).Caption = Computer Then MsgBox "That square has already been used! Please choose another square!" GoTo HumanTurn Else: MsgBox "Something is horribly 'f'ed up!" End If CTB1: 'Computer Turn - Block (Medium and Hard levels) Checks for all 24 possible eminent Human wins If lbl(0).Caption = Human And lbl(1).Caption = Human Then lbl(2).Caption = Computer GoTo HumanTurn Else: GoTo CTB2 End If CTB2: If lbl(0).Caption = Human And lbl(2).Caption = Human And lbl(1).Caption = " " Then lbl(1).Caption = Computer GoTo HumanTurn Else: GoTo CTB3 End If CTB3: If lbl(1).Caption = Human And lbl(2).Caption = Human And lbl(0).Caption = " " Then lbl(0).Caption = Computer GoTo HumanTurn Else: GoTo CTB4 End If CTB4: If lbl(3).Caption = Human And lbl(4).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB5 End If CTB5: If lbl(3).Caption = Human And lbl(4).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB6 End If CTB6: If lbl(4).Caption = Human And lbl(4).Caption = Human And lbl(3).Caption = " " Then lbl(3).Caption = Computer GoTo HumanTurn Else: GoTo CTB7 End If CTB7: If lbl(6).Caption = Human And lbl(7).Caption = Human And lbl(8).Caption = " " Then lbl(8).Caption = Computer GoTo HumanTurn Else: GoTo CTB8 End If CTB8: If lbl(6).Caption = Human And lbl(8).Caption = Human And lbl(7).Caption = " " Then lbl(7).Caption = Computer GoTo HumanTurn Else: GoTo CTB9 End If CTB9: If lbl(7).Caption = Human And lbl(8).Caption = Human And lbl(6).Caption = " " Then lbl(6).Caption = Computer GoTo HumanTurn Else: GoTo CTB10 End If CTB10: If lbl(0).Caption = Human And lbl(3).Caption = Human And lbl(6).Caption = " " Then lbl(6).Caption = Computer GoTo HumanTurn Else: GoTo CTB11 End If CTB11: If lbl(0).Caption = Human And lbl(6).Caption = Human And lbl(3).Caption = " " Then lbl(3).Caption = Computer GoTo HumanTurn Else: GoTo CTB12 End If CTB12: If lbl(3).Caption = Human And lbl(6).Caption = Human And lbl(0).Caption = " " Then lbl(0).Caption = Computer GoTo HumanTurn Else: GoTo CTB13 End If CTB13: If lbl(1).Caption = Human And lbl(4).Caption = Human And lbl(7).Caption = " " Then lbl(7).Caption = Computer GoTo HumanTurn Else: GoTo CTB14 End If CTB14: If lbl(1).Caption = Human And lbl(7).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB15 End If CTB15: If lbl(4).Caption = Human And lbl(7).Caption = Human And lbl(1).Caption = " " Then lbl(1).Caption = Computer GoTo HumanTurn Else: GoTo CTB16 End If CTB16: If lbl(2).Caption = Human And lbl(4).Caption = Human And lbl(8).Caption = " " Then lbl(8).Caption = Computer GoTo HumanTurn Else: GoTo CTB17 End If CTB17: If lbl(2).Caption = Human And lbl(8).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB18 End If CTB18: If lbl(4).Caption = Human And lbl(8).Caption = Human And lbl(2).Caption = " " Then lbl(2).Caption = Computer GoTo HumanTurn Else: GoTo CTB19 End If CTB19: If lbl(0).Caption = Human And lbl(4).Caption = Human And lbl(8).Caption = " " Then lbl(8).Caption = Computer GoTo HumanTurn Else: GoTo CTB20 End If CTB20: If lbl(0).Caption = Human And lbl(8).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB21 End If CTB21: If lbl(4).Caption = Human And lbl(8).Caption = Human And lbl(0).Caption = " " Then lbl(0).Caption = Computer GoTo HumanTurn Else: GoTo CTB22 End If CTB22: If lbl(2).Caption = Human And lbl(4).Caption = Human And lbl(6).Caption = " " Then lbl(6).Caption = Computer GoTo HumanTurn Else: GoTo CTB23 End If CTB23: If lbl(2).Caption = Human And lbl(6).Caption = Human And lbl(4).Caption = " " Then lbl(4).Caption = Computer GoTo HumanTurn Else: GoTo CTB24 End If CTB24: If lbl(4).Caption = Human And lbl(6).Caption = Human And lbl(2).Caption = " " Then lbl(2).Caption = Computer GoTo HumanTurn Else: compturn (1) End If HumanTurn: If Win_Check(Computer) = True Then Winner ("Computer") Exit Sub End If If Human = " " Then MsgBox "Please select X or O first!!!" Unload Me frmTictactoe.Show Else txtHCTurn.Text = Player & "'s Turn" End If End Sub Private Sub mnuDiffEasy_Click() mnuDiffEasy.Checked = True mnuDiffMed.Checked = False mnuDiffHard.Checked = False txtDiff.Text = Player & " at Easy Level" Difficulty = 1 MsgBox "Very Easy" End Sub Private Sub mnuDiffHard_Click() mnuDiffEasy.Checked = False mnuDiffMed.Checked = False mnuDiffHard.Checked = True txtDiff.Text = Player & " at Hard Level" Difficulty = 3 MsgBox "Impossible - NOT SET UP YET!!" frmTictactoe.Show End Sub Private Sub mnuDiffMed_Click() mnuDiffEasy.Checked = False mnuDiffMed.Checked = True mnuDiffHard.Checked = False txtDiff.Text = Player & " at Medium Level" Difficulty = 2 MsgBox "Somewhat hard." End Sub Private Sub mnuFileChangename_Click() Player = InputBox("Please enter the new name you wish to have", "Enter your new name") txtWho.Text = Title & " " & Player & " is " & Human With txtDiff Select Case Difficulty Case Is = 1 .Text = Player & " at Easy Level" Case 2 .Text = Player & " at Medium Level" Case 3 .Text = Player & " at Hard Level" End Select End With End Sub Private Sub mnuTttfileexit_Click() frmMain.Show MsgBox "Thank you for playing Just I-Names.com Tic Tac Toe!" Unload Me End Sub Private Sub Opto_Click() If Human = " " Then MsgBox "You will be O, the computer will be X" Human = "O" Computer = "X" txtWho.Text = Title & Player & " is " & Human Else: MsgBox "You may not switch sides in the middle of the game," & Player & "!" Optx.Visible = False Opto.Visible = False lblHP.Visible = False End If End Sub Private Sub Optx_Click() If Human = " " Then MsgBox "You will be X, the computer will be O" Human = "X" Computer = "O" txtWho.Text = Title & Player & " is " & Human Else: MsgBox "You may not switch sides in the middle of the game," & Player & "!" Optx.Visible = False Opto.Visible = False lblHP.Visible = False End If End Sub Private Sub compturn(index As Integer) 'Basic moves (All levels) If index < 9 Then 'repeats sub until legal move is found txtHCTurn.Text = "Computer's Turn" If lbl(index).Caption = " " Then lbl(index).Caption = Computer txtHCTurn.Text = Player & "'s Turn" Else compturn (index + 1) 'try next space End If Else MsgBox "Draw" ' all spaces are filled End If End Sub 'will exit at humanturn pointer in compturn as this sub is only called from one place Private Function Win_Check(who As String) As Boolean 'who="0" or "X" Dim i As Integer 'check for horizontal line then vertical then diagonal Win_Check = False For i = 0 To 2 If lbl(i * 3).Caption = who And lbl(i * 3 + 1).Caption = who And lbl(i * 3 + 1).Caption = who Then 'winner horizontal Win_Check = True Else If lbl(i).Caption = who And lbl(i + 3).Caption = who And lbl(i + 6).Caption = who Then 'winner vertical Win_Check = True Else If lbl(4).Caption = who Then If (lbl(0).Caption = who And lbl(8).Caption = who) Or (lbl(2).Caption = who And lbl(6).Caption = who) Then 'winner diagonal Win_Check = True End If End If End If End If Next End Function Private Sub Winner(Champ As String) MsgBox Champ & "won" End Sub