Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - sebah97

#41
Programación Visual Basic / Bug en "MI" jueguito
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 (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
#42
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
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
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
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
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
Cita de: BlackZeroX en 27 Julio 2010, 05:45 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
Hola, primero que nada gracias por responder, pero probé el código y no me funciona :S

Algien tiene otra idea ??
#49
Hola, eh intentado crear un tilemap y lo eh conseguido (Dejo el Código)

Código (vb) [Seleccionar]
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
Private Const SRCCOPY = &HCC0020
Private Const SRCERASE = &H440328
Private Const SRCINVERT = &H660046
Private Const SRCPAINT = &HEE0086
Private Const SRCAND = &H8800C6
Private Const CLR_WATER = &HFF
Private Const CLR_GRASS = &HFF00
Private Const CLR_DIRT = &HC0C000
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long


Public Sub DibujarMapa()




For y = 0 To 15
For x = 0 To 15

z = GetPixel(Form1.Picture2.hdc, x, y)
Debug.Print z

Select Case z


    Case RGB(0, 0, 255)
   
        EsAgua x * 32, y * 32
       

    Case RGB(128, 128, 128)
   
        EsCamino x * 32, y * 32
       
   
    Case RGB(0, 255, 0)
   
        EsLlegada x * 32, y * 32

End Select

Next x
Next y

End Sub
Sub EsAgua(x, y)


BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(0).hdc, 0, 0, SRCCOPY



End Sub
Sub EsLlegada(x, y)


BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(1).hdc, 0, 0, SRCCOPY

End Sub
Sub EsCamino(x, y)



BitBlt Form1.Render.hdc, x, y, 32, 32, Form1.pic(2).hdc, 0, 0, SRCCOPY

End Sub


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
Hola,disculpa x la tardanza!!!, GRACIAS ! :D