[VB6] Implementazione gioco del Tris

**ungarodj** · 01-02-2007, 17:40

Ciao ragazzi sono nuovo!... bè volevo chiedervi un grandissimoooooooooooooooo favore... siccome io ho 17 anni e sono uno studente dell'indirizzo informatico al 4 anno!.. il mio prof mi ha assegnato che devo fare un programma in VISUAL BASIC 6 ENTRO LUNEDì 5 FEBBRAIO ... il programma è il gioko del tris... mi serve qualkuno che gentilissimamente mi dia il codice sorgente e crearlo con le matrici! Vi ringrazio per l'aiuto che mi darete vi sarò infinitamente grato

**oregon** · 01-02-2007, 17:47

Mi sa che il moderatore ti scrivera' molto presto ...

**ungarodj** · 01-02-2007, 17:52

perchè?!? siccome sono nuovo nn sò come funziona! nn si può fare?

**MItaly** · 01-02-2007, 17:52

È un tuo compito e il forum serve per risolvere problematiche precise, non per farsi scrivere interi programmi... :rollo:

**ungarodj** · 01-02-2007, 17:54

vabbè ma in amicizia

.. ahey nn sò proprio dove sbattere la testa

me sà che prendo 2

**xegallo** · 01-02-2007, 18:02

Visto che può essere un esempio didattico
e il linguaggio l'hai scritto

allora ti serve:
1) un form (frmPlay) con una picturebox (picGrid) e una label (lblMessage)
2) un modulo di classe (cGrid)
3) un modulo di classe (IplayerAI)
4) un modulo di classe (CPlayer_A)

codice del form (frmPlay)

codice:

Option Explicit

Dim myGrid As CGrid
Dim AI As IPlayerAI
Dim bNeedInput As Boolean
Dim numgame As Integer

Private Sub Form_Load()
    Set myGrid = New CGrid
    Set AI = New CPlayer_A
    
    AI.Side = CROCE
    Randomize
    SetMessage "FAI LA TUA MOSSA!"
    bNeedInput = True
    numgame = 1
    
End Sub

Private Sub picGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If bNeedInput Then
        bNeedInput = False
        Dim gridX As Byte, gridY As Byte
        gridX = x \ (picGrid.ScaleWidth / 3)
        gridY = y \ (picGrid.ScaleHeight / 3)
        
        If myGrid.GetSquareVal(gridX, gridY) = VUOTO Then
            myGrid.Place CERCHIO, gridX, gridY
            Call picGrid_Paint
            
            If myGrid.hasWon = CERCHIO Then
                MsgBox "HAI VINTO"
                myGrid.Clear
                numgame = numgame + 1
                If numgame Mod 2 = 0 Then
                    AI.Play myGrid
                End If
                Call picGrid_Paint
                bNeedInput = True
                Exit Sub
            End If
            
            AI.Play myGrid
            Call picGrid_Paint
            
            gridX = myGrid.hasWon
            If gridX = CROCE Then
                MsgBox "HAI PERSO"
                myGrid.Clear
                numgame = numgame + 1
                If numgame Mod 2 = 0 Then
                    AI.Play myGrid
                End If
            Else
                If myGrid.isFull Then
                    MsgBox "PARI"
                    myGrid.Clear
                    numgame = numgame + 1
                    If numgame Mod 2 = 0 Then
                        AI.Play myGrid
                    End If
                End If
            End If

            Call picGrid_Paint
        End If
        
        bNeedInput = True
        SetMessage "FAI LA TUA MOSSA!"
    Else
        Beep
    End If
End Sub

Private Sub picGrid_Paint()
    myGrid.Draw picGrid
    
End Sub

Private Sub SetMessage(Optional strMsg As String)
    lblMessage.Caption = strMsg
End Sub

codice classe (cGrid)

codice:

Option Explicit

Public Enum GridSquareConstants
    VUOTO = 0
    CERCHIO = 1
    CROCE = 4
End Enum

Private arGrid(0 To 2, 0 To 2) As Byte

' possibilità
' 1 * *     * 2 *   * * 3
' 1 * *     * 2 *   * * 3
' 1 * *     * 2 *   * * 3
'
' 4 4 4     * * *   * * *
' * * *     5 5 5   * * *
' * * *     * * *   6 6 6
'
' 7 * *     * * 8
' * 7 *     * 8 *
' * * 7     8 * *

