Mensajes

muchas gracias, ahora me lo leo!

ya lo lei pero no me ayuda de nada... yo ya se como despejar x jaja pero no se como hacer para que el programa me lo haga solo

[Juego de los Clicks by hAcKeR92]

Juego de los Clicks by hAcKeR92


Aqui os dejo mi ultima creacion, decidme sugerencias para que pueda ir haciendo cosas mas elaboradas.

http://www.megaupload.com/?d=X4NCUK0K

Codigo:

FORM1

Código [Seleccionar] Expandir



Option Explicit
Dim s, record, ns, ns2

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1

Dim arreglo

Private Declare Function mciExecute _
   Lib "winmm.dll" ( _
       ByVal lpstrCommand As String) As Long


Function GetKeyValue(ByVal hKey As Long, ByVal path As String, ByVal Value As String) As String
   Dim Result As Long
   Dim vType As Long
   Dim Buffer As String
   Dim bSize As Long
   Dim subKey As Long
   Result = RegOpenKey(hKey, path, subKey&)
   Result = RegQueryValueEx(subKey&, Value, 0&, vType, ByVal 0&, bSize)
   If Result = ERROR_SUCCESS And vType = REG_SZ Then
       Buffer = String(bSize, Chr(0))
       Result = RegQueryValueEx(subKey&, Value, 0&, 0&, ByVal Buffer, bSize)
       If Result = ERROR_SUCCESS Then
           GetKeyValue = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
       End If
   End If
   Result = RegCloseKey(subKey&)
End Function

Private Sub Nuevo_Record()
ns = Label1.Caption

If Len(ns) > 1 Then
ns2 = Split(ns, ",")
ns = ns2(0) & "." & ns2(1)
End If

Dim a1
a1 = InputBox("Enhorabuena, has superado el record." & Chr(13) & Chr(13) & "Como te llamas?", "Has superado el record")
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Record1 /t REG_SZ /d " & Chr(34) & ns & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Jugador1 /t REG_SZ /d " & Chr(34) & a1 & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Fecha1 /t REG_SZ /d " & Chr(34) & Date & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Hora1 /t REG_SZ /d " & Chr(34) & Time & Chr(34) & " /f"), vbHide

Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."

limpieza
End Sub

Private Sub Start_Count()
Timer1.Interval = "100"
Timer1.Enabled = True
End Sub
Sub limpieza()
s = ""
ns = ""
Label1.Caption = ""
End Sub
Private Sub End_Count()
Timer1.Enabled = False
record = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1")
ns = Label1.Caption

If record = "" Then record = "Ninguno"


MsgBox "El tiempo transcurrido es de " & ns & " segundos." & Chr(13) & Chr(13) & "ENHORABUENA!" & Chr(13) & Chr(13) & "Record actual: " & record & Chr(13) & Chr(13) & "Tu tiempo: " & ns & " segundos.", vbInformation, "Enhorabuena"


If Val(ns) > 10 Or Val(ns) = 10 Then
limpieza
Exit Sub '10 segundos es mucho tiempo
End If
''''''''''''''''
''''''''''''''''
''''''''''''''''
If Len(ns) > 1 Then 'escribe ns como dos numeros, el x y el y siendo ns: x.y
ns2 = Split(ns, ",")
ns = ns2(0) & "." & ns2(1)
End If

If Len(record) > 1 Then 'escribe record como dos numeros, el x y el y siendo record: x.y
Dim d_record
d_record = Split(record, ".")
End If
''''''''''''''''
''''''''''''''''
''''''''''''''''




If record = "Ninguno" Then
Nuevo_Record
limpieza
Exit Sub
End If

If Len(record) > 1 And Len(ns) > 1 Then 'caso de que los dos son de 2 cifras

If Val(d_record(0)) > Val(ns2(0)) Then
Nuevo_Record
limpieza
Exit Sub
End If

If Val(d_record(0)) = Val(ns2(0)) Then 'hay que comprobar la cifra 2, la decimal
If Val(d_record(1)) > Val(ns2(1)) Then
Nuevo_Record
limpieza
Exit Sub
Else
limpieza
Exit Sub 'el tiempo es igual, no hay record
End If
End If

Else 'no hay posibilidad de nuevo record

limpieza
Exit Sub

End If 'Termina el caso de que sea record = x.y   --    ns = x.y

