Option Explicit
Dim Card(1 To 40) As Single
Dim Punti(1 To 10) As Integer
Dim PuntiPlayer, PuntiComputer As Integer
Dim SemeBriscola As Integer
Dim CartaGiocataP, CartaGiocataC As Integer
Dim UltimaCarta As Integer
Dim numCarteTot As Integer
Dim Dorso As String
Dim SleepTime As Integer
Dim Giocatore1 As String
Dim EndGame As Integer
Dim PuntiTot As Integer
Dim StatisticFile As String
Dim CartaPlayer(1 To 3) As Giocatore
Dim CartaComputer(1 To 3) As Giocatore
Dim CartaMazzo(1 To 40) As Giocatore
Dim CartaTavolo(1 To 2) As Giocatore
Private Sub Form_Load()
Dim num, sm, i As Integer
'nome del file delle statistiche
StatisticFile = IIf(Right(App.Path, 1) = "\", App.Path & "Statistic.log", App.Path & "\Statistic.log")
'se il file delle statistiche non esiste lo creo azzerando tutto
If (Dir(StatisticFile) = "") Then
Open StatisticFile For Output As #1
Print #1, 0
Print #1, 0
Print #1, 0
Close 1
End If
'tempo (sec) in cui le carte stanno in tavola
SleepTime = 2
'tipo di carte standard (nome della directory dove ci sono i file bmp con le carte)
TipoMazzo = "Default"
'tipo di dorso delle carte (dalla directory "Dorsi")
TipoDorso = "Dorso_05.bmp"
'assegnazione dei punteggi ad ogni carta
For num = 1 To 10
Punti(num) = Choose(num, 11, 0, 10, 0, 0, 0, 0, 2, 3, 4)
PuntiTot = PuntiTot + 4 * Punti(num)
Next num
'costruisco il mazzo di carte
For num = 1 To 10
For sm = 1 To 4
i = i + 1
Card(i) = num + (sm / 10)
Next sm
Next num
'giocatore che puo' fare la prima mossa (Player)
Giocatore1 = "P"
'scozzo il mazzo di carte
Scozza
End Sub
Public Sub Scozza()
Dim appoggio As String
Dim i, nm, conta(0 To 40) As Integer
'azzero la fine del gioco (quando viene finita la partita e iniziata un'altra
EndGame = 0
'azzero i punteggi e li visualizzo
PuntiPlayer = 0
PuntiComputer = 0
lblPlayer.Caption = PuntiPlayer
lblComputer.Caption = PuntiComputer
'pulisco il tavolo
imgTable(1).Picture = LoadPicture("")
imgTable(2).Picture = LoadPicture("")
imgTable(1).BorderStyle = 0
imgTable(2).BorderStyle = 0
'cancello la linea sopra il seme
Line1.Visible = False
'scelgo l'ordine delle carte
Randomize Timer
For i = 1 To 40
Do
If conta(nm) = 0 Then conta(nm) = 1
nm = Int(Rnd * 40) + 1
Loop Until conta(nm) = 0
CartaMazzo(i).Carta = Fix(Card(nm))
CartaMazzo(i).Seme = (Card(nm) - Fix(Card(nm))) * 10
appoggio = Format(Fix(Card(nm)), "00") & " " & IntToStrSeme(CartaMazzo(i).Seme)
CartaMazzo(i).FileCard = App.Path & IIf(Right(App.Path, 1) = "\", "Mazzi\" & TipoMazzo & "\" & appoggio, "\Mazzi\" & TipoMazzo & "\" & appoggio)
Next i
'percorso dell'immagine col dorso delle carte
Dorso = App.Path & IIf(Right(App.Path, 1) = "\", "Dorsi\" & TipoDorso, "\Dorsi\" & TipoDorso)
'inizializzazione seme briscola e mazzo
SemeBriscola = CartaMazzo(40).Seme
imgSeme.Picture = LoadPicture(CartaMazzo(40).FileCard)
imgSeme.BorderStyle = 1
imgMazzo.Picture = LoadPicture(Dorso)
imgMazzo.BorderStyle = 1
'aggiorno il numero di carte rimaste
numCarteTot = 34
lblNumeroCarte.Visible = True
lblNumeroCarte.Caption = numCarteTot & " cards"
'richiamo la funzione per dare le carte
UltimaCarta = 1
Call GiveCards(3)
End Sub
Public Sub GiveCards(numCarte As Integer)
Dim i, numCarta, from1, to1, from2, to2 As Integer
numCarta = 0
If Giocatore1 = "C" Then
from1 = UltimaCarta
to1 = UltimaCarta + numCarte - 1
from2 = UltimaCarta + numCarte
to2 = UltimaCarta + 2 * numCarte - 1
End If
If Giocatore1 = "P" Then
from1 = UltimaCarta + numCarte
to1 = UltimaCarta + 2 * numCarte - 1
from2 = UltimaCarta
to2 = UltimaCarta + numCarte - 1
End If
For i = from1 To to1
numCarta = numCarta + 1
If (numCarte = 1) Then numCarta = CartaGiocataC
CartaComputer(numCarta) = CartaMazzo(i)
If mnuUnshroundGame.Checked Then
imgComputer(numCarta).Picture = LoadPicture(CartaComputer(numCarta).FileCard)
Else
imgComputer(numCarta).Picture = LoadPicture(Dorso)
End If
imgComputer(numCarta).BorderStyle = 1
Next i
numCarta = 0
For i = from2 To to2
numCarta = numCarta + 1
If (numCarte = 1) Then numCarta = CartaGiocataP
CartaPlayer(numCarta) = CartaMazzo(i)
imgPlayer(numCarta).Picture = LoadPicture(CartaPlayer(numCarta).FileCard)
imgPlayer(numCarta).BorderStyle = 1
Next i
UltimaCarta = UltimaCarta + 2 * numCarte
If (Giocatore1 = "C") Then GiocaPC
End Sub
Private Function IntToStrSeme(i As Integer)
'funzione che restituisce il seme come stringa a partire da un intero
Select Case i
Case 1: IntToStrSeme = "cuori.bmp"
Case 2: IntToStrSeme = "quadri.bmp"
Case 3: IntToStrSeme = "picche.bmp"
Case 4: IntToStrSeme = "fiori.bmp"
End Select
End Function
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgComputer_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgMazzo_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgPlayer_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgSeme_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgTable_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub lblNumeroCarte_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'menu on-the-fly
If Button = 2 Then PopupMenu mnuGame, 0
End Sub
Private Sub imgPlayer_DblClick(Index As Integer)
If ((Giocatore1 = "P" Or (Giocatore1 = "C" And imgTable(2).BorderStyle = 0)) And (EndGame <> 3 And imgPlayer(Index).BorderStyle <> 0)) Then
imgTable(2).Picture = LoadPicture(CartaPlayer(Index).FileCard)
imgTable(2).BorderStyle = 1
imgPlayer(Index).Picture = LoadPicture("")
imgPlayer(Index).BorderStyle = 0
CartaTavolo(2).Carta = CartaPlayer(Index).Carta
CartaTavolo(2).Seme = CartaPlayer(Index).Seme
CartaTavolo(2).FileCard = CartaPlayer(Index).FileCard
CartaGiocataP = Index
If (CartaTavolo(1).FileCard = "") Then
GiocaPC
Else
If Giocatore1 = "P" Then
PulisciTavolo (Vincitore(CartaTavolo(2), CartaTavolo(1)))
Else
PulisciTavolo (Vincitore(CartaTavolo(1), CartaTavolo(2)))
End If
End If
Else
Exit Sub
End If
End Sub
Public Sub GiocaPC()
Dim CartaSceltaG As Giocatore
Dim X, CartaScelta As Integer
If Giocatore1 = "P" Then
CartaSceltaG = ScegliCarta1(CartaComputer())
Else
CartaSceltaG = ScegliCarta2(CartaComputer())
End If
For X = 1 To 3
If (CartaComputer(X).FileCard = CartaSceltaG.FileCard) Then
CartaScelta = X
Exit For
End If
Next X
imgTable(1).Picture = LoadPicture(CartaComputer(CartaScelta).FileCard)
imgTable(1).BorderStyle = 1
imgComputer(CartaScelta).Picture = LoadPicture("")
imgComputer(CartaScelta).BorderStyle = 0
CartaTavolo(1).Carta = CartaComputer(CartaScelta).Carta
CartaTavolo(1).Seme = CartaComputer(CartaScelta).Seme
CartaTavolo(1).FileCard = CartaComputer(CartaScelta).FileCard
CartaGiocataC = CartaScelta
If (CartaTavolo(1).FileCard <> "" And CartaTavolo(2).FileCard <> "") Then
If Giocatore1 = "P" Then
PulisciTavolo (Vincitore(CartaTavolo(2), CartaTavolo(1)))
Else
PulisciTavolo (Vincitore(CartaTavolo(1), CartaTavolo(2)))
End If
End If
End Sub
Private Function ScegliCarta1(C() As Giocatore) As Giocatore
'funzione che serve per determinare che carta deve giocare il Computer quando
'il PC deve rispondere ad una carta giocata dal Player
Dim appoggio(1 To 3) As Giocatore
Dim CartaBriscola(1 To 3) As Giocatore
Dim CartaBriscolaC(1 To 3) As Giocatore
Dim CartaBriscolaNC(1 To 3) As Giocatore
Dim CartaNoBriscola(1 To 3) As Giocatore
Dim CartaNoBriscolaC(1 To 3) As Giocatore
Dim CartaNoBriscolaNC(1 To 3) As Giocatore
Dim CartaVBriscola(1 To 3) As Giocatore
Dim CartaVBriscolaC(1 To 3) As Giocatore
Dim CartaVBriscolaNC(1 To 3) As Giocatore
Dim CartaVNoBriscola(1 To 3) As Giocatore
Dim CartaVNoBriscolaC(1 To 3) As Giocatore
Dim CartaVNoBriscolaNC(1 To 3) As Giocatore
Dim CartaVincente(1 To 3) As Giocatore
Dim CartaNVincente(1 To 3) As Giocatore
Dim CartaNVBriscola(1 To 3) As Giocatore
Dim CartaNVBriscolaC(1 To 3) As Giocatore
Dim CartaNVBriscolaNC(1 To 3) As Giocatore
Dim CartaNVNoBriscola(1 To 3) As Giocatore
Dim CartaNVNoBriscolaC(1 To 3) As Giocatore
Dim CartaNVNoBriscolaNC(1 To 3) As Giocatore
Dim X, CarteOk As Integer
Dim numBriscole, numBriscoleC, numBriscoleNC As Integer
Dim numNoBriscole, numNoBriscoleC, numNoBriscoleNC As Integer
Dim numCarteVincenti As Integer
Dim numVBriscole, numVBriscoleC, numVBriscoleNC As Integer
Dim numVNoBriscole, numVNoBriscoleC, numVNoBriscoleNC As Integer
Dim numCarteNVincenti As Integer
Dim numNVBriscole, numNVBriscoleC, numNVBriscoleNC As Integer
Dim numNVNoBriscole, numNVNoBriscoleC, numNVNoBriscoleNC As Integer
Dim Vincente As Boolean
'controllo le carte disponibili del Computer
For X = 1 To 3
If (C(X).Carta <> 0) Then
CarteOk = CarteOk + 1
appoggio(CarteOk) = C(X)
End If
Next X
'controllo i tipi di carte che ha il Computer
For X = 1 To CarteOk
'controllo quali carte il computer ha per vincere la mano e le memorizzo
Vincente = False
If Vincitore(CartaTavolo(2), appoggio(X)) = "C2" Then
numCarteVincenti = numCarteVincenti + 1
CartaVincente(numCarteVincenti) = appoggio(X)
Vincente = True
Else
numCarteNVincenti = numCarteNVincenti + 1
CartaNVincente(numCarteNVincenti) = appoggio(X)
Vincente = False
End If
'controllo le carte di briscola e non, carichi o non, e li memorizzo
If (appoggio(X).Seme = SemeBriscola) Then
If (Punti(appoggio(X).Carta) >= 10) Then
numBriscoleC = numBriscoleC + 1
CartaBriscolaC(numBriscoleC) = appoggio(X)
If (Vincente) Then
numVBriscoleC = numVBriscoleC + 1
CartaVBriscolaC(numVBriscoleC) = appoggio(X)
Else
numNVBriscoleC = numNVBriscoleC + 1
CartaNVBriscolaC(numNVBriscoleC) = appoggio(X)
End If
Else
numBriscoleNC = numBriscoleNC + 1
CartaBriscolaNC(numBriscoleNC) = appoggio(X)
If (Vincente) Then
numVBriscoleNC = numVBriscoleNC + 1
CartaVBriscolaNC(numVBriscoleNC) = appoggio(X)
Else
numNVBriscoleNC = numNVBriscoleNC + 1
CartaNVBriscolaNC(numNVBriscoleNC) = appoggio(X)
End If
End If
numBriscole = numBriscole + 1
CartaBriscola(numBriscole) = appoggio(X)
If (Vincente) Then
numVBriscole = numVBriscole + 1
CartaVBriscola(numVBriscole) = appoggio(X)
Else
numNVBriscole = numNVBriscole + 1
CartaNVBriscola(numNVBriscole) = appoggio(X)
End If
Else
If (Punti(appoggio(X).Carta) >= 10) Then
numNoBriscoleC = numNoBriscoleC + 1
CartaNoBriscolaC(numNoBriscoleC) = appoggio(X)
If (Vincente) Then
numVNoBriscoleC = numVNoBriscoleC + 1
CartaVNoBriscolaC(numVNoBriscoleC) = appoggio(X)
Else
numNVNoBriscoleC = numNVNoBriscoleC + 1
CartaNVNoBriscolaC(numNVNoBriscoleC) = appoggio(X)
End If
Else
numNoBriscoleNC = numNoBriscoleNC + 1
CartaNoBriscolaNC(numNoBriscoleNC) = appoggio(X)
If (Vincente) Then
numVNoBriscoleNC = numVNoBriscoleNC + 1
CartaVNoBriscolaNC(numVNoBriscoleNC) = appoggio(X)
Else
numNVNoBriscoleNC = numNVNoBriscoleNC + 1
CartaNVNoBriscolaNC(numNVNoBriscoleNC) = appoggio(X)
End If
End If
numNoBriscole = numNoBriscole + 1
CartaNoBriscola(numNoBriscole) = appoggio(X)
If (Vincente) Then
numVNoBriscole = numVNoBriscole + 1
CartaVNoBriscola(numVNoBriscole) = appoggio(X)
Else
numNVNoBriscole = numNVNoBriscole + 1
CartaNVNoBriscola(numNVNoBriscole) = appoggio(X)
End If
End If
Next X
'se il Computer ha solo una carta butta quella
If (CarteOk = 1) Then
ScegliCarta1 = appoggio(1)
Exit Function
'se il Computer ha 2 carte.........
ElseIf (CarteOk = 2) Then
'se il Computer ha 1 o 2 carte vincenti......
If (numCarteVincenti <> 0) Then
If (numCarteVincenti = 1) Then
If (numVBriscole = 1 And Punti(CartaTavolo(2).Carta) = 0) Then
If (Punti(CartaPiuBassa(CartaNVincente).Carta) >= 10) Then
ScegliCarta1 = CartaVincente(1)
Else
ScegliCarta1 = CartaPiuBassa(CartaNVincente)
End If
Else
ScegliCarta1 = CartaVincente(1)
End If
End If
If (numCarteVincenti = 2) Then
If (numVBriscole = 2 And numVNoBriscole = 0) Then
If (Punti(CartaTavolo(2).Carta) = 0) Then
If (Punti(CartaPiuBassa(CartaNVincente()).Carta) >= 10) Then
ScegliCarta1 = CartaPiuBassa(CartaVBriscola())
Else
ScegliCarta1 = CartaPiuBassa(CartaNVincente())
End If
Else
ScegliCarta1 = CartaPiuBassa(CartaVBriscola())
End If
End If
If (numVBriscole = 0 And numVNoBriscole = 2) Then ScegliCarta1 = CartaPiuBassa(CartaVNoBriscola())
If (numVBriscole = 1 And numVNoBriscole = 1) Then
If (numVNoBriscoleC = 1 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaVNoBriscolaC(1)
If (numVNoBriscoleNC = 1 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaVNoBriscolaNC(1)
End If
End If
'dato che il PC non ha una carta per vincere la mano, cerca di buttare la carta
'di punteggio più basso (possibilmente non briscola)
Else
If (numBriscole = 0 And numNoBriscole = 2) Then ScegliCarta1 = CartaPiuBassa(CartaNoBriscola())
If (numBriscole = 2 And numNoBriscole = 0) Then ScegliCarta1 = CartaPiuBassa(CartaBriscola())
If (numBriscole = 1 And numNoBriscole = 1) Then
If (numBriscoleC = 1 And numNoBriscoleC = 1) Then ScegliCarta1 = CartaNoBriscolaC(1)
If (numNoBriscoleNC = 1 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta1 = CartaNoBriscolaNC(1)
If (numBriscoleNC = 1 And numNoBriscoleC = 1) Then ScegliCarta1 = CartaBriscolaNC(1)
End If
End If
Exit Function
'se il Computer ha 3 carte.........
Else
'se il Computer ha una o più carte vincenti......
If (numCarteVincenti <> 0) Then
If (numCarteVincenti = 1) Then
If (numVBriscole = 1 And Punti(CartaTavolo(2).Carta) = 0) Then
If (Punti(CartaPiuBassa(CartaNVincente).Carta) >= 10) Then
ScegliCarta1 = CartaVincente(1)
Else
ScegliCarta1 = CartaPiuBassa(CartaNVincente)
End If
Else
ScegliCarta1 = CartaVincente(1)
End If
End If
If (numCarteVincenti = 2) Then
If (numVBriscole = 2 And numVNoBriscole = 0) Then
If (Punti(CartaTavolo(2).Carta) = 0) Then
If (Punti(CartaPiuBassa(CartaNVincente()).Carta) >= 10) Then
ScegliCarta1 = CartaPiuBassa(CartaVBriscola())
Else
ScegliCarta1 = CartaPiuBassa(CartaNVincente())
End If
Else
ScegliCarta1 = CartaPiuBassa(CartaVBriscola())
End If
End If
If (numVBriscole = 0 And numVNoBriscole = 2) Then ScegliCarta1 = CartaPiuAlta(CartaVNoBriscola())
If (numVBriscole = 1 And numVNoBriscole = 1) Then
If (numVNoBriscoleC = 1 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaVNoBriscolaC(1)
If (numVNoBriscoleNC = 1 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaVNoBriscolaNC(1)
End If
End If
If (numCarteVincenti = 3) Then
If (numVBriscole = 3 And numVNoBriscole = 0) Then ScegliCarta1 = CartaPiuBassa(CartaVBriscola())
If (numVBriscole = 0 And numVNoBriscole = 3) Then ScegliCarta1 = CartaPiuAlta(CartaVNoBriscola())
If (numVBriscole = 1 And numVNoBriscole = 2) Then
If (numVNoBriscoleC = 2 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaPiuAlta(CartaVNoBriscolaC())
If (numVNoBriscoleC = 1 And numVNoBriscoleNC = 1 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaVNoBriscolaC(1)
If (numVNoBriscoleNC = 2 And (numVBriscoleC = 1 Or numVBriscoleNC = 1)) Then ScegliCarta1 = CartaPiuAlta(CartaVNoBriscolaNC())
End If
If (numVBriscole = 2 And numVNoBriscole = 1) Then
If (numVNoBriscoleC = 1) Then ScegliCarta1 = CartaVNoBriscolaC(1)
If (numVNoBriscoleNC = 1) Then ScegliCarta1 = CartaVNoBriscolaNC(1)
End If
End If
'dato che il PC non ha una carta per vincere la mano, cerca di buttare la carta
'di punteggio più basso (possibilmente non briscola)
Else
If (numBriscole = 0 And numNoBriscole = 3) Then ScegliCarta1 = CartaPiuBassa(CartaNoBriscola())
If (numBriscole = 3 And numNoBriscole = 0) Then ScegliCarta1 = CartaPiuBassa(CartaBriscola())
If (numBriscole = 1 And numNoBriscole = 2) Then
If (numBriscoleC = 1 And numNoBriscoleC = 2) Then ScegliCarta1 = CartaPiuBassa(CartaNoBriscolaC())
If (numNoBriscoleC = 1 And numNoBriscoleNC = 1 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta1 = CartaNoBriscolaNC(1)
If (numNoBriscoleNC = 2 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta1 = CartaPiuBassa(CartaNoBriscolaNC())
If (numBriscoleNC = 1 And numNoBriscoleC = 2) Then ScegliCarta1 = CartaBriscolaNC(1)
End If
If (numBriscole = 2 And numNoBriscole = 1) Then
If (numBriscoleC = 1 And numBriscoleNC = 1 And numNoBriscoleC = 1) Then ScegliCarta1 = CartaBriscolaNC(1)
If (numNoBriscoleNC = 1 And ((numBriscoleC = 1 And numBriscoleNC = 1) Or numBriscoleNC = 2)) Then ScegliCarta1 = CartaNoBriscolaNC(1)
If (numBriscoleNC = 2 And numNoBriscoleC = 1) Then ScegliCarta1 = CartaPiuBassa(CartaBriscolaNC())
End If
End If
Exit Function
End If
End Function
Private Function ScegliCarta2(C() As Giocatore) As Giocatore
'funzione che serve per determinare che carta deve giocare il Computer quando
'il PC deve giocare per primo
Dim appoggio(1 To 3) As Giocatore
Dim CartaBriscola(1 To 3) As Giocatore
Dim CartaBriscolaC(1 To 3) As Giocatore
Dim CartaBriscolaNC(1 To 3) As Giocatore
Dim CartaNoBriscola(1 To 3) As Giocatore
Dim CartaNoBriscolaC(1 To 3) As Giocatore
Dim CartaNoBriscolaNC(1 To 3) As Giocatore
Dim CartaVBriscola(1 To 3) As Giocatore
Dim CartaVBriscolaC(1 To 3) As Giocatore
Dim CartaVBriscolaNC(1 To 3) As Giocatore
Dim CartaVNoBriscola(1 To 3) As Giocatore
Dim CartaVNoBriscolaC(1 To 3) As Giocatore
Dim CartaVNoBriscolaNC(1 To 3) As Giocatore
Dim CartaVincente(1 To 3) As Giocatore
Dim X, CarteOk As Integer
Dim numBriscole, numBriscoleC, numBriscoleNC As Integer
Dim numNoBriscole, numNoBriscoleC, numNoBriscoleNC As Integer
Dim numCarteVincenti As Integer
Dim numVBriscole, numVBriscoleC, numVBriscoleNC As Integer
Dim numVNoBriscole, numVNoBriscoleC, numVNoBriscoleNC As Integer
Dim Vincente As Boolean
'controllo le carte disponibili del Computer
For X = 1 To 3
If (C(X).Carta <> 0) Then
CarteOk = CarteOk + 1
appoggio(CarteOk) = C(X)
End If
Next X
'controllo i tipi di carte che ha il Computer
For X = 1 To CarteOk
'controllo quali carte il computer ha per vincere la mano e le memorizzo
Vincente = False
If Vincitore(CartaTavolo(2), appoggio(X)) = "C2" Then
numCarteVincenti = numCarteVincenti + 1
CartaVincente(numCarteVincenti) = appoggio(X)
Vincente = True
End If
'controllo le carte di briscola e non, carichi o non, e li memorizzo
If (appoggio(X).Seme = SemeBriscola) Then
If (Punti(appoggio(X).Carta) >= 10) Then
numBriscoleC = numBriscoleC + 1
CartaBriscolaC(numBriscoleC) = appoggio(X)
If (Vincente) Then
numVBriscoleC = numVBriscoleC + 1
CartaVBriscolaC(numVBriscoleC) = appoggio(X)
End If
Else
numBriscoleNC = numBriscoleNC + 1
CartaBriscolaNC(numBriscoleNC) = appoggio(X)
If (Vincente) Then
numVBriscoleNC = numVBriscoleNC + 1
CartaVBriscolaNC(numVBriscoleNC) = appoggio(X)
End If
End If
numBriscole = numBriscole + 1
CartaBriscola(numBriscole) = appoggio(X)
If (Vincente) Then
numVBriscole = numVBriscole + 1
CartaVBriscola(numVBriscole) = appoggio(X)
End If
Else
If (Punti(appoggio(X).Carta) >= 10) Then
numNoBriscoleC = numNoBriscoleC + 1
CartaNoBriscolaC(numNoBriscoleC) = appoggio(X)
If (Vincente) Then
numVNoBriscoleC = numVNoBriscoleC + 1
CartaVNoBriscolaC(numVNoBriscoleC) = appoggio(X)
End If
Else
numNoBriscoleNC = numNoBriscoleNC + 1
CartaNoBriscolaNC(numNoBriscoleNC) = appoggio(X)
If (Vincente) Then
numVNoBriscoleNC = numVNoBriscoleNC + 1
CartaVNoBriscolaNC(numVNoBriscoleNC) = appoggio(X)
End If
End If
numNoBriscole = numNoBriscole + 1
CartaNoBriscola(numNoBriscole) = appoggio(X)
If (Vincente) Then
numVNoBriscole = numVNoBriscole + 1
CartaVNoBriscola(numVNoBriscole) = appoggio(X)
End If
End If
Next X
'se il Computer ha solo una carta butta quella
If (CarteOk = 1) Then
ScegliCarta2 = appoggio(1)
Exit Function
'se il Computer ha 2 carte.........
ElseIf (CarteOk = 2) Then
If (numBriscole = 0 And numNoBriscole = 2) Then ScegliCarta2 = CartaPiuBassa(CartaNoBriscola())
If (numBriscole = 2 And numNoBriscole = 0) Then ScegliCarta2 = CartaPiuBassa(CartaBriscola())
If (numBriscole = 1 And numNoBriscole = 1) Then
If (numBriscoleC = 1 And numNoBriscoleC = 1) Then ScegliCarta2 = CartaNoBriscolaC(1)
If (numNoBriscoleNC = 1 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta2 = CartaNoBriscolaNC(1)
If (numBriscoleNC = 1 And numNoBriscoleC = 1) Then ScegliCarta2 = CartaBriscolaNC(1)
End If
Exit Function
'se il Computer ha 3 carte.........
Else
If (numBriscole = 0 And numNoBriscole = 3) Then ScegliCarta2 = CartaPiuBassa(CartaNoBriscola())
If (numBriscole = 3 And numNoBriscole = 0) Then ScegliCarta2 = CartaPiuBassa(CartaBriscola())
If (numBriscole = 1 And numNoBriscole = 2) Then
If (numBriscoleC = 1 And numNoBriscoleC = 2) Then ScegliCarta2 = CartaPiuBassa(CartaNoBriscolaC())
If (numNoBriscoleC = 1 And numNoBriscoleNC = 1 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta2 = CartaNoBriscolaNC(1)
If (numNoBriscoleNC = 2 And (numBriscoleC = 1 Or numBriscoleNC = 1)) Then ScegliCarta2 = CartaPiuBassa(CartaNoBriscolaNC())
If (numBriscoleNC = 1 And numNoBriscoleC = 2) Then ScegliCarta2 = CartaBriscolaNC(1)
End If
If (numBriscole = 2 And numNoBriscole = 1) Then
If (numBriscoleC = 2 And numNoBriscoleC = 1) Then ScegliCarta2 = CartaNoBriscolaC(1)
If (numNoBriscoleNC = 1) Then ScegliCarta2 = CartaNoBriscolaNC(1)
If (numBriscoleC = 1 And numBriscoleNC = 1 And numNoBriscoleC = 1) Then ScegliCarta2 = CartaBriscolaNC(1)
If (numBriscoleNC = 2 And numNoBriscoleC = 1) Then ScegliCarta2 = CartaPiuBassa(CartaBriscolaNC())
End If
Exit Function
End If
End Function
Private Function Vincitore(Carta1 As Giocatore, Carta2 As Giocatore) As String
'funzione che, date due carte (Carta1 la prima giocata in tavola), restituisce la
'carta vincente
If ((Carta1.Seme <> SemeBriscola And Carta2.Seme <> SemeBriscola) Or (Carta1.Seme = SemeBriscola And Carta2.Seme = SemeBriscola)) Then
If (Carta1.Seme <> Carta2.Seme) Then
Vincitore = "C1"
Else
If (Punti(Carta1.Carta) > Punti(Carta2.Carta)) Then
Vincitore = "C1"
Else
Vincitore = "C2"
End If
If (Punti(Carta1.Carta) = Punti(Carta2.Carta)) Then
If (Carta1.Carta > Carta2.Carta) Then
Vincitore = "C1"
Else
Vincitore = "C2"
End If
End If
End If
ElseIf (Carta1.Seme = SemeBriscola) Then
Vincitore = "C1"
Else
Vincitore = "C2"
End If
End Function
Private Sub PulisciTavolo(Vincitore As String)
Dim tstart As Single
'aspetto 2 secondi prima di togliere le carte dal tavolo
tstart = Timer
Do
DoEvents
Loop Until (Timer - tstart) > SleepTime
'tolgo le carte dal tavolo
imgTable(1).Picture = LoadPicture("")
imgTable(1).BorderStyle = 0
imgTable(2).Picture = LoadPicture("")
imgTable(2).BorderStyle = 0
'assegno i punteggi al giocatore o al computer
If (Vincitore = "C1" And Giocatore1 = "P") Or (Vincitore = "C2" And Giocatore1 = "C") Then
PuntiPlayer = PuntiPlayer + Punti(CartaTavolo(1).Carta) + Punti(CartaTavolo(2).Carta)
lblPlayer.Caption = PuntiPlayer
Giocatore1 = "P"
Else
PuntiComputer = PuntiComputer + Punti(CartaTavolo(1).Carta) + Punti(CartaTavolo(2).Carta)
lblComputer.Caption = PuntiComputer
Giocatore1 = "C"
End If
'azzero i valori delle carte sul tavolo
CartaTavolo(1).Carta = 0
CartaTavolo(1).Seme = 0
CartaTavolo(1).FileCard = ""
CartaTavolo(2).Carta = 0
CartaTavolo(2).Seme = 0
CartaTavolo(2).FileCard = ""
'fino a quando ci sono le carte...
If (numCarteTot > 0) Then
'richiamo la funzione per ridare una carta per ognuno
Call GiveCards(1)
'aggiorno il numero di carte rimaste
numCarteTot = numCarteTot - 2
lblNumeroCarte.Caption = numCarteTot & " cards"
'se le carte sono finite cancello il mazzo
If (numCarteTot = 0) Then
imgMazzo.Picture = LoadPicture("")
imgMazzo.BorderStyle = 0
Line1.Visible = True
lblNumeroCarte.Visible = False
End If
Else
CartaComputer(CartaGiocataC).Carta = 0
CartaComputer(CartaGiocataC).Seme = 0
CartaComputer(CartaGiocataC).FileCard = ""
EndGame = EndGame + 1
If (EndGame = 3) Then
If (CInt(lblPlayer.Caption) + CInt(lblComputer.Caption)) <> PuntiTot Then
MsgBox "Points Error!", vbCritical, "Attention"
Else
If PuntiPlayer > 60 Then MsgBox "You have WIN!", vbInformation, "Information"
If PuntiComputer > 60 Then MsgBox "Computer has WIN!", vbInformation, "Information"
If PuntiPlayer = PuntiComputer Then MsgBox "Same Points!", vbInformation, "Information"
ScriviStatistiche
End If
imgSeme.Picture = LoadPicture("")
imgSeme.BorderStyle = 0
Line1.Visible = False
Exit Sub
End If
If (Giocatore1 = "C") Then GiocaPC
End If
End Sub
Private Function CartaPiuAlta(C() As Giocatore) As Giocatore
'funzione che serve per trovare la carta piu' alta in un array di carte
Dim appoggio(1 To 3) As Giocatore
Dim X, CarteOk As Integer
For X = 1 To 3
If (C(X).Carta <> 0) Then
CarteOk = CarteOk + 1
appoggio(CarteOk) = C(X)
End If
Next X
CartaPiuAlta = appoggio(1)
If (CarteOk >= 2) Then
For X = 1 To (CarteOk - 1)
If (Punti(appoggio(X + 1).Carta) > Punti(CartaPiuAlta.Carta) Or (Punti(appoggio(X + 1).Carta) = Punti(CartaPiuAlta.Carta) And appoggio(X + 1).Carta >= CartaPiuAlta.Carta)) Then CartaPiuAlta = appoggio(X + 1)
Next X
End If
End Function
Private Function CartaPiuBassa(C() As Giocatore) As Giocatore
'funzione che serve per trovare la carta piu' bassa in un array di carte
Dim appoggio(1 To 3) As Giocatore
Dim X, CarteOk As Integer
For X = 1 To 3
If (C(X).Carta <> 0) Then
CarteOk = CarteOk + 1
appoggio(CarteOk) = C(X)
End If
Next X
CartaPiuBassa = appoggio(1)
If (CarteOk >= 2) Then
For X = 1 To (CarteOk - 1)
If (Punti(appoggio(X + 1).Carta) < Punti(CartaPiuBassa.Carta) Or (Punti(appoggio(X + 1).Carta) = Punti(CartaPiuBassa.Carta) And appoggio(X + 1).Carta <= CartaPiuBassa.Carta)) Then CartaPiuBassa = appoggio(X + 1)
Next X
End If
End Function
Private Sub mnuChangeCards_Click()
Dim TipoMazzoOld, TipoDorsoOld As String
TipoMazzoOld = TipoMazzo
TipoDorsoOld = TipoDorso
frmChangeCards.Show 1
If (TipoMazzo <> TipoMazzoOld Or TipoDorso <> TipoDorsoOld) Then
Giocatore1 = "P"
Scozza
End If
End Sub
Private Sub mnuGameSpeed_Click()
On Error Resume Next
SleepTime = InputBox("Insert the game speed (sec)", "Game Speed", 2)
If Err.
Number = 13
Then SleepTime
= 2
On Error GoTo 0
End Sub
Private Sub mnuNewPlay_Click()
If EndGame <> 3 Then
If MsgBox("Do you want to clear the game?", vbExclamation + vbYesNo, "Attention!") = vbYes Then
Giocatore1 = "P"
Scozza
End If
Else
Giocatore1 = "P"
Scozza
End If
End Sub
Private Sub mnuShowScore_Click()
If mnuShowScore.Checked Then
'nasconde i punteggi
lblStaticComputer.Visible = False
lblComputer.Visible = False
lblStaticPlayer.Visible = False
lblPlayer.Visible = False
Else
'visualizza i punteggi
lblStaticComputer.Visible = True
lblComputer.Visible = True
lblStaticPlayer.Visible = True
lblPlayer.Visible = True
End If
mnuShowScore.Checked = Not (mnuShowScore.Checked)
End Sub
Private Sub mnuStatistic_Click()
Dim appoggio1, appoggio2, appoggio3 As String
Dim tot As Long
'apro il file delle statistiche
If (Dir(StatisticFile) <> "") Then
Open StatisticFile For Input As #1
Line Input #1, appoggio1
Line Input #1, appoggio2
Line Input #1, appoggio3
tot = Val(appoggio1) + Val(appoggio2) + Val(appoggio3)
Close #1
Else
appoggio1 = 0
appoggio2 = 0
appoggio3 = 0
End If
fraWins.Visible = True
lblWin(0).Visible = True
lblWin(1).Visible = True
lblWin(2).Visible = True
cmdOkWin.Visible = True
cmdOkWin.Enabled = True
lblWin(0).Caption = "Computer : " & appoggio1 & " (" & Format$(100 * (Val(appoggio1) / tot), "00.00") & "%)"
lblWin(1).Caption = " Player : " & appoggio2 & " (" & Format$(100 * (Val(appoggio2) / tot), "00.00") & "%)"
lblWin(2).Caption = " Standoff : " & appoggio3 & " (" & Format$(100 * (Val(appoggio3) / tot), "00.00") & "%)"
End Sub
Private Sub cmdOkWin_Click()
fraWins.Visible = False
lblWin(0).Visible = False
lblWin(1).Visible = False
lblWin(2).Visible = False
cmdOkWin.Visible = False
cmdOkWin.Enabled = False
End Sub
Private Sub mnuUnshroundGame_Click()
Dim i As Integer
'scopre o copre le carte del computer
For i = 1 To 3
If (imgComputer(i).BorderStyle <> 0) Then
If (mnuUnshroundGame.Checked) Then
imgComputer(i).Picture = LoadPicture(Dorso)
Else
imgComputer(i).Picture = LoadPicture(CartaComputer(i).FileCard)
End If
End If
Next
mnuUnshroundGame.Checked = Not (mnuUnshroundGame.Checked)
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("Are you sure?", vbExclamation + vbYesNo, "Exit game") = vbNo Then Cancel = -1
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show vbModal
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub ScriviStatistiche()
Dim appoggio1, appoggio2, appoggio3 As String
'apro il file delle statistiche
If (Dir(StatisticFile) <> "") Then
Open StatisticFile For Input As #1
Line Input #1, appoggio1
Line Input #1, appoggio2
Line Input #1, appoggio3
Close #1
Open StatisticFile For Output As #1
If PuntiComputer > 60 Then appoggio1 = appoggio1 + 1
If PuntiPlayer > 60 Then appoggio2 = appoggio2 + 1
If PuntiComputer = PuntiPlayer Then appoggio3 = appoggio3 + 1
Print #1, appoggio1
Print #1, appoggio2
Print #1, appoggio3
Close #1
Else
MsgBox "I can't find the Statistic file!", vbCritical, "Attention"
End If
End Sub
