elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado:


  Mostrar Mensajes
Páginas: 1 2 3 4 [5] 6 7 8
41  Programación / Programación Visual Basic / Bug en "MI" jueguito en: 6 Noviembre 2010, 23:33 pm
Bueno antes que nada pongo "MI" jueguito porque en realidad yo solo toke una parte xd.

bueno, vamos al grano:

miren, ya no recuerdo de donde, baje el codigo de un laberinto, y como me gusto mucho la idea,lo modifique:

Miren el original:

Código
  1. Option Explicit
  2.  
  3. ' The maze information.
  4. Private NumRows As Integer
  5. Private NumCols As Integer
  6. Private LegalMove() As Boolean
  7.  
  8. ' The size of a square.
  9. Private Const SQUARE_WID = 20
  10. Private Const SQUARE_HGT = 20
  11.  
  12. ' The player's position.
  13. Private PlayerR As Integer
  14. Private PlayerC As Integer
  15.  
  16. ' The end position.
  17. Private RFinish As Integer
  18. Private CFinish As Integer
  19.  
  20. Private StartTime As Single
  21.  
  22. ' Look for movement keys.
  23. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  24. Dim r As Integer
  25. Dim c As Integer
  26.  
  27.    r = PlayerR
  28.    c = PlayerC
  29.    Select Case KeyCode
  30.        Case vbKeyLeft
  31.            c = PlayerC - 1
  32.        Case vbKeyRight
  33.            c = PlayerC + 1
  34.        Case vbKeyDown
  35.            r = PlayerR + 1
  36.        Case vbKeyUp
  37.            r = PlayerR - 1
  38.        Case Else
  39.            Exit Sub
  40.    End Select
  41.  
  42.    If LegalMove(r, c) Then PositionPlayer r, c
  43. End Sub
  44.  
  45. ' Initialize the maze and player.
  46. Private Sub Form_Load()
  47.    ScaleMode = vbPixels
  48.    AutoRedraw = True
  49.    picPlayer.Visible = False
  50.  
  51.    ' Initialize the maze.
  52.    LoadMaze
  53. End Sub
  54.  
  55. ' Draw the maze.
  56. Private Sub DrawMaze()
  57. Dim r As Integer
  58. Dim c As Integer
  59. Dim clr As Long
  60.  
  61.    ' Start from scratch.
  62.    Cls
  63.  
  64.    For r = 1 To NumRows
  65.        For c = 1 To NumCols
  66.            If LegalMove(r, c) Then
  67.                If r = RFinish And c = CFinish Then
  68.                    clr = vbYellow
  69.                Else
  70.                    clr = vbWhite
  71.                End If
  72.            Else
  73.                clr = RGB(128, 128, 128)
  74.            End If
  75.            Line (c * SQUARE_WID, r * SQUARE_HGT)-Step(-SQUARE_WID, -SQUARE_HGT), clr, BF
  76.        Next c
  77.    Next r
  78. End Sub
  79.  
  80.  
  81. ' Initialize the maze.
  82. Private Sub LoadMaze()
  83. Dim fnum As Integer
  84. Dim r As Integer
  85. Dim c As Integer
  86. Dim ch As String
  87. Dim row_info As String
  88.  
  89.    ' Open the maze file.
  90.    fnum = FreeFile
  91.    Open App.Path & "\maze.dat" For Input As #fnum
  92.  
  93.    ' Read the number of rows and columns.
  94.    Input #fnum, NumRows, NumCols
  95.    ReDim LegalMove(1 To NumRows, 1 To NumCols)
  96.  
  97.    ' Read the data.
  98.    For r = 1 To NumRows
  99.        Line Input #fnum, row_info
  100.        For c = 1 To NumCols
  101.            ch = Mid$(row_info, c, 1)
  102.            LegalMove(r, c) = (ch <> "#")
  103.            If LCase$(ch) = "s" Then
  104.                ' It's the start.
  105.                PlayerR = r
  106.                PlayerC = c
  107.            ElseIf LCase$(ch) = "f" Then
  108.                ' It's the finish.
  109.                RFinish = r
  110.                CFinish = c
  111.            End If
  112.        Next c
  113.    Next r
  114.  
  115.    ' Close the file.
  116.    Close #fnum
  117.  
  118.    ' Size the form.
  119.    Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
  120.        Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
  121.    Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
  122.        Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)
  123.  
  124.    ' Draw the maze.
  125.    DrawMaze
  126.  
  127.    ' Position the player.
  128.    PositionPlayer PlayerR, PlayerC
  129.  
  130.    ' Save the start time.
  131.    StartTime = Timer
  132. End Sub
  133.  
  134. ' Draw the player.
  135. Private Sub PositionPlayer(r As Integer, c As Integer)
  136. Dim x As Single
  137. Dim y As Single
  138.  
  139.    ' Erase the player's old position.
  140.    If PlayerR > 0 Then
  141.        x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
  142.        y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
  143.        Line (x - 1, y - 1)-Step(picPlayer.Width, picPlayer.Height), vbWhite, BF
  144.    End If
  145.  
  146.    ' Move the player.
  147.    PlayerR = r
  148.    PlayerC = c
  149.  
  150.    ' Draw the player.
  151.    x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
  152.    y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
  153.    PaintPicture picPlayer.Picture, x, y
  154.  
  155.    ' See if the player reached the finish.
  156.    If r = RFinish And c = CFinish Then
  157.        If MsgBox("You finished in " & _
  158.            Int(Timer - StartTime) & " seconds." & _
  159.            vbCrLf & "Play again?", vbYesNo, _
  160.            "Congratulations") = vbYes _
  161.        Then
  162.            Form_Load
  163.        Else
  164.            Unload Me
  165.        End If
  166.    End If
  167. End Sub
  168.  
  169.  

