Il forum per tutti i developer. Leggere attentamente il regolamento di sezione prima di postare.
da M@ttia » mar nov 25, 2003 8:58 pm
[In risposta a qui]
Dunque, il sorgente del mio poker che mi avevi chiesto è questo... Probabilmente può essere "alleggerito" un pochino dato che lo scritto tutto io e nn lo faccio di mestiere, ma comunque funziona perfettamente ed è comunque veloce-istantaneo...
(le vincite, che ti interessano, le trovi verso la metà-fine e ti ho messo anche cosa sto verificando ad ogni riga di codice x farti capire meglio... ![[^]](http://www.megalab.it/forum/images/smilies/Oh-yea.gif "Approvazione")
<blockquote id="quote"><font size="1" face="Verdana, Arial, Helvetica" id="quote">citazione:<hr height="1" noshade id="quote">Option Explicit
Dim k As Integer
Dim Cash As Integer
Dim Vecchiovalore(4) As Integer
Dim Vecchioseme(4) As Integer
Dim Nuovovalore(4) As Integer
Dim Nuovoseme(4) As Integer
Dim pass(4) As Boolean
Dim scalazr As Boolean
Dim minscalaVal As Integer
Dim minscalaCont As Integer
Dim pokerz As Integer
Dim colorez As Boolean
Dim valoriz As Integer
Dim coppia(3) As Integer
Dim dieciassoz(4) As Integer
Dim percorso As String
Dim percorsoskin As String
Dim skincarta As String
Private Sub Form_Load()
Randomize
Cash = 1000
Cassa.Caption = Cash
skincarta = "Carta1.jpg"
percorso = "Immagini/Immagini Poker/"
percorsoskin = percorso
Azzera
End Sub
'0 = Cuori, 1 = Quadri, 2 = Fiori, 3 = Picche
Private Sub Pulsante_Click()
If Pulsante.Caption = "Dai Carte!!!" Then
If Scommessa.Text = "" Or Scommessa.Text < "1" Then MsgBox "Scommettere Qualcosa (minimo 1$)", vbExclamation, "Errore Scommessa": Scommessa.Text = "": GoTo 999
If Scommessa.Text > Cash Then MsgBox "Non hai tutti questi soldi!!!", vbCritical, "Mancanza Soldi": Scommessa.Text = "": GoTo 999
Cash = Cash - Scommessa.Text
Cassa.Caption = Cash
Scommessa.Enabled = False
10 Valore(0) = Int(Rnd() * 13) + 1: Seme(0).Tag = Int(Rnd() * 4)
Vecchiovalore(0) = Valore(0): Vecchioseme(0) = Seme(0).Tag
20 Valore(1) = Int(Rnd() * 13) + 1: Seme(1).Tag = Int(Rnd() * 4)
If Valore(1) = Valore(0) And Seme(1).Tag = Seme(0).Tag Then GoTo 20
Vecchiovalore(1) = Valore(1): Vecchioseme(1) = Seme(1).Tag
30 Valore(2) = Int(Rnd() * 13) + 1: Seme(2).Tag = Int(Rnd() * 4)
If Valore(2) = Valore(0) And Seme(2).Tag = Seme(0).Tag Or Valore(2) = Valore(1) And Seme(2).Tag = Seme(1).Tag Then GoTo 30
Vecchiovalore(2) = Valore(2): Vecchioseme(2) = Seme(2).Tag
40 Valore(3) = Int(Rnd() * 13) + 1: Seme(3).Tag = Int(Rnd() * 4)
If Valore(3) = Valore(0) And Seme(3).Tag = Seme(0).Tag Or Valore(3) = Valore(1) And Seme(3).Tag = Seme(1).Tag Or Valore(3) = Valore(2) And Seme(3).Tag = Seme(2).Tag Then GoTo 40
Vecchiovalore(3) = Valore(3): Vecchioseme(3) = Seme(3).Tag
50 Valore(4) = Int(Rnd() * 13) + 1: Seme(4).Tag = Int(Rnd() * 4)
If Valore(4) = Valore(0) And Seme(4).Tag = Seme(0).Tag Or Valore(4) = Valore(1) And Seme(4).Tag = Seme(1).Tag Or Valore(4) = Valore(2) And Seme(4).Tag = Seme(2).Tag Or Valore(4) = Valore(3) And Seme(4).Tag = Seme(3).Tag Then GoTo 50
Vecchiovalore(4) = Valore(4): Vecchioseme(4) = Seme(4).Tag
For k = 0 To 4
If Seme(k).Tag = "0" Then Seme(k).Picture = LoadPicture(percorso & "Cuori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Cuori.jpg") Else If Seme(k).Tag = "1" Then Seme(k).Picture = LoadPicture(percorso & "Quadri.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Quadri.jpg") Else If Seme(k).Tag = "2" Then Seme(k).Picture = LoadPicture(percorso & "Fiori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Fiori.jpg") Else Seme(k).Picture = LoadPicture(percorso & "Picche.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Picche.jpg")
If Seme(k).Tag = "0" Or Seme(k).Tag = "1" Then Valore(k).ForeColor = vbRed Else Valore(k).ForeColor = vbBlack
If Valore(k) = "11" Then Valore(k) = "J": Figura(k).Picture = LoadPicture(percorso & "Fante.jpg") Else If Valore(k) = "12" Then Valore(k) = "Q": Figura(k).Picture = LoadPicture(percorso & "Donna.jpg") Else If Valore(k) = "13" Then Valore(k) = "K": Figura(k).Picture = LoadPicture(percorso & "Re.jpg") Else Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If Valore(k) = "1" Then Valore(k) = "A"
Valore(k).Visible = True
Seme(k).Visible = True
Seme(k + 5).Visible = True
Figura(k).Visible = True
Cambia(k).Enabled = True
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
Next k
Pulsante.Caption = "Cambia Carte"
GoTo 999
End If
If Pulsante.Caption = "Cambia Carte" Then
GoTo 101
0 Nuovovalore(0) = Int(Rnd() * 13) + 1: Nuovoseme(0) = Int(Rnd() * 4): pass(0) = True
If Nuovovalore(0) = Vecchiovalore(0) And Nuovoseme(0) = Vecchioseme(0) Or Nuovovalore(0) = Vecchiovalore(1) And Nuovoseme(0) = Vecchioseme(1) Or Nuovovalore(0) = Vecchiovalore(2) And Nuovoseme(0) = Vecchioseme(2) Or Nuovovalore(0) = Vecchiovalore(3) And Nuovoseme(0) = Vecchioseme(3) Or Nuovovalore(0) = Vecchiovalore(4) And Nuovoseme(0) = Vecchioseme(4) Then GoTo 0 Else Valore(0) = Nuovovalore(0): Seme(0).Tag = Nuovoseme(0): GoTo 101
1 Nuovovalore(1) = Int(Rnd() * 13) + 1: Vecchioseme(1) = Int(Rnd() * 4): pass(1) = True
If Nuovovalore(1) = Vecchiovalore(0) And Nuovoseme(1) = Vecchioseme(0) Or Nuovovalore(1) = Vecchiovalore(1) And Nuovoseme(1) = Vecchioseme(1) Or Nuovovalore(1) = Vecchiovalore(2) And Nuovoseme(1) = Vecchioseme(2) Or Nuovovalore(1) = Vecchiovalore(3) And Nuovoseme(1) = Vecchioseme(3) Or Nuovovalore(1) = Vecchiovalore(4) And Nuovoseme(1) = Vecchioseme(4) Or Nuovovalore(1) = Nuovovalore(0) And Nuovoseme(1) = Nuovoseme(0) Then GoTo 1 Else Valore(1) = Nuovovalore(1): Seme(1).Tag = Nuovoseme(1): GoTo 101
2 Nuovovalore(2) = Int(Rnd() * 13) + 1: Vecchioseme(2) = Int(Rnd() * 4): pass(2) = True
If Nuovovalore(2) = Vecchiovalore(0) And Nuovoseme(2) = Vecchioseme(0) Or Nuovovalore(2) = Vecchiovalore(1) And Nuovoseme(2) = Vecchioseme(1) Or Nuovovalore(2) = Vecchiovalore(2) And Nuovoseme(2) = Vecchioseme(2) Or Nuovovalore(2) = Vecchiovalore(3) And Nuovoseme(2) = Vecchioseme(3) Or Nuovovalore(2) = Vecchiovalore(4) And Nuovoseme(2) = Vecchioseme(4) Or Nuovovalore(2) = Nuovovalore(0) And Nuovoseme(2) = Nuovoseme(0) Or Nuovovalore(2) = Nuovovalore(1) And Nuovoseme(2) = Nuovoseme(1) Then GoTo 2 Else Valore(2) = Nuovovalore(2): Seme(2).Tag = Nuovoseme(2): GoTo 101
3 Nuovovalore(3) = Int(Rnd() * 13) + 1: Vecchioseme(3) = Int(Rnd() * 4): pass(3) = True
If Nuovovalore(3) = Vecchiovalore(0) And Nuovoseme(3) = Vecchioseme(0) Or Nuovovalore(3) = Vecchiovalore(1) And Nuovoseme(3) = Vecchioseme(1) Or Nuovovalore(3) = Vecchiovalore(2) And Nuovoseme(3) = Vecchioseme(2) Or Nuovovalore(3) = Vecchiovalore(3) And Nuovoseme(3) = Vecchioseme(3) Or Nuovovalore(3) = Vecchiovalore(4) And Nuovoseme(3) = Vecchioseme(4) Or Nuovovalore(3) = Nuovovalore(0) And Nuovoseme(3) = Nuovoseme(0) Or Nuovovalore(3) = Nuovovalore(1) And Nuovoseme(3) = Nuovoseme(1) Or Nuovovalore(3) = Nuovovalore(2) And Nuovoseme(3) = Nuovoseme(2) Then GoTo 3 Else Valore(3) = Nuovovalore(3): Seme(3).Tag = Nuovoseme(3): GoTo 101
4 Nuovovalore(4) = Int(Rnd() * 13) + 1: Vecchioseme(4) = Int(Rnd() * 4): pass(4) = True
If Nuovovalore(4) = Vecchiovalore(0) And Nuovoseme(4) = Vecchioseme(0) Or Nuovovalore(4) = Vecchiovalore(1) And Nuovoseme(4) = Vecchioseme(1) Or Nuovovalore(4) = Vecchiovalore(2) And Nuovoseme(4) = Vecchioseme(2) Or Nuovovalore(4) = Vecchiovalore(3) And Nuovoseme(4) = Vecchioseme(3) Or Nuovovalore(4) = Vecchiovalore(4) And Nuovoseme(4) = Vecchioseme(4) Or Nuovovalore(4) = Nuovovalore(0) And Nuovoseme(4) = Nuovoseme(0) Or Nuovovalore(4) = Nuovovalore(1) And Nuovoseme(4) = Nuovoseme(1) Or Nuovovalore(4) = Nuovovalore(2) And Nuovoseme(4) = Nuovoseme(2) Or Nuovovalore(4) = Nuovovalore(3) And Nuovoseme(4) = Nuovoseme(3) Then GoTo 4 Else Valore(4) = Nuovovalore(4): Seme(4).Tag = Nuovoseme(4): GoTo 101
101 'Cambia solo le Carte Selezionate
For k = 0 To 4
If Cambia(k).Value = vbChecked And pass(k) = False Then
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If k = 0 Then GoTo 0 Else If k = 1 Then GoTo 1 Else If k = 2 Then GoTo 2 Else If k = 3 Then GoTo 3 Else If k = 4 Then GoTo 4
End If
Next k
For k = 0 To 4
If Cambia(k).Value = vbChecked Then
If Seme(k).Tag = "0" Then Seme(k).Picture = LoadPicture(percorso & "Cuori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Cuori.jpg") Else If Seme(k).Tag = "1" Then Seme(k).Picture = LoadPicture(percorso & "Quadri.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Quadri.jpg") Else If Seme(k).Tag = "2" Then Seme(k).Picture = LoadPicture(percorso & "Fiori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Fiori.jpg") Else Seme(k).Picture = LoadPicture(percorso & "Picche.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Picche.jpg")
If Seme(k).Tag = "0" Or Seme(k).Tag = "1" Then Valore(k).ForeColor = vbRed Else Valore(k).ForeColor = vbBlack
If Valore(k) = "11" Then Valore(k) = "J": Figura(k).Picture = LoadPicture(percorso & "Fante.jpg") Else If Valore(k) = "12" Then Valore(k) = "Q": Figura(k).Picture = LoadPicture(percorso & "Donna.jpg") Else If Valore(k) = "13" Then Valore(k) = "K": Figura(k).Picture = LoadPicture(percorso & "Re.jpg") Else Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If Valore(k) = "1" Then Valore(k) = "A"
Valore(k).Visible = True
Seme(k).Visible = True
Seme(k + 5).Visible = True
Figura(k).Visible = True
Cambia(k).Enabled = True
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
End If
Cambia(k).Enabled = False
Next k
'VITTORIE
'--- Prerequisiti ---
For k = 0 To 4
'valore senza lettere
If Valore(k) = "A" Then Valore(k).Tag = 1 Else If Valore(k) = "J" Then Valore(k).Tag = 11 Else If Valore(k) = "Q" Then Valore(k).Tag = 12 Else If Valore(k) = "K" Then Valore(k).Tag = 13 Else Valore(k).Tag = Valore(k)
'10-J-Q-K-A (non ripetuti)?
If Valore(k) = "10" Then dieciassoz(0) = dieciassoz(0) + 1
If Valore(k) = "J" Then dieciassoz(1) = dieciassoz(1) + 1
If Valore(k) = "Q" Then dieciassoz(2) = dieciassoz(2) + 1
If Valore(k) = "K" Then dieciassoz(3) = dieciassoz(3) + 1
If Valore(k) = "A" Then dieciassoz(4) = dieciassoz(4) + 1
'scala?
If Valore(k).Tag < minscalaVal Then minscalaVal = Valore(k).Tag
'Valori uguali per coppie o tris?
If Valore(k) = Valore(0) Then valoriz = valoriz + 1
If Valore(k) = Valore(1) Then valoriz = valoriz + 1
If Valore(k) = Valore(2) Then valoriz = valoriz + 1
If Valore(k) = Valore(3) Then valoriz = valoriz + 1
If Valore(k) = Valore(4) Then valoriz = valoriz + 1
'coppia di Jack o superiore?
If Valore(k) = "J" Then coppia(0) = coppia(0) + 1
If Valore(k) = "Q" Then coppia(1) = coppia(1) + 1
If Valore(k) = "K" Then coppia(2) = coppia(2) + 1
If Valore(k) = "A" Then coppia(3) = coppia(3) + 1
Next k
300 'ricontrolla da capo la scala
For k = 0 To 4
If Valore(k).Tag = minscalaVal + 1 Then minscalaVal = Valore(k).Tag: minscalaCont = minscalaCont + 1: GoTo 300
Next k
'stesso colore?
If Seme(0).Tag = Seme(1).Tag And Seme(1).Tag = Seme(2).Tag And Seme(2).Tag = Seme(3).Tag And Seme(3).Tag = Seme(4).Tag Then colorez = True
'scala 10-J-Q-K-A?
If dieciassoz(0) = 1 And dieciassoz(1) = 1 And dieciassoz(2) = 1 And dieciassoz(3) = 1 And dieciassoz(4) = 1 Then scalazr = True
'--- Tipi di vincita ---
'Scala Reale
If scalazr = True And colorez = True Then Vittorie.Caption = "SCALA REALE!!!": Cash = Cash + Scommessa.Text * 800: GoTo 600
'Scala Colore
If minscalaCont = 4 And colorez = True Then Vittorie.Caption = "SCALA COLORE!!!": Cash = Cash + Scommessa.Text * 50: GoTo 600
'Poker
For k = 0 To 4
If Valore(k) = Valore(0) Then pokerz = pokerz + 1
If Valore(k) = Valore(1) Then pokerz = pokerz + 1
If Valore(k) = Valore(2) Then pokerz = pokerz + 1
If Valore(k) = Valore(3) Then pokerz = pokerz + 1
If Valore(k) = Valore(4) Then pokerz = pokerz + 1
Next k
If pokerz = 17 Then Vittorie.Caption = "POKER!!!": Cash = Cash + Scommessa.Text * 25: GoTo 600
'Full
If valoriz = 13 Then Vittorie.Caption = "Full!": Cash = Cash + Scommessa.Text * 9: GoTo 600
'Colore!
If colorez = True Then Vittorie.Caption = "Colore": Cash = Cash + Scommessa.Text * 6: GoTo 600
'Scala
If minscalaCont = 4 Or scalazr = True Then Vittorie.Caption = "Scala": Cash = Cash + Scommessa.Text * 4: GoTo 600
'Tris
If valoriz = 11 Then Vittorie.Caption = "Tris": Cash = Cash + Scommessa.Text * 3: GoTo 600
'Doppia Coppia
If valoriz = 9 Then Vittorie.Caption = "Doppia Coppia": Cash = Cash + Scommessa.Text * 2: GoTo 600
'Coppia Jack o superiore
If coppia(0) = 2 Or coppia(1) = 2 Or coppia(2) = 2 Or coppia(3) = 2 Then Vittorie.FontSize = 17: Vittorie.Caption = "Coppia di Jack o Superiore": Cash = Cash + Scommessa.Text: GoTo 600
600 'Fine Vittorie
Cassa.Caption = Cash
Pulsante.Caption = "Nuova Partita"
GoTo 999
End If
If Pulsante.Caption = "Nuova Partita" Then
If Cash < 1 Then MsgBox "Non hai più soldi... hai perso tutto!!!!", vbOKOnly, "Perso!!!": Pulsante.Enabled = False: Scommessa.Enabled = False: GoTo 999
Pulsante.Caption = "Dai Carte!!!"
Scommessa.Enabled = True
Call Azzera
End If
999 'Fine Sub
End Sub
Private Sub Azzera()
For k = 0 To 4
pass(k) = False
Cambia(k).Value = vbUnchecked
Seme(k).Visible = False
Seme(k + 5).Visible = False
Figura(k).Visible = False
Valore(k).Visible = False
Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
If k < 4 Then coppia(k) = 0
Next k
Vittorie.Caption = ""
Vittorie.FontSize = 22
colorez = False
minscalaVal = 14
minscalaCont = 0
scalazr = False
pokerz = 0
valoriz = 0
End Sub
Private Sub Cambia_Click(Index As Integer)
If Cambia(Index).Value = vbChecked Then Carta(Index).Picture = LoadPicture(percorsoskin & skincarta): Seme(Index).Visible = False: Seme(Index + 5).Visible = False: Figura(Index).Visible = False: Valore(Index).Visible = False
If Cambia(Index).Value = vbUnchecked Then Carta(Index).Picture = LoadPicture(percorso & "Bianco.jpg"): Seme(Index).Visible = True: Seme(Index + 5).Visible = True: Figura(Index).Visible = True: Valore(Index).Visible = True
End Sub
Private Sub Scommessa_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then KeyAscii = 0: MsgBox "Niente Spazi!", vbCritical, "Errore Scommessa": Exit Sub
If IsNumeric(Chr(KeyAscii)) = False Then If KeyAscii <> 8 And KeyAscii <> 13 Then MsgBox "Inserire un Numero Intero Valido (solo numeri...)!", vbCritical, "Errore Scommessa": KeyAscii = 0
If KeyAscii = 13 Then Pulsante.SetFocus: Call Pulsante_Click
End Sub
Private Sub NuovaPartita_Click()
Unload Me
Form1.Show
End Sub
Private Sub Esci_Click()
Unload Me
End Sub
Private Sub Combinazioni_Click()
MsgBox ("1X Coppia di Jack o superiore" + Chr(10) + Chr(13) + "2X Doppia Coppia" + Chr(10) + Chr(13) + "3X Tris" + Chr(10) + Chr(13) + "4X Scala" + Chr(10) + Chr(13) + "6X Colore" + Chr(10) + Chr(13) + "9X Full (Tris + Coppia)" + Chr(10) + Chr(13) + "25X Poker (4 uguali)" + Chr(10) + Chr(13) + "50X Scala Colore" + Chr(10) + Chr(13) + "800X Scala Reale (dal 10 all Asso dello stesso Colore)"), vbInformation, "Combinazioni Vincenti..."
End Sub
Private Sub About2_Click()
Form2.Show 1
End Sub
Private Sub Skin_Click(Index As Integer)
On Error GoTo GestoreErrori
For k = 1 To 6
If k <> Index Then Skin(k).Checked = False
Next k
Skin(Index).Checked = True
Skinimp.Checked = False
If Index = 6 Then MsgBox "Modifica l'immagine 'Carta6.jpg' presente nella cartella 'Immagini/Immagini Poker' a tuo piacimento... Enjoy!"
percorsoskin = "Immagini/Immagini Poker/"
skincarta = "Carta" & Index & ".jpg"
If Pulsante.Caption = "Dai Carte!!!" Then Azzera
If Pulsante.Caption = "Cambia Carte" Then
For k = 0 To 4
If Cambia(k).Value = vbChecked Then Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
Next k
GestoreErrori:
If Err.Number = 53 Then MsgBox "Immagine non trovata!!!", vbCritical
End If
End Sub
Private Sub Skinimp_Click()
On Error GoTo GestoreErrori
CommonDialog1.ShowOpen
skincarta = CommonDialog1.FileName
percorsoskin = ""
For k = 1 To 6
Skin(k).Checked = False
Next k
Skinimp.Checked = True
If Pulsante.Caption = "Dai Carte!!!" Then Azzera
If Pulsante.Caption = "Cambia Carte" Then
For k = 0 To 4
If Cambia(k).Value = vbChecked Then Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
Next k
End If
GestoreErrori:
If Err.Number = 481 Then
MsgBox "Immagine non Valida!!!", vbCritical
percorsoskin = percorso
skincarta = "Bianco.jpg"
End If
End Sub
<hr height="1" noshade id="quote"></blockquote id="quote"></font id="quote">
-
M@ttia
- Moderatore
-
- Messaggi: 8363
- Iscritto il: lun giu 09, 2003 2:18 pm
- Località: Ticino - Estero
da M@ttia » mar nov 25, 2003 8:58 pm
[In risposta a qui]
Dunque, il sorgente del mio poker che mi avevi chiesto è questo... Probabilmente può essere "alleggerito" un pochino dato che lo scritto tutto io e nn lo faccio di mestiere, ma comunque funziona perfettamente ed è comunque veloce-istantaneo...
(le vincite, che ti interessano, le trovi verso la metà-fine e ti ho messo anche cosa sto verificando ad ogni riga di codice x farti capire meglio...
<blockquote id="quote"><font size="1" face="Verdana, Arial, Helvetica" id="quote">citazione:<hr height="1" noshade id="quote">Option Explicit
Dim k As Integer
Dim Cash As Integer
Dim Vecchiovalore(4) As Integer
Dim Vecchioseme(4) As Integer
Dim Nuovovalore(4) As Integer
Dim Nuovoseme(4) As Integer
Dim pass(4) As Boolean
Dim scalazr As Boolean
Dim minscalaVal As Integer
Dim minscalaCont As Integer
Dim pokerz As Integer
Dim colorez As Boolean
Dim valoriz As Integer
Dim coppia(3) As Integer
Dim dieciassoz(4) As Integer
Dim percorso As String
Dim percorsoskin As String
Dim skincarta As String
Private Sub Form_Load()
Randomize
Cash = 1000
Cassa.Caption = Cash
skincarta = "Carta1.jpg"
percorso = "Immagini/Immagini Poker/"
percorsoskin = percorso
Azzera
End Sub
'0 = Cuori, 1 = Quadri, 2 = Fiori, 3 = Picche
Private Sub Pulsante_Click()
If Pulsante.Caption = "Dai Carte!!!" Then
If Scommessa.Text = "" Or Scommessa.Text < "1" Then MsgBox "Scommettere Qualcosa (minimo 1$)", vbExclamation, "Errore Scommessa": Scommessa.Text = "": GoTo 999
If Scommessa.Text > Cash Then MsgBox "Non hai tutti questi soldi!!!", vbCritical, "Mancanza Soldi": Scommessa.Text = "": GoTo 999
Cash = Cash - Scommessa.Text
Cassa.Caption = Cash
Scommessa.Enabled = False
10 Valore(0) = Int(Rnd() * 13) + 1: Seme(0).Tag = Int(Rnd() * 4)
Vecchiovalore(0) = Valore(0): Vecchioseme(0) = Seme(0).Tag
20 Valore(1) = Int(Rnd() * 13) + 1: Seme(1).Tag = Int(Rnd() * 4)
If Valore(1) = Valore(0) And Seme(1).Tag = Seme(0).Tag Then GoTo 20
Vecchiovalore(1) = Valore(1): Vecchioseme(1) = Seme(1).Tag
30 Valore(2) = Int(Rnd() * 13) + 1: Seme(2).Tag = Int(Rnd() * 4)
If Valore(2) = Valore(0) And Seme(2).Tag = Seme(0).Tag Or Valore(2) = Valore(1) And Seme(2).Tag = Seme(1).Tag Then GoTo 30
Vecchiovalore(2) = Valore(2): Vecchioseme(2) = Seme(2).Tag
40 Valore(3) = Int(Rnd() * 13) + 1: Seme(3).Tag = Int(Rnd() * 4)
If Valore(3) = Valore(0) And Seme(3).Tag = Seme(0).Tag Or Valore(3) = Valore(1) And Seme(3).Tag = Seme(1).Tag Or Valore(3) = Valore(2) And Seme(3).Tag = Seme(2).Tag Then GoTo 40
Vecchiovalore(3) = Valore(3): Vecchioseme(3) = Seme(3).Tag
50 Valore(4) = Int(Rnd() * 13) + 1: Seme(4).Tag = Int(Rnd() * 4)
If Valore(4) = Valore(0) And Seme(4).Tag = Seme(0).Tag Or Valore(4) = Valore(1) And Seme(4).Tag = Seme(1).Tag Or Valore(4) = Valore(2) And Seme(4).Tag = Seme(2).Tag Or Valore(4) = Valore(3) And Seme(4).Tag = Seme(3).Tag Then GoTo 50
Vecchiovalore(4) = Valore(4): Vecchioseme(4) = Seme(4).Tag
For k = 0 To 4
If Seme(k).Tag = "0" Then Seme(k).Picture = LoadPicture(percorso & "Cuori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Cuori.jpg") Else If Seme(k).Tag = "1" Then Seme(k).Picture = LoadPicture(percorso & "Quadri.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Quadri.jpg") Else If Seme(k).Tag = "2" Then Seme(k).Picture = LoadPicture(percorso & "Fiori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Fiori.jpg") Else Seme(k).Picture = LoadPicture(percorso & "Picche.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Picche.jpg")
If Seme(k).Tag = "0" Or Seme(k).Tag = "1" Then Valore(k).ForeColor = vbRed Else Valore(k).ForeColor = vbBlack
If Valore(k) = "11" Then Valore(k) = "J": Figura(k).Picture = LoadPicture(percorso & "Fante.jpg") Else If Valore(k) = "12" Then Valore(k) = "Q": Figura(k).Picture = LoadPicture(percorso & "Donna.jpg") Else If Valore(k) = "13" Then Valore(k) = "K": Figura(k).Picture = LoadPicture(percorso & "Re.jpg") Else Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If Valore(k) = "1" Then Valore(k) = "A"
Valore(k).Visible = True
Seme(k).Visible = True
Seme(k + 5).Visible = True
Figura(k).Visible = True
Cambia(k).Enabled = True
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
Next k
Pulsante.Caption = "Cambia Carte"
GoTo 999
End If
If Pulsante.Caption = "Cambia Carte" Then
GoTo 101
0 Nuovovalore(0) = Int(Rnd() * 13) + 1: Nuovoseme(0) = Int(Rnd() * 4): pass(0) = True
If Nuovovalore(0) = Vecchiovalore(0) And Nuovoseme(0) = Vecchioseme(0) Or Nuovovalore(0) = Vecchiovalore(1) And Nuovoseme(0) = Vecchioseme(1) Or Nuovovalore(0) = Vecchiovalore(2) And Nuovoseme(0) = Vecchioseme(2) Or Nuovovalore(0) = Vecchiovalore(3) And Nuovoseme(0) = Vecchioseme(3) Or Nuovovalore(0) = Vecchiovalore(4) And Nuovoseme(0) = Vecchioseme(4) Then GoTo 0 Else Valore(0) = Nuovovalore(0): Seme(0).Tag = Nuovoseme(0): GoTo 101
1 Nuovovalore(1) = Int(Rnd() * 13) + 1: Vecchioseme(1) = Int(Rnd() * 4): pass(1) = True
If Nuovovalore(1) = Vecchiovalore(0) And Nuovoseme(1) = Vecchioseme(0) Or Nuovovalore(1) = Vecchiovalore(1) And Nuovoseme(1) = Vecchioseme(1) Or Nuovovalore(1) = Vecchiovalore(2) And Nuovoseme(1) = Vecchioseme(2) Or Nuovovalore(1) = Vecchiovalore(3) And Nuovoseme(1) = Vecchioseme(3) Or Nuovovalore(1) = Vecchiovalore(4) And Nuovoseme(1) = Vecchioseme(4) Or Nuovovalore(1) = Nuovovalore(0) And Nuovoseme(1) = Nuovoseme(0) Then GoTo 1 Else Valore(1) = Nuovovalore(1): Seme(1).Tag = Nuovoseme(1): GoTo 101
2 Nuovovalore(2) = Int(Rnd() * 13) + 1: Vecchioseme(2) = Int(Rnd() * 4): pass(2) = True
If Nuovovalore(2) = Vecchiovalore(0) And Nuovoseme(2) = Vecchioseme(0) Or Nuovovalore(2) = Vecchiovalore(1) And Nuovoseme(2) = Vecchioseme(1) Or Nuovovalore(2) = Vecchiovalore(2) And Nuovoseme(2) = Vecchioseme(2) Or Nuovovalore(2) = Vecchiovalore(3) And Nuovoseme(2) = Vecchioseme(3) Or Nuovovalore(2) = Vecchiovalore(4) And Nuovoseme(2) = Vecchioseme(4) Or Nuovovalore(2) = Nuovovalore(0) And Nuovoseme(2) = Nuovoseme(0) Or Nuovovalore(2) = Nuovovalore(1) And Nuovoseme(2) = Nuovoseme(1) Then GoTo 2 Else Valore(2) = Nuovovalore(2): Seme(2).Tag = Nuovoseme(2): GoTo 101
3 Nuovovalore(3) = Int(Rnd() * 13) + 1: Vecchioseme(3) = Int(Rnd() * 4): pass(3) = True
If Nuovovalore(3) = Vecchiovalore(0) And Nuovoseme(3) = Vecchioseme(0) Or Nuovovalore(3) = Vecchiovalore(1) And Nuovoseme(3) = Vecchioseme(1) Or Nuovovalore(3) = Vecchiovalore(2) And Nuovoseme(3) = Vecchioseme(2) Or Nuovovalore(3) = Vecchiovalore(3) And Nuovoseme(3) = Vecchioseme(3) Or Nuovovalore(3) = Vecchiovalore(4) And Nuovoseme(3) = Vecchioseme(4) Or Nuovovalore(3) = Nuovovalore(0) And Nuovoseme(3) = Nuovoseme(0) Or Nuovovalore(3) = Nuovovalore(1) And Nuovoseme(3) = Nuovoseme(1) Or Nuovovalore(3) = Nuovovalore(2) And Nuovoseme(3) = Nuovoseme(2) Then GoTo 3 Else Valore(3) = Nuovovalore(3): Seme(3).Tag = Nuovoseme(3): GoTo 101
4 Nuovovalore(4) = Int(Rnd() * 13) + 1: Vecchioseme(4) = Int(Rnd() * 4): pass(4) = True
If Nuovovalore(4) = Vecchiovalore(0) And Nuovoseme(4) = Vecchioseme(0) Or Nuovovalore(4) = Vecchiovalore(1) And Nuovoseme(4) = Vecchioseme(1) Or Nuovovalore(4) = Vecchiovalore(2) And Nuovoseme(4) = Vecchioseme(2) Or Nuovovalore(4) = Vecchiovalore(3) And Nuovoseme(4) = Vecchioseme(3) Or Nuovovalore(4) = Vecchiovalore(4) And Nuovoseme(4) = Vecchioseme(4) Or Nuovovalore(4) = Nuovovalore(0) And Nuovoseme(4) = Nuovoseme(0) Or Nuovovalore(4) = Nuovovalore(1) And Nuovoseme(4) = Nuovoseme(1) Or Nuovovalore(4) = Nuovovalore(2) And Nuovoseme(4) = Nuovoseme(2) Or Nuovovalore(4) = Nuovovalore(3) And Nuovoseme(4) = Nuovoseme(3) Then GoTo 4 Else Valore(4) = Nuovovalore(4): Seme(4).Tag = Nuovoseme(4): GoTo 101
101 'Cambia solo le Carte Selezionate
For k = 0 To 4
If Cambia(k).Value = vbChecked And pass(k) = False Then
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If k = 0 Then GoTo 0 Else If k = 1 Then GoTo 1 Else If k = 2 Then GoTo 2 Else If k = 3 Then GoTo 3 Else If k = 4 Then GoTo 4
End If
Next k
For k = 0 To 4
If Cambia(k).Value = vbChecked Then
If Seme(k).Tag = "0" Then Seme(k).Picture = LoadPicture(percorso & "Cuori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Cuori.jpg") Else If Seme(k).Tag = "1" Then Seme(k).Picture = LoadPicture(percorso & "Quadri.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Quadri.jpg") Else If Seme(k).Tag = "2" Then Seme(k).Picture = LoadPicture(percorso & "Fiori.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Fiori.jpg") Else Seme(k).Picture = LoadPicture(percorso & "Picche.jpg"): Seme(k + 5).Picture = LoadPicture(percorso & "Picche.jpg")
If Seme(k).Tag = "0" Or Seme(k).Tag = "1" Then Valore(k).ForeColor = vbRed Else Valore(k).ForeColor = vbBlack
If Valore(k) = "11" Then Valore(k) = "J": Figura(k).Picture = LoadPicture(percorso & "Fante.jpg") Else If Valore(k) = "12" Then Valore(k) = "Q": Figura(k).Picture = LoadPicture(percorso & "Donna.jpg") Else If Valore(k) = "13" Then Valore(k) = "K": Figura(k).Picture = LoadPicture(percorso & "Re.jpg") Else Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
If Valore(k) = "1" Then Valore(k) = "A"
Valore(k).Visible = True
Seme(k).Visible = True
Seme(k + 5).Visible = True
Figura(k).Visible = True
Cambia(k).Enabled = True
Carta(k).Picture = LoadPicture(percorso & "Bianco.jpg")
End If
Cambia(k).Enabled = False
Next k
'VITTORIE
'--- Prerequisiti ---
For k = 0 To 4
'valore senza lettere
If Valore(k) = "A" Then Valore(k).Tag = 1 Else If Valore(k) = "J" Then Valore(k).Tag = 11 Else If Valore(k) = "Q" Then Valore(k).Tag = 12 Else If Valore(k) = "K" Then Valore(k).Tag = 13 Else Valore(k).Tag = Valore(k)
'10-J-Q-K-A (non ripetuti)?
If Valore(k) = "10" Then dieciassoz(0) = dieciassoz(0) + 1
If Valore(k) = "J" Then dieciassoz(1) = dieciassoz(1) + 1
If Valore(k) = "Q" Then dieciassoz(2) = dieciassoz(2) + 1
If Valore(k) = "K" Then dieciassoz(3) = dieciassoz(3) + 1
If Valore(k) = "A" Then dieciassoz(4) = dieciassoz(4) + 1
'scala?
If Valore(k).Tag < minscalaVal Then minscalaVal = Valore(k).Tag
'Valori uguali per coppie o tris?
If Valore(k) = Valore(0) Then valoriz = valoriz + 1
If Valore(k) = Valore(1) Then valoriz = valoriz + 1
If Valore(k) = Valore(2) Then valoriz = valoriz + 1
If Valore(k) = Valore(3) Then valoriz = valoriz + 1
If Valore(k) = Valore(4) Then valoriz = valoriz + 1
'coppia di Jack o superiore?
If Valore(k) = "J" Then coppia(0) = coppia(0) + 1
If Valore(k) = "Q" Then coppia(1) = coppia(1) + 1
If Valore(k) = "K" Then coppia(2) = coppia(2) + 1
If Valore(k) = "A" Then coppia(3) = coppia(3) + 1
Next k
300 'ricontrolla da capo la scala
For k = 0 To 4
If Valore(k).Tag = minscalaVal + 1 Then minscalaVal = Valore(k).Tag: minscalaCont = minscalaCont + 1: GoTo 300
Next k
'stesso colore?
If Seme(0).Tag = Seme(1).Tag And Seme(1).Tag = Seme(2).Tag And Seme(2).Tag = Seme(3).Tag And Seme(3).Tag = Seme(4).Tag Then colorez = True
'scala 10-J-Q-K-A?
If dieciassoz(0) = 1 And dieciassoz(1) = 1 And dieciassoz(2) = 1 And dieciassoz(3) = 1 And dieciassoz(4) = 1 Then scalazr = True
'--- Tipi di vincita ---
'Scala Reale
If scalazr = True And colorez = True Then Vittorie.Caption = "SCALA REALE!!!": Cash = Cash + Scommessa.Text * 800: GoTo 600
'Scala Colore
If minscalaCont = 4 And colorez = True Then Vittorie.Caption = "SCALA COLORE!!!": Cash = Cash + Scommessa.Text * 50: GoTo 600
'Poker
For k = 0 To 4
If Valore(k) = Valore(0) Then pokerz = pokerz + 1
If Valore(k) = Valore(1) Then pokerz = pokerz + 1
If Valore(k) = Valore(2) Then pokerz = pokerz + 1
If Valore(k) = Valore(3) Then pokerz = pokerz + 1
If Valore(k) = Valore(4) Then pokerz = pokerz + 1
Next k
If pokerz = 17 Then Vittorie.Caption = "POKER!!!": Cash = Cash + Scommessa.Text * 25: GoTo 600
'Full
If valoriz = 13 Then Vittorie.Caption = "Full!": Cash = Cash + Scommessa.Text * 9: GoTo 600
'Colore!
If colorez = True Then Vittorie.Caption = "Colore": Cash = Cash + Scommessa.Text * 6: GoTo 600
'Scala
If minscalaCont = 4 Or scalazr = True Then Vittorie.Caption = "Scala": Cash = Cash + Scommessa.Text * 4: GoTo 600
'Tris
If valoriz = 11 Then Vittorie.Caption = "Tris": Cash = Cash + Scommessa.Text * 3: GoTo 600
'Doppia Coppia
If valoriz = 9 Then Vittorie.Caption = "Doppia Coppia": Cash = Cash + Scommessa.Text * 2: GoTo 600
'Coppia Jack o superiore
If coppia(0) = 2 Or coppia(1) = 2 Or coppia(2) = 2 Or coppia(3) = 2 Then Vittorie.FontSize = 17: Vittorie.Caption = "Coppia di Jack o Superiore": Cash = Cash + Scommessa.Text: GoTo 600
600 'Fine Vittorie
Cassa.Caption = Cash
Pulsante.Caption = "Nuova Partita"
GoTo 999
End If
If Pulsante.Caption = "Nuova Partita" Then
If Cash < 1 Then MsgBox "Non hai più soldi... hai perso tutto!!!!", vbOKOnly, "Perso!!!": Pulsante.Enabled = False: Scommessa.Enabled = False: GoTo 999
Pulsante.Caption = "Dai Carte!!!"
Scommessa.Enabled = True
Call Azzera
End If
999 'Fine Sub
End Sub
Private Sub Azzera()
For k = 0 To 4
pass(k) = False
Cambia(k).Value = vbUnchecked
Seme(k).Visible = False
Seme(k + 5).Visible = False
Figura(k).Visible = False
Valore(k).Visible = False
Figura(k).Picture = LoadPicture(percorso & "Bianco.jpg")
Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
If k < 4 Then coppia(k) = 0
Next k
Vittorie.Caption = ""
Vittorie.FontSize = 22
colorez = False
minscalaVal = 14
minscalaCont = 0
scalazr = False
pokerz = 0
valoriz = 0
End Sub
Private Sub Cambia_Click(Index As Integer)
If Cambia(Index).Value = vbChecked Then Carta(Index).Picture = LoadPicture(percorsoskin & skincarta): Seme(Index).Visible = False: Seme(Index + 5).Visible = False: Figura(Index).Visible = False: Valore(Index).Visible = False
If Cambia(Index).Value = vbUnchecked Then Carta(Index).Picture = LoadPicture(percorso & "Bianco.jpg"): Seme(Index).Visible = True: Seme(Index + 5).Visible = True: Figura(Index).Visible = True: Valore(Index).Visible = True
End Sub
Private Sub Scommessa_KeyPress(KeyAscii As Integer)
If KeyAscii = 32 Then KeyAscii = 0: MsgBox "Niente Spazi!", vbCritical, "Errore Scommessa": Exit Sub
If IsNumeric(Chr(KeyAscii)) = False Then If KeyAscii <> 8 And KeyAscii <> 13 Then MsgBox "Inserire un Numero Intero Valido (solo numeri...)!", vbCritical, "Errore Scommessa": KeyAscii = 0
If KeyAscii = 13 Then Pulsante.SetFocus: Call Pulsante_Click
End Sub
Private Sub NuovaPartita_Click()
Unload Me
Form1.Show
End Sub
Private Sub Esci_Click()
Unload Me
End Sub
Private Sub Combinazioni_Click()
MsgBox ("1X Coppia di Jack o superiore" + Chr(10) + Chr(13) + "2X Doppia Coppia" + Chr(10) + Chr(13) + "3X Tris" + Chr(10) + Chr(13) + "4X Scala" + Chr(10) + Chr(13) + "6X Colore" + Chr(10) + Chr(13) + "9X Full (Tris + Coppia)" + Chr(10) + Chr(13) + "25X Poker (4 uguali)" + Chr(10) + Chr(13) + "50X Scala Colore" + Chr(10) + Chr(13) + "800X Scala Reale (dal 10 all Asso dello stesso Colore)"), vbInformation, "Combinazioni Vincenti..."
End Sub
Private Sub About2_Click()
Form2.Show 1
End Sub
Private Sub Skin_Click(Index As Integer)
On Error GoTo GestoreErrori
For k = 1 To 6
If k <> Index Then Skin(k).Checked = False
Next k
Skin(Index).Checked = True
Skinimp.Checked = False
If Index = 6 Then MsgBox "Modifica l'immagine 'Carta6.jpg' presente nella cartella 'Immagini/Immagini Poker' a tuo piacimento... Enjoy!"
percorsoskin = "Immagini/Immagini Poker/"
skincarta = "Carta" & Index & ".jpg"
If Pulsante.Caption = "Dai Carte!!!" Then Azzera
If Pulsante.Caption = "Cambia Carte" Then
For k = 0 To 4
If Cambia(k).Value = vbChecked Then Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
Next k
GestoreErrori:
If Err.Number = 53 Then MsgBox "Immagine non trovata!!!", vbCritical
End If
End Sub
Private Sub Skinimp_Click()
On Error GoTo GestoreErrori
CommonDialog1.ShowOpen
skincarta = CommonDialog1.FileName
percorsoskin = ""
For k = 1 To 6
Skin(k).Checked = False
Next k
Skinimp.Checked = True
If Pulsante.Caption = "Dai Carte!!!" Then Azzera
If Pulsante.Caption = "Cambia Carte" Then
For k = 0 To 4
If Cambia(k).Value = vbChecked Then Carta(k).Picture = LoadPicture(percorsoskin & skincarta)
Next k
End If
GestoreErrori:
If Err.Number = 481 Then
MsgBox "Immagine non Valida!!!", vbCritical
percorsoskin = percorso
skincarta = "Bianco.jpg"
End If
End Sub
<hr height="1" noshade id="quote"></blockquote id="quote"></font id="quote">
-
M@ttia
- Moderatore
-
- Messaggi: 8363
- Iscritto il: lun giu 09, 2003 2:18 pm
- Località: Ticino - Estero
Torna a Programmazione
Chi c’è in linea
Visitano il forum: Nessuno e 1 ospite
Esegui