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:
Version sebah97
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
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 (vb) [Seleccionar]
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 (vb) [Seleccionar]
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