Scripted Tic Tac Toe - No Minimax [VB5 & VB6]

**technorobbo** · Jul 8th, 2009, 10:02 PM

Code:

Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Enum Flow
    idle = -1
    init = 0
    xturn = 1
    Oturn = 2
    Play2Win1 = 3
    Play2block1 = 4
    Play2Win2 = 5
    Play2Block2 = 6
    CompWon = 7
    KATZ = 8
End Enum
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Dim RB(0 To 8) As RECT, XnO As Byte, moves(0 To 8) As Integer
Dim MoveCount As Integer, Lockout As Boolean
Dim Token As Flow, Gameon As Boolean
Dim MousePick As Integer
Dim Mask(0 To 8) As Integer, LEVEL As Integer, lScore(0 To 8) As Long
Dim wScore(0 To 8) As Single
Dim nodes As Single
Sub DrawBoard()
    Dim i As Integer
    For i = 0 To 8
        If moves(i) > 0 Then
            Me.Circle ((RB(i).Left + RB(i).Right) / 2, (RB(i).Top + RB(i).Bottom) / 2), 45
        ElseIf moves(i) < 0 Then
            Me.Line (RB(i).Left + 10, RB(i).Top + 10)-(RB(i).Right - 10, RB(i).Bottom - 10)
            Me.Line (RB(i).Left + 10, RB(i).Bottom - 10)-(RB(i).Right - 10, RB(i).Top + 10)
        End If
    Next
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Dim i As Integer, astr As String
initmask
With Me
    .AutoRedraw = True
    .Show
    .DrawWidth = 2
    .ScaleMode = vbPixels
    .Caption = "TR's Tic Tac Toe"
    .Width = .ScaleX(350, vbPixels, vbTwips)
    .Height = .ScaleY(350, vbPixels, vbTwips)
    .BackColor = &HFFFFFF
End With
For i = 0 To 8
    RB(i).Top = (Me.ScaleHeight - 300) / 2 + Int(i / 3) * 100
    RB(i).Left = (Me.ScaleWidth - 300) / 2 + (i Mod 3) * 100
    RB(i).Bottom = RB(i).Top + 99
    RB(i).Right = RB(i).Left + 99
Next
Token = init
Gameon = True
Gameloop
End Sub
Private Sub CLEARBOARD()
Dim i As Integer
Me.Cls
For i = 0 To 8
    Rectangle Me.hdc, RB(i).Left, RB(i).Top, RB(i).Right, RB(i).Bottom
Next
For i = 0 To 8: moves(i) = 0: Next
MousePick = -1
End Sub
Private Sub form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim i As Integer
MousePick = -1
For i = 0 To 8
    If PtInRect(RB(i), x, Y) And moves(i) = 0 Then
        MousePick = i
    End If
Next
End Sub
Private Sub Gameloop()
Dim x(0 To 8) As Integer, i As Integer, Y As Integer
Dim xOnEdge As Boolean, xOnCrnr As Boolean, TC As Integer
Do While Gameon
    Select Case Token
        Case init
            CLEARBOARD
            Token = xturn
        Case xturn, Play2Win1, Play2block1
            If MousePick > -1 Then
                moves(MousePick) = -1
                MousePick = -1
                DrawBoard
                Select Case Token
                    Case xturn
                        Token = Oturn
                    Case Play2block1
                        Token = Play2Block2
                    Case Play2Win1
                        Token = Play2Win2
                End Select
            End If
        Case Oturn
            If moves(4) = 0 Then
                moves(4) = 1
                DrawBoard
                Token = Play2Win1
            Else
                moves(0) = 1
                DrawBoard
                Token = Play2block1
            End If
        Case Play2Block2
            TC = ThreatCheck(moves)
            If TC > -1 Then
                moves(TC) = 1
            ElseIf moves(0) = 0 Then
                moves(0) = 1
            ElseIf moves(2) = 0 Then
                moves(2) = 1
            ElseIf moves(6) = 0 Then
                moves(6) = 1
            ElseIf moves(8) = 0 Then
                moves(8) = 1
            ElseIf moves(1) = 0 Then
                moves(1) = 1
            ElseIf moves(3) = 0 Then
                moves(3) = 1
            ElseIf moves(5) = 0 Then
                moves(5) = 1
            ElseIf moves(7) = 0 Then
                moves(7) = 1
            End If
            DrawBoard
            If WinCheck(moves) = 1 Then
                Token = CompWon
            ElseIf WinCheck(moves) = -2 Then
                Token = KATZ
            Else
                Token = Play2block1
            End If
        Case CompWon
            If MsgBox("You Lost Sucka!!!!!!" & vbCrLf & "Play again?", _
                    vbYesNo) = vbYes Then
                Token = init
            Else
                Token = idle
            End If
        Case KATZ
            If MsgBox("Cats Game (Tie)" & vbCrLf & "Play again?", _
                    vbYesNo) = vbYes Then
                Token = init
            Else
                Token = idle
            End If
        Case Play2Win2
            TC = ThreatCheck(moves)
            If TC > -1 Then
                moves(TC) = 1
            Else
                xOnCrnr = False: xOnEdge = False
                If moves(0) = -1 Or moves(2) = -1 Or moves(6) = -1 _
                    Or moves(8) = -1 Then xOnCrnr = True
                If moves(1) = -1 Or moves(3) = -1 Or moves(5) = -1 _
                    Or moves(7) = -1 Then xOnEdge = True
                 If xOnCrnr = True And xOnEdge = False Then
                    If moves(1) = 0 Then
                        moves(1) = 1
                    ElseIf moves(3) = 0 Then
                        moves(3) = 1
                    ElseIf moves(5) = 0 Then
                        moves(5) = 1
                    ElseIf moves(7) = 0 Then
                        moves(7) = 1
                    End If
                ElseIf xOnCrnr = True And xOnEdge = True Then
                    If moves(0) = -1 Then
                        moves(8) = 1
                    ElseIf moves(2) = -1 Then
                        moves(6) = 1
                    ElseIf moves(6) = -1 Then
                        moves(2) = 1
                    ElseIf moves(8) = -1 Then
                        moves(0) = 1
                    End If
                ElseIf xOnCrnr = False And xOnEdge = True Then
                    If moves(1) = -1 And moves(5) = -1 Then
                        moves(2) = 1
                    ElseIf moves(5) = -1 And moves(7) = -1 Then
                        moves(8) = 1
                    ElseIf moves(7) = -1 And moves(3) = -1 Then
                        moves(6) = 1
                    ElseIf moves(3) = -1 And moves(1) = -1 Then
                        moves(0) = 1
                    Else
                        If moves(1) = 0 Then
                            moves(1) = 1
                        ElseIf moves(3) = 0 Then
                            moves(3) = 1
                        ElseIf moves(5) = 0 Then
                            moves(5) = 1
                        ElseIf moves(7) = 0 Then
                            moves(7) = 1
                        End If
                    End If
                End If
            End If
            DrawBoard
            If WinCheck(moves) = 1 Then
                Token = CompWon
            ElseIf WinCheck(moves) = -2 Then
                Token = KATZ
            Else
                Token = Play2block1
            End If
        Case idle
            DoEvents
    End Select
    DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Gameon = False
