Punto y fama con visual basic 6

Publicado el: 19 de agosto de 2019
Principiante
Acerca de este proyecto
Sencillo juego que consiste en adivinar en 10 pasos las 4 cifras generadas por el computador, a traves de una serie de pistas.
visual basic 6 punto y fama
Publicidad
DETALLES

El juego consiste en adivinar las 4 cifras generadas de manera aleatoria por el programa. Las cifras no deben repetirse entre si. Luego el usuario va introduciendo cada cifra en un cuadro de texto, al presionar el boton de aceptar, el programa compara cada cifra del usuario con la generada por la maquina. Si la cifra se encuentra en la misma posicion o columna, se genera una fama, si la cifra esta en otra posicion u orden, se genera un punto. Se gana el juego cuando se consigan las 4 famas antes de que se cumplan los 10 intentos posibles.

El programa verifica que las cifras generadas al azar no se repitan entre si, al igua que las cifras introducidas por el usuario.

Modulo para generar el numero aleatorio

Modulo que genera el numero aleatorio.

Este programa tambien asigna un puntaje o score, por cada punto se le suma un punto a su score, y por cada fama se le suma dos puntos a su puntaje. Esto servira para poder competir con algun amigo o familiar.

Haga clic aca para descargar el codigo fuente en visual basic 6.0.


CODIFICACI脫N
Codigo en visual basic 6-
Esto solo es el codigo fuente, se recomienda descargar el proyecto desde el enlace para descargar los formularios.
Option Explicit


'Punto y Fama
'Versión 1
'Pueden añadirle mejoras como: niveles de dificultad
'o que el computador adivine tu número
Dim a, b, c, d, i As Integer
Dim k, l, m, n, paso As Integer
Dim puntos, famas As Long
Dim mensaje$, Cadena$
Dim score As Long, tempscore As Long
Dim rsta As Variant

Private Sub verificar()

puntos = 0
famas = 0
k = Val(txt(0))
l = Val(txt(1))
m = Val(txt(2))
n = Val(txt(3))
If k = l Or k = m Or k = n Or l = m Or l = n Or m = n Then
   rsta = MsgBox("No se deben repetir las cifras entre sí", vbOKOnly + vbInformation, "Punto y Fama")
  Else
  If a = k Then famas = famas + 1
  If b = l Then famas = famas + 1
  If c = m Then famas = famas + 1
  If d = n Then famas = famas + 1
    If a = l Or a = m Or a = n Then puntos = puntos + 1
    If b = k Or b = m Or b = n Then puntos = puntos + 1
    If c = k Or c = l Or c = n Then puntos = puntos + 1
    If d = k Or d = l Or d = m Then puntos = puntos + 1
lblNumero = txt(0) & "   " & txt(1) & "   " & txt(2) & "   " & txt(3)
lblPuntos = puntos
lblFamas = famas
tempscore = puntos + famas * 2
score = tempscore + score
lblScore = score
paso = paso + 1
If paso = 11 Then
        MsgBox "El Número es el " & a & b & c & d
        Call inicio
    End If
lblPaso = "Paso: " & paso
txt(0) = "": txt(1) = "": txt(2) = "": txt(3) = ""
cmdAceptar.Enabled = False
txt(0).SetFocus
End If

End Sub

Private Sub cmdAceptar_Click()
verificar
End Sub

Private Sub cmdCerrarAyuda_Click()
txtAyuda.Visible = False
cmdCerrarAyuda.Visible = False
End Sub

Private Sub cmdReset_Click()
Form_Load
End Sub



Private Sub inicio()
score = 0
paso = 1
lblPuntos = 0
lblFamas = 0
lblScore = 0
lblNumero = Empty
Randomize Timer
5: a = Int(Rnd * 10)
10: b = Int(Rnd * 10)
    If a = b Then GoTo 10
15: c = Int(Rnd * 10)
    If a = c Or b = c Then GoTo 15
20: d = Int(Rnd * 10)
    If a = d Or b = d Or c = d Then GoTo 20
End Sub




Private Sub Form_KeyPress(KeyAscii As Integer)
'Verifica si se pulsó la tecla ENTER
If cmdAceptar.Enabled = True Then
    If KeyAscii = 13 Then
        Call verificar
    End If
Else
    Exit Sub
End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    ' Se habilita el botón Aceptar sólo si todos los cuadros de texto _
    tienen datos
    Dim ControlAct As Control
    For Each ControlAct In Controls
    If TypeOf ControlAct Is TextBox Then
        If ControlAct.Text = "" Then ' El cuadro de texto está vacío
            cmdAceptar.Enabled = False
            Exit Sub
        End If
    End If
    Next
    cmdAceptar.Enabled = True 'Todos los cuadros de texto tienen datos
End Sub


Private Sub Form_Load()
cmdAceptar.Enabled = False
paso = 1
Call inicio
End Sub
Private Sub lblSalir_Click()
Unload Me
Unload frmAcercaDe

End Sub

Private Sub mnuAcercaDe_Click()
frmAcercaDe.Show
End Sub

Private Sub mnuComo_Click()
txtAyuda.Visible = True: cmdCerrarAyuda.Visible = True
txtAyuda = "El Juego consiste en adivinar un número de 4 cifras que selecciona aleatoriamente el computador; para adivinarlo se suministran dos pistas que son: Los Puntos y Las Famas." & vbCrLf & "Se obtiene un PUNTO cuando hay una cifra de tú número que se encuentra en el número oculto del computador pero en distinto orden; y se obtiene una FAMA cuando alguna cifra coincide exactamente en el mismo orden del número del computador" & vbCrLf & " Ejemplo: Si el número oculto del computador es: 4263 y tu digitas 2861 obtienes una fama y un punto; ya que el 2 está en la casilla incorrecta (punto) y el 6 en la posición correcta (fama) Sólo tienes 10 Intentos Mucha Suerte"


End Sub

Private Sub mnuSalir_Click()
Unload Me
Unload frmAcercaDe
End Sub

Private Sub pctSalir_Click()
Unload Me
Unload frmAcercaDe

End Sub

Private Sub txt_Change(Index As Integer)
If txt(Index) <> "" Then
    If Index < 3 Then
 SendKeys "{tab}"
     Else
        txt(Index).SetFocus
    End If
End If
End Sub

Private Sub txt_GotFocus(Index As Integer)
'Selecciona el text que recibe el foco
Select Case Index
    Case 0
    txt(0).SelStart = 0
    txt(0).SelLength = Len(txt(0))
    Case 1
    txt(1).SelStart = 0
    txt(1).SelLength = Len(txt(1))
    Case 2
    txt(2).SelStart = 0
    txt(2).SelLength = Len(txt(2))
    Case 3
    txt(3).SelStart = 0
    txt(3).SelLength = Len(txt(3))
End Select
End Sub

Private Sub txt_KeyPress(Index As Integer, KeyAscii As Integer)
'Para que solo se introduzcan números
If KeyAscii <> 8 Then
    If KeyAscii < 48 Or KeyAscii > 57 Then
        KeyAscii = 0
    End If
End If
End Sub

Private Sub Timer1_Timer()
'Scroll del caption del form
    mensaje$ = "Bejarano's Programs"
    
    i = i + 1
    Cadena$ = Mid(mensaje, i, 1)
    frmPuntos.Caption = frmPuntos.Caption & Cadena$
    If i > 19 Then
        i = 0
        frmPuntos.Caption = "Punto y Fama           "
    End If
End Sub

Download me
Autor: mastervisual
1 proyectos 0 seguidores 0 siguiendo

COMENTARIOS
Para publicar un comentario debes