Mensajes

fue si no lo quieren ver q no lo vean xD... ahora me estoy x ir no tengo tiempo de cargar las screen :S

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

Código (vb) [Seleccionar] Expandir

'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

Código (vb) [Seleccionar] Expandir

'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...

mmmm me parece q hiciste un ALTO copy paste xD

no se mi consejo es q te leas un manual.. y no empiezes con cosas tan dificiles...
lo q queres hacer es una pavada xD... y no puede ser q si hiciste el code de antes no te salga eso! :S

SALUDOS

mmm donde lo analisaste? es probable a ahora todos lo detecten XD

este post ya tenia 11 dias xD... de todos modos la mejor forma es poner en stylus el modo imagen... creo q era ese... luego diseñar una imagen q la parte q queres q no este la pones en un color x ejemplo verde y luego con un clase q ahora no tengo el nombre para fijarme como era le quitas todo lo q tenga ese color y te queda el form irregual o de la forma q queiras...

si alguno lo necesita lo busco y lo posteo

si a mi tb me cuesta mucho entenderlo xD... me gustaria q lo expliques :P

muy muy bueno... nunca habia visto algo asi (excepto en el protector de pantalla claro xD)

lo q quiere hacer es reemplazar el 1000 x la letra A.. es muy facil, se hace con la funcion Remplace

Código [Seleccionar] Expandir

Text1.Text = Replace(Text1.Text, "1000", "A")

SALUDOS

mmmm no creo... a menos q una vez compilado le cambies el icono... yo alguna vez use un programa... es muy conocido creo q se llamaba ResHacker.. con ese si ya le podes cambiar el icono al q quieras...
sino la unica solucion es hacer uno en 16 bits

el icono debe tener (no me acuerdo bien la verdad xD) 35x35 pixeles y estan en 16 bits de colores

no se si el q intentas poner cumple con eso...