Version sebah97

Código
  1. Option Explicit
  2.  
  3. ' The maze information.
  4. Private NumRows As Integer
  5. Private NumCols As Integer
  6. Private LegalMove() As Boolean
  7.  
  8. ' The size of a square.
  9. Private Const SQUARE_WID = 20
  10. Private Const SQUARE_HGT = 20
  11.  
  12. ' The player's position.
  13. Private PlayerR As Integer
  14. Private PlayerC As Integer
  15.  
  16. ' The end position.
  17. Private RFinish As Integer
  18. Private CFinish As Integer
  19.  
  20. Private StartTime As Single
  21. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  22. Dim r As Integer
  23. Dim c As Integer
  24.  
  25.    r = PlayerR
  26.    c = PlayerC
  27.    Select Case KeyCode
  28.        Case vbKeyLeft
  29.            c = PlayerC - 1
  30.        Case vbKeyRight
  31.            c = PlayerC + 1
  32.        Case vbKeyDown
  33.            r = PlayerR + 1
  34.        Case vbKeyUp
  35.            r = PlayerR - 1
  36.        Case Else
  37.            Exit Sub
  38.    End Select
  39.  
  40.    If LegalMove(r, c) Then PositionPlayer r, c
  41. End Sub
  42.  
  43. ' Initialize the maze and player.
  44. Private Sub Form_Load()
  45.    ScaleMode = vbPixels
  46.    AutoRedraw = True
  47.    picPlayer.Visible = False
  48.  
  49.    ' Initialize the maze.
  50.    LoadMaze
  51. End Sub
  52.  
  53. ' Draw the maze.
  54. Private Sub DrawMaze()
  55. Dim r As Integer
  56. Dim c As Integer
  57. Dim Tile As String
  58.  
  59.    ' Start from scratch.
  60.    Cls
  61.  
  62.    For r = 1 To NumRows
  63.        For c = 1 To NumCols
  64.            If LegalMove(r, c) Then
  65.                If r = RFinish And c = CFinish Then
  66.                    EsLlegada c * SQUARE_HGT, r * SQUARE_WID
  67.                Else
  68.                     EsCamino c * SQUARE_HGT, r * SQUARE_WID
  69.                End If
  70.            Else
  71.                 EsPared c * SQUARE_HGT, r * SQUARE_WID
  72.            End If
  73.  
  74.        Next c
  75.    Next r
  76. End Sub
  77.  
  78.  
  79. ' Initialize the maze.
  80. Private Sub LoadMaze()
  81. Dim fnum As Integer
  82. Dim r As Integer
  83. Dim c As Integer
  84. Dim ch As String
  85. Dim row_info As String
  86.  
  87.    ' Open the maze file.
  88.    fnum = FreeFile
  89.    Open App.Path & "\maze.dat" For Input As #fnum
  90.  
  91.    ' Read the number of rows and columns.
  92.    Input #fnum, NumRows, NumCols
  93.    ReDim LegalMove(1 To NumRows, 1 To NumCols)
  94.  
  95.    ' Read the data.
  96.    For r = 1 To NumRows
  97.        Line Input #fnum, row_info
  98.        For c = 1 To NumCols
  99.            ch = Mid$(row_info, c, 1)
  100.            LegalMove(r, c) = (ch <> "#")
  101.            If LCase$(ch) = "s" Then
  102.                ' It's the start.
  103.                PlayerR = r
  104.                PlayerC = c
  105.            ElseIf LCase$(ch) = "f" Then
  106.                ' It's the finish.
  107.                RFinish = r
  108.                CFinish = c
  109.            End If
  110.        Next c
  111.    Next r
  112.  
  113.    ' Close the file.
  114.    Close #fnum
  115.  
  116.    ' Size the form.
  117.    Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
  118.        Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
  119.    Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
  120.        Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)
  121.  
  122.    ' Draw the maze.
  123.    DrawMaze
  124.  
  125.    ' Position the player.
  126.    PositionPlayer PlayerR, PlayerC
  127.  
  128.    ' Save the start time.
  129.    StartTime = Timer
  130. End Sub
  131.  
  132. ' Draw the player.
  133. Private Sub PositionPlayer(r As Integer, c As Integer)
  134. Dim x As Single
  135. Dim y As Single
  136.  
  137.    ' Erase the player's old position.
  138.    If PlayerR > 0 Then
  139.        x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
  140.        y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
  141.        Actualizar
  142.    End If
  143.  
  144.    ' Move the player.
  145.    PlayerR = r
  146.    PlayerC = c
  147.  
  148.    ' Draw the player.
  149.    x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
  150.    y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
  151.    PaintPicture picPlayer.Picture, x, y
  152.  
  153.    ' See if the player reached the finish.
  154.    If r = RFinish And c = CFinish Then
  155.        If MsgBox("You finished in " & _
  156.            Int(Timer - StartTime) & " seconds." & _
  157.            vbCrLf & "Play again?", vbYesNo, _
  158.            "Congratulations") = vbYes _
  159.        Then
  160.            Form_Load
  161.        Else
  162.            Unload Me
  163.        End If
  164.    End If
  165. End Sub
  166.  
  167. Sub EsCamino(x, y)
  168. Me.PaintPicture Picture1, x, y, 20, 20
  169. End Sub
  170. Sub EsLlegada(x, y)
  171.   Me.PaintPicture Picture3, x, y, 20, 20
  172. End Sub
  173. Sub EsPared(x, y)
  174.   Me.PaintPicture Picture2, x, y, 20, 20
  175. End Sub
  176.  
  177. Sub Actualizar()
  178. Form1.Cls
  179. DrawMaze
  180. End Sub
  181.  
  182.  

