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
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!!!