If Len(record) > 1 And Len(ns) = 1 Then
If Val(d_record(0)) > Val(ns) Then Nuevo_Record: limpieza: Exit Sub
If Val(d_record(0)) < Val(ns) Then limpieza: Exit Sub
If Val(d_record(0)) = Val(ns) Then Nuevo_Record: limpieza: Exit Sub
End If 'termina caso de que record es x.y cuando ns es de 1 cifra

If Len(record) = 1 And Len(ns) > 1 Then
If Val(ns2(0)) < Val(record) Then Nuevo_Record: limpieza: Exit Sub
If Val(ns2(0)) > Val(record) Or Val(ns2(0)) = Val(record) Then limpieza: Exit Sub 'el tiempo es igual, no hay record
End If 'termina el caso record x siendo ns x.y

If Len(record) = 1 And Len(ns) = 1 Then
If Val(record) > Val(ns) Then Nuevo_Record: limpieza: Exit Sub Else limpieza: Exit Sub
End If 'caso normal, record es numero entero y ns tambien

limpieza 'por si me dejo algun caso :P
End Sub

Private Sub Command1_Click() 'empieza el juego
Command1.Visible = False
Command13.Visible = False
Command14.Visible = False
Label2.Caption = "3"
Timer3.Enabled = True
If Existe("ptd.wav") = "si" Then mciExecute "Play ptd.wav"
End Sub

Private Sub Command13_Click() 'borrar record
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Record1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Jugador1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Fecha1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Hora1 /f"), vbHide
End Sub

Private Sub Command14_Click() 'ver record
If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
MsgBox "No hay ningun record", vbInformation, "Record en blanco"
Else
MsgBox "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "." & Chr(13) & Chr(13) & "El Record fue relizado el dia: " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Fecha1") & " a las " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Hora1"), vbInformation, "Record Actual"
End If
End Sub

Private Sub Command2_Click()
Command3.Visible = True
Command2.Visible = False
Timer2.Enabled = True
End Sub
Private Sub Command3_Click()
Command4.Visible = True
Command3.Visible = False
End Sub
Private Sub Command4_Click()
Command5.Visible = True
Command4.Visible = False
End Sub
Private Sub Command5_Click()
Command6.Visible = True
Command5.Visible = False
End Sub
Private Sub Command6_Click()
Command7.Visible = True
Command6.Visible = False
End Sub
Private Sub Command7_Click()
Command8.Visible = True
Command7.Visible = False
End Sub
Private Sub Command8_Click()
Command9.Visible = True
Command8.Visible = False
End Sub
Private Sub Command9_Click()
Command10.Visible = True
Command9.Visible = False
End Sub
Private Sub Command10_Click()
Command11.Visible = True
Command10.Visible = False
End Sub
Private Sub Command11_Click()
Command12.Visible = True
Command11.Visible = False
Timer2.Enabled = False
End Sub

Private Sub Command12_Click() 'ultimo boton del juego
End_Count
Command12.Visible = False
Command1.Visible = True
Command13.Visible = True
Command14.Visible = True
Label3.Visible = True
End Sub

Private Sub Form_Load()

With Form1
.BorderStyle = 1
.BackColor = RGB(0, 0, 0)
.Caption = "Juego de los Clicks"
End With

With Label1
.BackColor = RGB(0, 0, 0)
.ForeColor = RGB(255, 0, 0)
.Caption = ""
End With

Dim Objeto As Object, Objeto2 As Object
For Each Objeto In Controls
If TypeOf Objeto Is CommandButton Then
Objeto.Caption = "CLICK"
If Objeto.Name = "Command1" Then Objeto.Caption = "Empezar Juego"
If Objeto.Name = "Command13" Then Objeto.Caption = "Borrar Record"
If Objeto.Name = "Command14" Then Objeto.Caption = "Ver Records"
End If
Next Objeto

For Each Objeto2 In Controls
If TypeOf Objeto2 Is CommandButton Then
If Objeto2.Caption = "CLICK" Then Objeto2.Visible = False
End If
Next Objeto2

Timer2.Interval = 100: Timer2.Enabled = False

Label2.ForeColor = vbRed: Label2.BackColor = vbBlack: Label2.FontSize = "70": Label2.FontBold = True: Label2.Font = "Arial": Label2.Caption = ""

Timer3.Interval = 1000: Timer3.Enabled = False

Label3.Caption = "Record actual: ": Label3.ForeColor = vbWhite: Label3.BackColor = vbBlack: Label3.FontBold = True

If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
Label3.Caption = "No hay ningun record actualmente en este PC. Puedes ser tu el primero!!"
Else
Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."
End If

Timer4.Interval = 1000: Timer4.Enabled = True