Si se dan cuenta, cambié, que en vez de que el camino sea un cuadradito blanco, y la pared sea un cuadrado gris, cambie para que con PaintPicture, dibuje texturas, bien eso funciona a la perfección.

pero el problema está en que están "corridas" las texturas.Por ejemplo, en la fila 2 hay camino y en la fila 1 hay pared,pero al momento de jugar el personaje se ve caminando sobre la fila 1, pero enrealidad esta caminando en la fila 2....


ojala que me puedan entender y ayudar...

Saludos y Gracias de Antemano
42  Programación / Programación Visual Basic / [AYUDA] Dibujar Punto en medio de la pantalla en: 1 Octubre 2010, 20:10 pm
Hola, bueno como dice el título.. Algien me podria ayudar??

Lo que quiero hacer es crear una mira para el Counter Strike (Seguramente lo Conocen),y al dibujar el punto que no moleste en NADA, osea como si fuera una manchita en el monitor (a lo que me refiero es que puedas cliquear x la zona donde está el punto).

Espero que me puedan ayudar.... Gracias de antemano

sebah97
43  Programación / Programación Visual Basic / [Ayuda] Mostrar lo que estoy escuchando en un Form en: 5 Septiembre 2010, 02:37 am
Como dice el título, eh buscado, pero solamente dice para mostrar en el MSN lo que estoy haciendo yo, osea un ej:

Si Tengo el form1 habierto que en el msn diga "FOrmulario 1 Abierto" o algo asi xD.

Pero lo que quiero yo es en MI formulario mostrar lo que se está escuchando, x ejemplo con el Ares, winamp, etc
44  Programación / Programación Visual Basic / Re: [Ayuda] TileMap (Parallax Scrolling) en: 31 Julio 2010, 02:23 am
Gracias, Funcionó, nosé que hacia de mal yo xD.

Pero ahora surgio otro problema, yo tengo la propiedad STRETCH del image en TRUE, pero cuando la guardo, osea se genera como la foto original, y yo quisiera que la guarde tal como se ve en el control (Osea con el mismo tamaño del Control Image).

Espero que me entiendan, y gracias de antemano
45  Programación / Programación Visual Basic / Re: [Ayuda] TileMap (Parallax Scrolling) en: 31 Julio 2010, 01:48 am
Hola BlackZeroX, gracias por responder, pero creo que me expresé Mal.

