viernes, 25 de junio de 2010

Pedro Responde - Tarot Virtual:


Para los conocedores del funcionamiento de este simpatico programa, les dejo el codigo fuente en Visual Basic. net. En este caso ya no sera pedro quien te conteste las preguntas deseadas por que esta de vacaciones y dejo a su compañero Matias para responderte. como funciona el programa


Codigo Fuente:

Public Class FrmTarot
Dim peticion() As String = {"M", "a", "t", "i", "a", "s", " ", "p", "o", "r", " ", "f", "a", "v", "o", "r", " ", "r", "e", "s", "p", "o", "n", "d", "e", " ", "e", "s", "t", "a", " ", "p", "r", "e", "g", "u", "n", "t", "a"}

Dim tamaño As Integer = UBound(peticion) + 1
Dim borrar As Boolean = False
Dim texto As String = ""
Dim truco As Boolean = False

Dim RespuestasAlternas() As String = {"Tu ansiedad por probarme te hace escribir cualquier cosa, así nunca te responderé.", "La pregunta que has realizado no es válida.", "Por el momento no responderé.", "Sigue intentando.", "El tiempo todo lo responde."}

Dim texto2 As String = ""
Dim res As String = ""
Dim final As Boolean = False

Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TxtPeticion.KeyPress

Dim agregado As String
agregado = e.KeyChar

If TxtPeticion.Text = Nothing Then
borrar = False
texto = ""
truco = False
texto2 = ""
res = ""
final = False
End If

If Not (Char.IsControl(e.KeyChar)) Then
borrar = False
Else
If truco = True Then
If Len(res) > 1 Then
res = Microsoft.VisualBasic.Left(res, Len(res) - 1)
Else
res = ""
End If
End If
End If

If truco = True And borrar = False Then
res += agregado
End If

texto = CStr(TxtPeticion.Text)

If truco = True And agregado = "." Then
truco = False
final = True
ElseIf truco = False And agregado = "." Then
truco = True
End If

agregado = ""

If e.KeyChar = Chr(13) Then
TxtPregunta.Focus()
End If

End Sub

Private Sub TextBox1_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TxtPeticion.TextChanged

If borrar = False Then
If truco = True Or final = True Then
texto2 = Microsoft.VisualBasic.Left(texto, Len(texto))
TxtPeticion.Text = texto2 & peticion(Len(texto2))
final = False
TxtPeticion.SelectionStart = Len(TxtPeticion.Text)
End If
borrar = True
End If

End Sub

Private Sub BtnOk_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOk.Click

If TxtPeticion.Text.ToUpper = "MATIAS POR FAVOR RESPONDE ESTA PREGUNTA" Or TxtPeticion.Text.ToUpper = "MATIAS POR FAVOR RESPONDE" Then

If res = "" Then
Dim value As Integer = CInt(Int((UBound(RespuestasAlternas) * Rnd()) + 1))
lblres.Text = RespuestasAlternas(value).ToUpper
Else
lblres.Text = Microsoft.VisualBasic.Left(res, Len(res) - 1).ToUpper
End If
Else
lblres.Text = "Pregunta o Peticion no Valida"
Exit Sub
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

TxtPeticion.MaxLength = tamaño

End Sub

Private Sub TxtPregunta_Enter(ByVal sender As Object, ByVal e As System.EventArgs) Handles TxtPregunta.Enter

If TxtPeticion.Text <> Nothing Then
TxtPeticion.ReadOnly = True
End If

End Sub

Private Sub TxtPregunta_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TxtPregunta.KeyPress

If e.KeyChar = Chr(13) Or e.KeyChar = "?" Then
BtnOk.PerformClick()
End If

End Sub



Private Sub BtnNuevo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnNuevo.Click

lblres.Text = Nothing
TxtPeticion.ReadOnly = False
TxtPeticion.Text = Nothing
TxtPregunta.Text = Nothing
borrar = False
texto = ""
truco = False
texto2 = ""
res = ""
final = False

End Sub

Private Sub Label7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label7.Click

Application.Exit()

End Sub

End Class

No hay comentarios:

Publicar un comentario en la entrada