Título: Simple juego
Publicado por: vivachapas en 7 Noviembre 2008, 22:35 pm
bueno... este proyecto surgio creo q caudno intentaba acelerar el envio de capturas de pantalla de mi troyano.. y termino en esto xD jaja nada q ver antes q nada decir q el codigo es 100% mio.. y q si se matan buscando similitudesen internet seguro encuentran algo ya q de ahi aprendo... pero lo hice yo a todo.. ¬¬ (para las malas lenguas) dejo un link de descarga del Source: http://rapidshare.com/files/162287705/Simple_Juego.rar.html bueno les dejo el code: Un Form con: un timer = Timer1 un Picture = Picture1 un menu titulo Configuracion = mnu sub menu titulo Tamaño = mnu_tam sub menu titulo Cantidad de Obstaculos = mnu_obs en un modulo 'Sencillo Juego Creado Por Vivachapas 'Si estas leyendo este codigo mas vale q lo hayas 'bajado del http://foro.elhacker.net , sino es copiado ¬¬ Public NumObs As Long, Ini As Long Public Direccion As Byte Public MX As Long, MY As Long Public PX As Long, PY As Long Public CS As Byte Public X As Long, Y As Long Sub Tabla() Dim i As Long Gano Form1.Picture1.Line ((X - 1) * CS, (Y - 1) * CS)-(X * CS, Y * CS), vbRed, BF Form1.Picture1.Line (PX * CS, PY * CS)-((PX + 1) * CS, (PY + 1) * CS), vbGreen, BF For i = 0 To X Form1.Picture1.Line (i * CS, 0)-(i * CS, Y * CS), vbBlack Next i For i = 0 To Y Form1.Picture1.Line (0, i * CS)-(X * CS, i * CS), vbBlack Next i End Sub Function Dentro() As Boolean Dentro = True If MX >= X Then Dentro = False MX = MX - 1 End If If MY >= Y Then Dentro = False MY = MY - 1 End If If MX < 0 Then Dentro = False MX = MX + 1 End If If MY < 0 Then Dentro = False MY = MY + 1 End If End Function Sub Mueve() Form1.Picture1.Line (PX * CS, PY * CS)-((PX + 1) * CS, (PY + 1) * CS), vbWhite, BF PX = MX PY = MY Tabla End Sub Sub Perdio() Direccion = 0 MsgBox "Perdio", , "Agus" NumObs = Ini Reset End Sub Sub Reset() Form1.Picture1.Cls Direccion = 0 PX = 0 PY = 0 MX = 0 MY = 0 Obstaculos (NumObs) Titulo End Sub Sub Gano() If Form1.Picture1.Point(PX * CS + 1, PY * CS + 1) = vbRed Then MsgBox "Gano", , "Agus" NumObs = Int(NumObs * 120 / 100) Reset End If End Sub Sub Obstaculos(ByVal Cantidad As Long) Randomize Dim i As Long Dim OX As Long, OY As Long For i = 1 To Cantidad OX = Int(Rnd * X) OY = Int(Rnd * Y) Form1.Picture1.Line (OX * CS, OY * CS)-((OX + 1) * CS, (OY + 1) * CS), vbBlue, BF Next i Tabla End Sub Sub Lugar() If Form1.Picture1.Point(MX * CS + 1, MY * CS + 1) = vbBlue Then Perdio End Sub Sub Titulo() Form1.Caption = "Agus - Obstaculos:" & NumObs End Sub
en el Form1 'Sencillo Juego Creado Por Vivachapas 'Si estas leyendo este codigo mas vale q lo hayas 'bajado del http://foro.elhacker.net , sino es copiado ¬¬ Private Sub Form_Load() PX = 0 PY = 0 Direccion = 0 Ini = 20 NumObs = Ini Titulo With Picture1 .Height = 5000 .Width = 5000 .AutoRedraw = True .BackColor = vbWhite .ScaleMode = 3 End With CS = 20 X = Int(Picture1.ScaleHeight / CS) Y = Int(Picture1.ScaleWidth / CS) Picture1.ScaleHeight = X * CS + 1 Picture1.ScaleWidth = Y * CS + 1 Obstaculos (Ini) Timer1.Interval = CS * 5 End Sub Private Sub mnu_obs_Click() a = InputBox("Ingrese el numero de obstaculos iniciales", "Agus") If a = "" Then Exit Sub If IsNumeric(a) Then Ini = a Else MsgBox "Debe ingresar un numero", vbCritical, "Agus" End If NumObs = Ini Titulo Reset End Sub Private Sub mnu_tam_Click() a = InputBox("Ingrese el tamaño", "Agus") If a = "" Then Exit Sub If IsNumeric(a) Then CS = a Else MsgBox "Debe ingresar un numero", vbCritical, "Agus" End If Picture1.Cls X = Int(Picture1.ScaleHeight / CS) Y = Int(Picture1.ScaleWidth / CS) Picture1.ScaleHeight = X * CS + 1 Picture1.ScaleWidth = Y * CS + 1 Timer1.Interval = CS * 5 Obstaculos (Ini) End Sub Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer) Dim Podra As Boolean Select Case KeyCode Case vbKeyRight If Direccion = 2 Then Perdio Exit Sub End If Direccion = 1 Case vbKeyLeft If Direccion = 1 Then Perdio Exit Sub End If Direccion = 2 Case vbKeyUp If Direccion = 4 Then Perdio Exit Sub End If Direccion = 3 Case vbKeyDown If Direccion = 3 Then Perdio Exit Sub End If Direccion = 4 End Select End Sub Private Sub Timer1_Timer() Dim Podra As Boolean Select Case Direccion Case 0 Exit Sub Case 1 MX = PX + 1 Case 2 MX = PX - 1 Case 3 MY = PY - 1 Case 4 MY = PY + 1 End Select Podra = Dentro Lugar If Podra = False Then Perdio Exit Sub End If Mueve End Sub
espero opiniones... SALUDOS P/D: Tamaño 5, con 100 Obstaculos es mi favorito...
Título: Re: Simple juego
Publicado por: Hans el Topo en 7 Noviembre 2008, 23:24 pm
las screens suelen avivar el interes :D
Título: Re: Simple juego
Publicado por: vivachapas en 8 Noviembre 2008, 00:10 am
fue si no lo quieren ver q no lo vean xD... ahora me estoy x ir no tengo tiempo de cargar las screen :S
Título: Re: Simple juego
Publicado por: seba123neo en 8 Noviembre 2008, 00:40 am
colgalo en otro servidor , porque la verdad es un desastre ese...
Título: Re: Simple juego
Publicado por: vivachapas en 8 Noviembre 2008, 01:12 am
hecho :P tb les dejo un screen :P
(http://s1.subirimagenes.com/otros/previo/thump_1415723dibujo.jpg)
Título: Re: Simple juego
Publicado por: seba123neo en 8 Noviembre 2008, 01:33 am
esta bueno :D, lo unico es tratar de que no se creen obstaculos alrededor del target rojo..porque seria imposible alcanzarlo...
saludos.
Título: Re: Simple juego
Publicado por: vivachapas en 8 Noviembre 2008, 01:46 am
jaja si... eso lo arregle.. el tema es q a veces cuando son muchos se enciarra tb pero con un cuadrado mayor :S y ya se complica mas para arregalr : /
Título: Re: Simple juego
Publicado por: el_c0c0 en 8 Noviembre 2008, 02:40 am
interesante =), muy bueno
saludos
Título: Re: Simple juego
Publicado por: ssccaann43 © en 8 Noviembre 2008, 04:49 am
Esta bueno... Lo puse en tamaño 10 y obstaculos 200. Pues termine loco che... No dormi bien viendo cuadritos :laugh:
Me gusto mucho... Saludos
Título: Re: Simple juego
Publicado por: CICOLO_111234 en 8 Noviembre 2008, 13:05 pm
buen aporte, vivachapas.
Título: Re: Simple juego
Publicado por: WestOn en 8 Noviembre 2008, 13:37 pm
Wenas, esta bien el juego jaja, hice lo que dijo ssccaann43 (yo tamaño 5 :P) y no pude ganar.. :laugh: un saludo
Título: Re: Simple juego
Publicado por: <[(x)]> en 10 Noviembre 2008, 00:07 am
jaja muy buena idea, estuve apunto de ganar unas cuantas veces pero se me hace dificil doblar al final :P en.
Ah y el link a rapidshare me da error.
saludos
Título: Re: Simple juego
Publicado por: vivachapas en 10 Noviembre 2008, 02:00 am
ahi lo solucione :P http://rapidshare.com/files/162287705/Simple_Juego.rar.html
|