Public Function GetRowVal(iRow As Byte) As Byte
    Dim iTotal As Byte
    
    Select Case iRow
    Case 1: iTotal = arGrid(0, 0) + arGrid(0, 1) + arGrid(0, 2)
    Case 2: iTotal = arGrid(1, 0) + arGrid(1, 1) + arGrid(1, 2)
    Case 3: iTotal = arGrid(2, 0) + arGrid(2, 1) + arGrid(2, 2)
    
    Case 4: iTotal = arGrid(0, 0) + arGrid(1, 0) + arGrid(2, 0)
    Case 5: iTotal = arGrid(0, 1) + arGrid(1, 1) + arGrid(2, 1)
    Case 6: iTotal = arGrid(0, 2) + arGrid(1, 2) + arGrid(2, 2)
    
    Case 7: iTotal = arGrid(0, 0) + arGrid(1, 1) + arGrid(2, 2)
    Case 8: iTotal = arGrid(2, 0) + arGrid(1, 1) + arGrid(0, 2)
    End Select
    
    GetRowVal = iTotal
End Function

Public Sub Place(move As Byte, x As Byte, y As Byte)
    Debug.Assert move = CERCHIO Or move = CROCE
    If arGrid(x, y) = VUOTO Then
        'Debug.Print "Piazzamento " & IIf(move = CROCE, "CROCE", "CERCHIO") & " @ "; x & "," & y
        arGrid(x, y) = move
    End If
End Sub

Public Function GetSquareVal(x As Byte, y As Byte) As Byte
    Debug.Assert x >= 0 And x <= 2 And y >= 0 And y <= 2
    
    GetSquareVal = arGrid(x, y)
End Function

Public Function hasWon() As Byte
    Dim i As Byte, n As Byte
    
    For i = 1 To 8
        n = GetRowVal(i)
        If n = (CERCHIO * 3) Then
            hasWon = CERCHIO
            Exit Function
        ElseIf n = (CROCE * 3) Then
            hasWon = CROCE
            Exit Function
        End If
    Next i
End Function

Public Sub Draw(picBox As PictureBox)
    Dim x As Byte, y As Byte
    Dim w As Long, h As Long
    
    w = picBox.ScaleWidth
    h = picBox.ScaleHeight
    picBox.FontSize = 14
    picBox.DrawWidth = 3
    picBox.Cls
    
    For x = 0 To 2
        For y = 0 To 2
            ' disegna le righe
            If x > 0 And y > 0 Then
                picBox.Line (x * (w / 3), 0)-(x * (w / 3), h)
                picBox.Line (0, y * (h / 3))-(w, y * (h / 3))
            End If
            
            ' disegna croci e cerchi.
            picBox.CurrentX = x * (w / 3) + (w / 6) - 8
            picBox.CurrentY = y * (h / 3) + (h / 6) - 8
            
            Select Case arGrid(x, y)
            Case CROCE
                picBox.Print "X"
            Case CERCHIO
                picBox.Print "O"
            End Select
        Next y
    Next x
End Sub

Public Sub Clear()
    Dim x As Byte, y As Byte
    
    For x = 0 To 2
        For y = 0 To 2
            arGrid(x, y) = VUOTO
        Next y
    Next x
End Sub

Public Function GetCopy() As CGrid
    Dim newGrid As CGrid
    Dim x As Byte, y As Byte
    
    Set newGrid = New CGrid
    
    For x = 0 To 2
        For y = 0 To 2
            newGrid.Place arGrid(x, y), x, y
        Next y
    Next x
    
    Set GetCopy = newGrid
End Function

Public Function PlaceInFreeSquare(move As Byte, iRow As Byte) As Boolean
    Dim x As Byte, y As Byte
    
    Debug.Assert move = CERCHIO Or move = CROCE And (iRow >= 1 And iRow <= 8)
    
    GetFreeSquare iRow, x, y
    'Debug.Print "Piazzamento " & IIf(move = CROCE, "CROCE", "CERCHIO") & " @ "; x & "," & y
    If x = 99 Or y = 99 Then
        Exit Function
    Else
        PlaceInFreeSquare = True
        arGrid(x, y) = move
    End If
End Function