Lo que quiero yo es Guardar el Picture de un Control IMAGE, en el disco, intente con SavePicture, pero no anda.
46  Programación / Programación Visual Basic / Re: [Ayuda] TileMap (Parallax Scrolling) en: 30 Julio 2010, 04:37 am
Hola, Gracias a todos, ya solucioné el tema del Parallax.

Bien, Ya que estamos, para no crear otro tema, Como hago para Guardar el Contenido de un  IMAGE ?? (No Confundan con PictureBox !! )

Bien, gracias y espero que Respuestas.

Desde ya Muchas gracias
47  Programación / Programación Visual Basic / Re: [Ayuda] TileMap (Parallax Scrolling) en: 27 Julio 2010, 06:56 am
.
Es mucho mejor con Apis... pero si es muy serio entonces seria con DirectX y/o OpenGL!¡.

Dulces Lunas!¡.

Si, tenes razon, es mejor con OpenGl o DirectX, pero yo quiero empezar por asi decirlo "UN MOTOR" (SI así se le puede llamar) desde 0  :xD

Y Con Respecto al Parallax Scrolling, no lo pude hacer funcionar :(

Una idea mia era cargar todo el mapa en la memoria, y a medida que aprieto tal tecla, lo ba mostrando de a partes.

Pero nose si funciona, y si funcionara, no sabría como hacerlo  :-\
48  Programación / Programación Visual Basic / Re: [Ayuda] TileMap (Parallax Scrolling) en: 27 Julio 2010, 02:44 am
Hola, primero que nada gracias por responder, pero probé el código y no me funciona :S

Algien tiene otra idea ??
49  Programación / Programación Visual Basic / [Ayuda] TileMap (Parallax Scrolling) en: 27 Julio 2010, 00:57 am
Hola, eh intentado crear un tilemap y lo eh conseguido (Dejo el Código)

Código
  1. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  2. Private Const SRCCOPY = &HCC0020
  3. Private Const SRCERASE = &H440328
  4. Private Const SRCINVERT = &H660046
  5. Private Const SRCPAINT = &HEE0086
  6. Private Const SRCAND = &H8800C6
  7. Private Const CLR_WATER = &HFF
  8. Private Const CLR_GRASS = &HFF00
  9. Private Const CLR_DIRT = &HC0C000
  10. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  11. Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  12.  
  13.  
  14. Public Sub DibujarMapa()
  15.  
  16.  
  17.  
  18.  
  19. For y = 0 To 15
  20. For x = 0 To 15
  21.  
  22. z = GetPixel(Form1.Picture2.hdc, x, y)
  23. Debug.Print z
  24.  
  25. Select Case z
  26.  
  27.  
  28.    Case RGB(0, 0, 255)
  29.  
  30.        EsAgua x * 32, y * 32
  31.  
  32.  
  33.    Case RGB(128, 128, 128)
  34.  
  35.        EsCamino x * 32, y * 32
  36.  
  37.  
  38.    Case RGB(0, 255, 0)
  39.  
  40.        EsLlegada x * 32, y * 32
  41.  
  42. End Select
  43.  
  44. Next x
  45. Next y
  46.  
  47. End Sub
  48. Sub EsAgua(x, y)
  49.  
  50.  
  51. BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(0).hdc, 0, 0, SRCCOPY
  52.  
  53.  
  54.  
  55. End Sub
  56. Sub EsLlegada(x, y)
  57.  
  58.  
  59. BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(1).hdc, 0, 0, SRCCOPY
  60.  
  61. End Sub
  62. Sub EsCamino(x, y)
  63.  
  64.  
  65.  
  66. BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(2).hdc, 0, 0, SRCCOPY
  67.  
  68. End Sub
  69.  

Y Funciona muy Bien (Les dejo una Foto)



(Si se dan Cuenta, lo que hace es Leer Pixel x Pixel la imagen del picture 2, y depende a que pixel sea, Carga una textura.)

Bien, pero Ahora mi Duda:

¿Como Hago para hacer una especie de Parallax Scrolling? Porque de esta manera solo estaria limitando al mapa a ese tamaño que ustedes ven ):?

Bien, espero que me puedan ayudar, y gracias de AnteMano :)
50  Programación / Programación Visual Basic / Re: [Ayuda] Necesito el Laberinto de MCKSys Argentina en: 23 Junio 2010, 19:37 pm
Hola,disculpa x la tardanza!!!, GRACIAS ! :D
Páginas: 1 2 3 4 [5] 6 7 8
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines