Este es el formulario en cuestion, ahora vayamos a por el codigo. Siempre que tengamos problemas podemos ir a la pagina oficial de Visual Basic y buscar lo que necesitemos, para ayudaros aqui teneis un enlace a u na buena pagina de ayuda a visual basic==========>
pasamos al CODIGO:
Option Explicit
' La información del laberinto.
Private NumRows As Integer
Private NumCols As Integer
Private LegalMove() As Boolean
' El tamaño de un cuadrado.
Private Const SQUARE_WID = 20
Private Const SQUARE_HGT = 20
' La posición del jugador.
Private PlayerR As Integer
Private PlayerC As Integer
' La posición final.
Private RFinish As Integer
Private CFinish As Integer
Private StartTime As Single
' Busque las teclas de movimiento.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim r As Integer
Dim c As Integer
r = PlayerR
c = PlayerC
Select Case KeyCode
Case vbKeyLeft
c = PlayerC - 1
Case vbKeyRight
c = PlayerC + 1
Case vbKeyDown
r = PlayerR + 1
Case vbKeyUp
r = PlayerR - 1
Case Else
Exit Sub
End Select
If LegalMove(r, c) Then PositionPlayer r, c
End Sub
' Inicialice el laberinto y el reproductor.
Private Sub Form_Load()
ScaleMode = vbPixels
AutoRedraw = True
picPlayer.Visible = False
'Inicialice el laberinto.
LoadMaze
End Sub
' Dibujar el laberinto.
Private Sub DrawMaze()
Dim r As Integer
Dim c As Integer
Dim clr As Long
' Empezar desde cero.
Cls
For r = 1 To NumRows
For c = 1 To NumCols
If LegalMove(r, c) Then
If r = RFinish And c = CFinish Then
clr = vbYellow
Else
clr = vbWhite
End If
Else
clr = RGB(128, 128, 128)
End If
Line (c * SQUARE_WID, r * SQUARE_HGT)-Step(-SQUARE_WID, -SQUARE_HGT), clr, BF
Next c
Next r
End Sub
' Inicialice el laberinto.
Private Sub LoadMaze()
Dim fnum As Integer
Dim r As Integer
Dim c As Integer
Dim ch As String
Dim row_info As String
' Abra el archivo laberinto.
fnum = FreeFile
Open App.Path & "\maze.dat" For Input As #fnum
' Leer el número de filas y columnas.
Input #fnum, NumRows, NumCols
ReDim LegalMove(1 To NumRows, 1 To NumCols)
' Lea los datos.
For r = 1 To NumRows
Line Input #fnum, row_info
For c = 1 To NumCols
ch = Mid$(row_info, c, 1)
LegalMove(r, c) = (ch <> "#")
If LCase$(ch) = "s" Then
' Es el comienzo.
PlayerR = r
PlayerC = c
ElseIf LCase$(ch) = "f" Then
' Es la meta.
RFinish = r
CFinish = c
End If
Next c
Next r
' Cierre el archivo.
Close #fnum
' Tamaño del formulario.
Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _
Width - ScaleX(ScaleWidth, ScaleMode, vbTwips)
Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _
Height - ScaleY(ScaleHeight, ScaleMode, vbTwips)
' Dibujar el laberinto.
DrawMaze
' Coloque el reproductor.
PositionPlayer PlayerR, PlayerC
'Guarde la hora de inicio.
StartTime = Timer
End Sub
' Dibujar el jugador.
Private Sub PositionPlayer(r As Integer, c As Integer)
Dim x As Single
Dim y As Single
' Borrar vieja posición del jugador.
If PlayerR > 0 Then
x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
Line (x - 1, y - 1)-Step(picPlayer.Width, picPlayer.Height), vbWhite, BF
End If
' Mueve al jugador.
PlayerR = r
PlayerC = c
' Dibujar el jugador.
x = (c - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2
y = (r - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2
PaintPicture picPlayer.Picture, x, y
' A ver si el jugador llegó a la meta.
If r = RFinish And c = CFinish Then
If MsgBox("El juego acabara en " & _
Int(Timer - StartTime) & " segundos." & _
vbCrLf & "Jugar de nuevo?", vbYesNo, _
"Felicidades") = vbYes _
Then
Form_Load
Else
Unload Me
End If
End If
End Sub
Cuidado con el COPY/PASTE que cambia las comillas y practicad cambiando el formulario para manejar el cacharro este. Por cierto, no he arreglado del todo la sangria, pero es que es un coñazo, hacedlo vosotros en vuestro visual basic.
No hay comentarios:
Publicar un comentario