Private Sub GetFreeSquare(iRow As Byte, ByRef x As Byte, ByRef y As Byte)
    Select Case iRow
    Case 1, 2, 3
        x = iRow - 1
        For y = 0 To 2
            If arGrid(x, y) = VUOTO Then Exit Sub
        Next y
        x = 99
        y = 99
        
    Case 4, 5, 6
        y = iRow - 4
        For x = 0 To 2
            If arGrid(x, y) = VUOTO Then Exit Sub
        Next x
        x = 99
        y = 99
    
    Case 7
        For x = 0 To 2
            If arGrid(x, y) = VUOTO Then Exit Sub
            y = y + 1
        Next x
        x = 99
        y = 99
            
    Case 8
        For x = 0 To 2
            y = x
            If arGrid(2 - x, y) = VUOTO Then
                x = 2 - x
                Exit Sub
            End If
        Next x
        x = 99
        y = 99
        
    End Select
End Sub

Public Function isFull() As Boolean
    Dim x As Byte, y As Byte
    Dim bFull As Boolean
    
    bFull = True
    
    For x = 0 To 2
        For y = 0 To 2
            If arGrid(x, y) = VUOTO Then
                bFull = False
                Exit Function
            End If
        Next y
    Next x
    
    isFull = bFull
End Function

codice classe (CPlayer_A)

codice:

Option Explicit

Implements IPlayerAI
Private Side As Byte
Private Opponent As Byte
'Private CurrentGrid As CGrid

Private Sub IPlayerAI_Play(CurrentGrid As CGrid)

    Dim iRow As Byte
    
    ' cerca per vincere
    For iRow = 1 To 8
        If CurrentGrid.GetRowVal(iRow) = (Side * 2) Then
            If CurrentGrid.PlaceInFreeSquare(Side, iRow) Then
                Debug.Print "mossa vincente"
                Exit Sub
            End If
        End If
    Next iRow
    
    ' Cerca per bloccare
    For iRow = 1 To 8
        If CurrentGrid.GetRowVal(iRow) = (Opponent * 2) Then
            If CurrentGrid.PlaceInFreeSquare(Side, iRow) Then
                Debug.Print "mossa per bloccare"
                Exit Sub
            End If
        End If
    Next iRow
    
    ' mossa random.
    Dim x As Byte, y As Byte
    Dim posX(1 To 9) As Byte, posY(1 To 9) As Byte
    Dim n As Byte
    
    For x = 0 To 2
        For y = 0 To 2
            If CurrentGrid.GetSquareVal(x, y) = VUOTO Then
                n = n + 1
                posX(n) = x
                posY(n) = y
            End If
        Next y
    Next x

    n = Int(Rnd * n) + 1
    CurrentGrid.Place Side, posX(n), posY(n)
    Debug.Print "mossa random"
End Sub

Private Property Let IPlayerAI_Side(RHS As Byte)
    Side = RHS
    Opponent = IIf(RHS = CROCE, CERCHIO, CROCE)
End Property

codice classe (IPlayerAI)

codice:

Option Explicit

Public Sub Play(G As CGrid)

End Sub

Public Property Let Side(CERCHIOOrCROCE As Byte)

End Property

cmq mi sa che ti sgama che non l'hai fatto tu

**ungarodj** · 01-02-2007, 18:07

WOW!!! GRAZIE MILLEEEE!! mi hai salvato la pagella! mia madre e sopratutto la mia pelle ti sarà molto grata

... cmq nn ti preokkupare me la vedo io a nn farmi sgamare!

l'importante è partecipare :P GRAZIE ANKORA... l'uniko problema è che sono cose che nn abbiamo mai sentito parlare ^^" cmq grazie x il pensiero

**Lak3d** · 01-02-2007, 18:09

un genio!

**MItaly** · 01-02-2007, 18:12

Originariamente inviato da ungarodj
cmq nn ti preokkupare me la vedo io a nn farmi sgamare!

e il professore ci crede che per scrivere un programma di tris hai usato una classe ed un'interfaccia, quando probabilmente non sa neanche lui cosa sono?

@xegallo: complimenti per il codice!

**xegallo** · 01-02-2007, 18:17

Originariamente inviato da MItaly

@xegallo: complimenti per il codice!

in realtà è più complicato l'interfaccia serve appunto per gestire vari livelli di difficoltà, grazie

Discussione: [VB6] Implementazione gioco del Tris

Strumenti discussione

Ricerca discussione

Visualizza

Help me!!... è urgente per favore

Permessi di invio