|
Mostrar Mensajes
|
Páginas: [1] 2 3 4 5 6 7
|
2
|
Programación / Programación Visual Basic / Juego de los Clicks BY HACKER92
|
en: 20 Febrero 2010, 18:57 pm
|
Juego de los Clicks by hAcKeR92Aqui os dejo mi ultima creacion, decidme sugerencias para que pueda ir haciendo cosas mas elaboradas. http://www.megaupload.com/?d=X4NCUK0KCodigo: FORM1 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 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 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
|
|
|
6
|
Programación / Programación Visual Basic / operando con incognitas
|
en: 20 Febrero 2010, 14:47 pm
|
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
|
|
|
|
|
|
|