End Sub
Private Sub initmask()
Mask(0) = 448
Mask(1) = 56
Mask(2) = 7
Mask(3) = 292
Mask(4) = 146
Mask(5) = 73
Mask(6) = 273
Mask(7) = 84
End Sub
Private Function WinCheck(board() As Integer) As Long
Dim Omatrix As Long, Xmatrix As Long, x As Integer, Y As Integer
Dim i As Integer, J As Long, index As Integer, tmp As Long
Dim brd(0 To 8) As Integer, cats As Integer
cats = 0
For i = 0 To 8
    brd(i) = board(i)
    If brd(i) <> 0 Then cats = cats + 1
Next
If cats = 9 Then
    WinCheck = -2
    Exit Function
End If

'build matrices
Omatrix = 0
Xmatrix = 0
For i = 0 To 8
        Omatrix = IIf(brd(i) = 1, 1, 0) + Omatrix * 2
        Xmatrix = IIf(brd(i) = -1, 1, 0) + Xmatrix * 2
Next
For i = 0 To 7
    If (Omatrix And Mask(i)) = Mask(i) Then
        WinCheck = 1
        Exit Function
    ElseIf (Xmatrix And Mask(i)) = Mask(i) Then
        WinCheck = -1
        Exit Function
    End If
Next
WinCheck = 0
End Function

Private Function ThreatCheck(board() As Integer) As Long
Dim Omatrix As Long, Xmatrix As Long, x As Integer, Y As Integer
Dim i As Integer, J As Long, tmp As Long
Dim brd(0 To 8) As Integer

For i = 0 To 8
    brd(i) = board(i)
Next
Omatrix = 0
Xmatrix = 0
For i = 0 To 8
        Omatrix = IIf(brd(i) = 1, 2 ^ (8 - i), 0) Or Omatrix
        Xmatrix = IIf(brd(i) = -1, 2 ^ (8 - i), 0) Or Xmatrix
Next
For i = 0 To 7
    If (Omatrix And Mask(i)) > 0 And (Xmatrix And Mask(i)) = 0 Then
        tmp = (Omatrix And Mask(i))
        Y = 0
        For x = 0 To 8
            If (tmp And (2 ^ (8 - x))) > 0 Then Y = Y + 1
            If Y = 2 Then
                J = (Omatrix And Mask(i)) Xor Mask(i)
                ThreatCheck = 8 - (Log(J) / Log(2))
                Exit Function
            End If
        Next
    End If
Next
For i = 0 To 7
    If (Xmatrix And Mask(i)) > 0 And (Omatrix And Mask(i)) = 0 Then
        tmp = (Xmatrix And Mask(i))
        Y = 0
        For x = 0 To 8
            If (tmp And (2 ^ (8 - x))) > 0 Then Y = Y + 1
            If Y = 2 Then
                J = (Xmatrix And Mask(i)) Xor Mask(i)
                ThreatCheck = 8 - (Log(J) / Log(2))
                Exit Function
            End If
        Next
    End If
Next
ThreatCheck = -1
End Function

Thread: Scripted Tic Tac Toe - No Minimax [VB5 & VB6]

Thread Tools

Display

Threaded View

Scripted Tic Tac Toe - No Minimax [VB5 & VB6]

Posting Permissions