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
Option Explicit ' The maze information. Private NumRows As Integer Private NumCols As Integer Private LegalMove() As Boolean ' The size of a square. Private Const SQUARE_WID = 20 Private Const SQUARE_HGT = 20 ' The player's position. Private PlayerR As Integer Private PlayerC As Integer ' The end position. Private RFinish As Integer Private CFinish As Integer Private StartTime As Single ' Look for movement keys. 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 ' Initialize the maze and player. Private Sub Form_Load() ScaleMode = vbPixels AutoRedraw = True picPlayer.Visible = False ' Initialize the maze. LoadMaze End Sub ' Draw the maze. Private Sub DrawMaze() Dim r As Integer Dim c As Integer Dim clr As Long ' Start from scratch. 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 ' Initialize the maze. Private Sub LoadMaze() Dim fnum As Integer Dim r As Integer Dim c As Integer Dim ch As String Dim row_info As String ' Open the maze file. fnum = FreeFile Open App.Path & "\maze.dat" For Input As #fnum ' Read the number of rows and columns. Input #fnum, NumRows, NumCols ReDim LegalMove(1 To NumRows, 1 To NumCols) ' Read the data. 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 ' It's the start. PlayerR = r PlayerC = c ElseIf LCase$(ch) = "f" Then ' It's the finish. RFinish = r CFinish = c End If Next c Next r ' Close the file. Close #fnum ' Size the form. Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _ Width - ScaleX(ScaleWidth, ScaleMode, vbTwips) Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _ Height - ScaleY(ScaleHeight, ScaleMode, vbTwips) ' Draw the maze. DrawMaze ' Position the player. PositionPlayer PlayerR, PlayerC ' Save the start time. StartTime = Timer End Sub ' Draw the player. Private Sub PositionPlayer(r As Integer, c As Integer) Dim x As Single Dim y As Single ' Erase the player's old position. 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 ' Move the player. PlayerR = r PlayerC = c ' Draw the player. 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 ' See if the player reached the finish. If r = RFinish And c = CFinish Then If MsgBox("You finished in " & _ Int(Timer - StartTime) & " seconds." & _ vbCrLf & "Play again?", vbYesNo, _ "Congratulations") = vbYes _ Then Form_Load Else Unload Me End If End If End Sub
Version sebah97
Código
Option Explicit ' The maze information. Private NumRows As Integer Private NumCols As Integer Private LegalMove() As Boolean ' The size of a square. Private Const SQUARE_WID = 20 Private Const SQUARE_HGT = 20 ' The player's position. Private PlayerR As Integer Private PlayerC As Integer ' The end position. Private RFinish As Integer Private CFinish As Integer Private StartTime As Single Private Sub Form_KeyUp(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 ' Initialize the maze and player. Private Sub Form_Load() ScaleMode = vbPixels AutoRedraw = True picPlayer.Visible = False ' Initialize the maze. LoadMaze End Sub ' Draw the maze. Private Sub DrawMaze() Dim r As Integer Dim c As Integer Dim Tile As String ' Start from scratch. Cls For r = 1 To NumRows For c = 1 To NumCols If LegalMove(r, c) Then If r = RFinish And c = CFinish Then EsLlegada c * SQUARE_HGT, r * SQUARE_WID Else EsCamino c * SQUARE_HGT, r * SQUARE_WID End If Else EsPared c * SQUARE_HGT, r * SQUARE_WID End If Next c Next r End Sub ' Initialize the maze. Private Sub LoadMaze() Dim fnum As Integer Dim r As Integer Dim c As Integer Dim ch As String Dim row_info As String ' Open the maze file. fnum = FreeFile Open App.Path & "\maze.dat" For Input As #fnum ' Read the number of rows and columns. Input #fnum, NumRows, NumCols ReDim LegalMove(1 To NumRows, 1 To NumCols) ' Read the data. 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 ' It's the start. PlayerR = r PlayerC = c ElseIf LCase$(ch) = "f" Then ' It's the finish. RFinish = r CFinish = c End If Next c Next r ' Close the file. Close #fnum ' Size the form. Width = ScaleX(SQUARE_WID * NumCols, ScaleMode, vbTwips) + _ Width - ScaleX(ScaleWidth, ScaleMode, vbTwips) Height = ScaleY(SQUARE_HGT * NumRows, ScaleMode, vbTwips) + _ Height - ScaleY(ScaleHeight, ScaleMode, vbTwips) ' Draw the maze. DrawMaze ' Position the player. PositionPlayer PlayerR, PlayerC ' Save the start time. StartTime = Timer End Sub ' Draw the player. Private Sub PositionPlayer(r As Integer, c As Integer) Dim x As Single Dim y As Single ' Erase the player's old position. If PlayerR > 0 Then x = (PlayerC - 1) * SQUARE_WID + (SQUARE_WID - picPlayer.Width) / 2 y = (PlayerR - 1) * SQUARE_HGT + (SQUARE_HGT - picPlayer.Height) / 2 Actualizar End If ' Move the player. PlayerR = r PlayerC = c ' Draw the player. 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 ' See if the player reached the finish. If r = RFinish And c = CFinish Then If MsgBox("You finished in " & _ Int(Timer - StartTime) & " seconds." & _ vbCrLf & "Play again?", vbYesNo, _ "Congratulations") = vbYes _ Then Form_Load Else Unload Me End If End If End Sub Sub EsCamino(x, y) Me.PaintPicture Picture1, x, y, 20, 20 End Sub Sub EsLlegada(x, y) Me.PaintPicture Picture3, x, y, 20, 20 End Sub Sub EsPared(x, y) Me.PaintPicture Picture2, x, y, 20, 20 End Sub Sub Actualizar() Form1.Cls DrawMaze End Sub
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