[Juego] Tragamonedas.

[79137913]

HOLA!!!

Hola, hoy les traigo un tragamonedas, lo programe hoy asi que puede ser que tenga algun que otro bug, digan si encuentran .

Es asi:



El codigo:

Código (vb) [Seleccionar] Expandir


Private tabla(15) As Byte
Private DETENER As Boolean
Private LINEAS As Byte
Private MONEDAS As Boolean
Private DINERO As Double
Private DIB2(15) As Byte 'REPRESENTA LOS DIBUJOS EN CODIGO
Private BASE(3) As Integer
Dim CODIGO As String
Dim LIN As String
Dim DIN As Integer
Dim RESTA As Byte


Private Sub Form_Load()
LINEAS = 1
DINERO = 100
MONEDAS = False
Dim x As Byte
For x = 1 To 5
tabla(x) = x
If x >= 2 Then tabla(x + 4) = x
If x >= 3 Then tabla(x + 7) = x
If x >= 4 Then tabla(x + 9) = x
Next
tabla(15) = 5
End Sub


Private Sub Go_Click()
Dim AP As Byte ' apuesta
AP = LINEAS
If MONEDAS = True Then AP = LINEAS * 2
If AP <= DINERO Then
Girar.Interval = 30
STOPTIM.Interval = 1000
Go.Enabled = False
Else
MsgBox "Estas apostando mas de lo que tienes", , "Atencion"
End If
End Sub

Private Sub Girar_Timer()
Randomize
    Dim x As Byte
    Dim VUELTA As Byte ' REPRESENTA LA CANTIDAD DE VECES QUE MANDO UN DIBUJO ARRIBA
    For x = 0 To 14
        DIB1(x).Top = DIB1(x).Top + 150
        If DIB1(x).Top >= 2430 Then
            VUELTA = VUELTA + 1
            DIB1(x).Top = -1330
            If DETENER = True Then Girar.Interval = 0
            RAN = tabla(1 + Int(Rnd() * 14))
            DIB1(x).Picture = LoadPicture(App.Path & "/Images/T (" & RAN & ").jpg")
            DIB2(x) = RAN
            BASE(VUELTA) = x - 1
            If BASE(VUELTA) = -1 Then BASE(VUELTA) = 4
            If BASE(VUELTA) = 4 Then BASE(VUELTA) = 9
            If BASE(VUELTA) = 9 Then BASE(VUELTA) = 14
        End If
    Next
    VUELTA = 0
    If DETENER = True And Girar.Interval = 0 Then
        DETENER = False
        Call Calcular
    End If
End Sub

Private Sub MAS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) + 1)) & " LINEAS"
If LBLLIN.Caption = "6 LINEAS" Then LBLLIN.Caption = "5 LINEAS"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub

Private Sub MENOS_Click()
LBLLIN.Caption = Trim(Str(Val(Mid(LBLLIN.Caption, 1, 1)) - 1)) & " LINEAS"
If LBLLIN.Caption = "0 LINEAS" Then LBLLIN.Caption = "1 LINEA"
If LBLLIN.Caption = "1 LINEAS" Then LBLLIN.Caption = "1 LINEA"
LINEAS = Str(Val(Mid(LBLLIN.Caption, 1, 1)))
End Sub

Private Sub Option1_Click(Index As Integer)
MONEDAS = False
If Index = 1 Then MONEDAS = True
End Sub

Private Sub STOPTIM_Timer()
STOPTIM.Interval = 0
StopX.Enabled = True
End Sub

Private Sub StopX_Click()
DETENER = True
Go.Enabled = True
StopX.Enabled = False
End Sub

Private Sub Calcular()
CODIGO = ""
DIN = 0
'HORIZONTALES
For x = 0 To 2
    If x = 0 Then
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
    ElseIf x = 1 Then
        If BASE(1) = 0 Then
        CODIGO = DIB2(4) & DIB2(9) & DIB2(14) & CODIGO
        Else
        CODIGO = DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x) & CODIGO
        End If
    ElseIf x = 2 Then
        If BASE(1) = 0 Then
        CODIGO = CODIGO & DIB2(3) & DIB2(8) & DIB2(13)
        ElseIf BASE(1) = 1 Then
        CODIGO = CODIGO & DIB2(4) & DIB2(9) & DIB2(14)
        Else
        CODIGO = CODIGO & DIB2(BASE(1) - x) & DIB2(BASE(2) - x) & DIB2(BASE(3) - x)
        End If
    End If
Next
'DIAGONAL 1
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(9) & DIB2(10)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(5) & DIB2(11)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(6) & DIB2(12)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(7) & DIB2(13)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(8) & DIB2(14)
End If
'DIAGONAL 2
If BASE(1) = 0 Then
    CODIGO = CODIGO & DIB2(0) & DIB2(9) & DIB2(13)
ElseIf BASE(1) = 1 Then
    CODIGO = CODIGO & DIB2(1) & DIB2(5) & DIB2(14)
ElseIf BASE(1) = 2 Then
    CODIGO = CODIGO & DIB2(2) & DIB2(6) & DIB2(10)
ElseIf BASE(1) = 3 Then
    CODIGO = CODIGO & DIB2(3) & DIB2(7) & DIB2(11)
ElseIf BASE(1) = 4 Then
    CODIGO = CODIGO & DIB2(4) & DIB2(8) & DIB2(12)
End If
For x = 0 To LINEAS - 1
    LIN = Mid(CODIGO, x * 3 + 1, 3)
    If LIN = "111" Then DIN = DIN + 2000
    If LIN = "222" Then DIN = DIN + 200
    If LIN = "333" Then DIN = DIN + 50
    If LIN = "444" Then DIN = DIN + 30
    If LIN = "555" Then DIN = DIN + 10
    Dim Y As Byte
    If Not LIN = "555" And (Mid(LIN, 1, 2) = "55" Or Mid(LIN, 2, 2) = "55") Then DIN = DIN + 5
Next
If MONEDAS = True Then DIN = DIN * 2
RESTA = LINEAS
If MONEDAS = True Then RESTA = LINEAS * 2
DINERO = DINERO + DIN - RESTA
lbldin.Caption = "$ " & DINERO
End Sub


Source con el ejecutable:

Descargar URL:
http://www.gigasize.com/get.php?d=mkrb3z3ylyb

Mirror:
http://hotfile.com/dl/80628928/841f839/Tragamonedas.rar.html

GRACIAS POR LEER!!!