Label4.Caption = "hAcKeR92": Label4.ForeColor = vbYellow: Label4.BackColor = vbBlack

End Sub





Private Sub Timer1_Timer()
If s = "" Then s = 0
ns = s / 1000
s = Val(s + 100)
Label1.Caption = ns
If Val(ns) < "5" Then Label1.ForeColor = RGB(232, 158, 43)
If Val(ns) = "5" Or Val(ns) > "5" Then Label1.ForeColor = vbGreen
If Val(ns) > "7" Then Label1.ForeColor = vbRed
End Sub


Private Sub Timer2_Timer() 'para evitar trampas pulsando enter o space
If arreglo = "" Then arreglo = "0"
Dim Tecla As String
Dim x%
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x) 'obtener tecla pulsada
If Tecla = "[ENTER]" Or Tecla = "[SPACE]" Then
arreglo = Val(arreglo + 1)
End If
If Val(arreglo) = 2 Or Val(arreglo) > 2 Then
s = ""
ns = ""
Label1.Caption = ""
MsgBox "Has pulsado " & Tecla & " en un momento no apropiado. Se considerara como una trampa", vbExclamation, "Se pulso " & Tecla
Timer2.Enabled = False
Timer1.Enabled = False
arreglo = ""
Form2.Show
Unload Form1
Exit Sub
End If
End If
Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form1
mciExecute "Close All"
End Sub

Private Sub Timer3_Timer()
Label2.Caption = Val(Label2.Caption) - 1
If Val(Label2.Caption) <= 0 Then
Timer3.Enabled = False
Label2.Caption = ""
Label3.Visible = False
Start_Count
Command2.Visible = True
If Existe("lstptd.wav") = "si" Then mciExecute "Play lstptd.wav"
Else
If Existe("ptd.wav") = "si" Then mciExecute "Play ptd.wav"
End If
End Sub

Private Sub Timer4_Timer()
If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
Label3.Caption = "No hay ningun record actualmente en este PC. Puedes ser tu el primero!!"
Else
Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."
End If
End Sub



FORM2

Código [Seleccionar] Expandir



Option Explicit

Private Sub Command1_Click()
Unload Form1
Load Form1
Form1.Show
Unload Form2
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form2
mciExecute "Close All"
End Sub

Private Sub Form_Load()
With Form2
.Caption = "Juego de los Clicks[Se han detectado trampas]"
.BackColor = vbBlack
'Propiedad borderstyle en 1
End With
Command1.Caption = "Volver a intentar"
With Label1
.Caption = "Estas aqui por presionar enter o la barra espaciadora cuando no debias."
.BackColor = vbBlack
.ForeColor = vbRed
.FontBold = True
End With
End Sub





MODULO1

Código [Seleccionar] Expandir



Option Explicit

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Sub musica(comando As String, path As String)
mciExecute comando & path
End Sub

Function ObtenerTecla(x As Integer)
Dim Tecla As String
Select Case x
Case 13
Tecla = "[ENTER]"
Case 32
Tecla = "[SPACE]"
End Select
ObtenerTecla = Tecla
End Function


Function Existe(archivo)
Dim x
On Error GoTo Fallo
x = GetAttr(archivo)
Existe = "si"
Exit Function
Fallo:
Existe = "no"
End Function




muchas gracias, ahora me lo leo!

esa respuesta no me la esperaba.. pero supongo que constante jaja

yo la voy a tratar como si fuera de un problema sencillito de matematicas

enhorabuena! tu primer programa 

ahora sigue con mas retos nuevos!

hola a todos!

alguno me puede ayudar a operar con varias incognitas??

por ejemplo hacer 3x + 4x = 7x

el problema esta en que si no asigno ningun valor a x me da siempre 0 porque es el valor por defecto de x y yo quiero que no se sepa el valor de x y te lo de en funcion de x..

muchas gracias

IMPRESIONANTE!

gran trabajo

y en VB!!!!!!

Woow que currada jajjaa

habra que probarlo

Mira esto

Código [Seleccionar] Expandir


Private Sub Command1_Click()
Dim x As Integer
For x = 0 To List1.ListCount
    If List1.List(x) = "dedo" Then
        MsgBox "Aki Toy"
    End If
Next x
End Sub


Gracias! me sirvio este codigo para adaptarlo a mi formulario

PERDON!

solucione el problema!

poniendo un With lo solucione:

With FormN
TextN.Text = Replace(TextN.Text, "palabraantigua", "nuevapalabra")
End With