Se traba al caminar

elgabii

Yo :)
Código:
Sub CheckKeys()  'Stand
'*****************************************************************
'Checks keys and respond
'*****************************************************************
On Error Resume Next
    'Don't allow any these keys during movement..
    If UserMoving = 0 Then
        If Not UserEstupido Then
            'Move Up
            If GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyUp)) < 0 Then
                Call MoveTo(NORTH)
                frmMain.Coord.Caption = "Posición: " & UserMap & "," & UserPos.X & "," & UserPos.y
                Exit Sub
            End If
       
            'Move Right
            If GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyRight)) < 0 Then
                Call MoveTo(EAST)
                frmMain.Coord.Caption = "Posición: " & UserMap & "," & UserPos.X & "," & UserPos.y
                Exit Sub
            End If
       
            'Move down
            If GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyDown)) < 0 Then
                Call MoveTo(SOUTH)
                frmMain.Coord.Caption = "Posición: " & UserMap & "," & UserPos.X & "," & UserPos.y
                Exit Sub
            End If
       
            'Move left
            If GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyLeft)) < 0 Then
                Call MoveTo(WEST)
                frmMain.Coord.Caption = "Posición: " & UserMap & "," & UserPos.X & "," & UserPos.y
                Exit Sub
            End If
        Else
            Dim kp As Boolean
            kp = (GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyUp)) < 0) Or _
                GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyRight)) < 0 Or _
                GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyDown)) < 0 Or _
                GetKeyState(CustomKeys.BindedKey(eKeyType.mKeyLeft)) < 0
            If kp Then Call RandomMove
            frmMain.Coord.Caption = "Posición: " & UserMap & "," & UserPos.X & "," & UserPos.y
        End If
    End If
End Sub
Gracias por responder rapido.
 

elgabii

Yo :)
Aca tenes el char_render:
Código:
Private Sub Char_Render(ByVal CharIndex As Long, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer, ByVal X As Byte, ByVal y As Byte)
'***************************************************
'Author: Juan Martín Sotuyo Dodero (Maraxus)
'Last Modify Date: 12/03/04
'Draw char's to screen without offcentering them
'***************************************************
On Error Resume Next
    Dim moved As Boolean
    Dim Pos As Integer
    Dim line As String
    Dim color As Long
    Dim i As Integer
   
    With charlist(CharIndex)
        If .Moving Then
            'If needed, move left and right
            If .scrollDirectionX <> 0 Then
                .MoveOffsetX = .MoveOffsetX + ScrollPixelsPerFrameX * Sgn(.scrollDirectionX) * timerTicksPerFrame
               
                'Start animations
'TODO : Este parche es para evita los uncornos exploten al moverse!! REVER!!!
                If .Body.Walk(.Heading).Speed > 0 Then _
                    .Body.Walk(.Heading).Started = 1
                .Arma.WeaponWalk(.Heading).Started = 1
                .Escudo.ShieldWalk(.Heading).Started = 1
               
                'Char moved
                moved = True
               
                'Check if we already got there
                If (Sgn(.scrollDirectionX) = 1 And .MoveOffsetX >= 0) Or _
                        (Sgn(.scrollDirectionX) = -1 And .MoveOffsetX <= 0) Then
                    .MoveOffsetX = 0
                    .scrollDirectionX = 0
                End If
            End If
           
            'If needed, move up and down
            If .scrollDirectionY <> 0 Then
                .MoveOffsetY = .MoveOffsetY + ScrollPixelsPerFrameY * Sgn(.scrollDirectionY) * timerTicksPerFrame
               
                'Start animations
'TODO : Este parche es para evita los uncornos exploten al moverse!! REVER!!!
                If .Body.Walk(.Heading).Speed > 0 Then _
                    .Body.Walk(.Heading).Started = 1
                .Arma.WeaponWalk(.Heading).Started = 1
                .Escudo.ShieldWalk(.Heading).Started = 1
               
                'Char moved
                moved = True
               
                'Check if we already got there
                If (Sgn(.scrollDirectionY) = 1 And .MoveOffsetY >= 0) Or _
                        (Sgn(.scrollDirectionY) = -1 And .MoveOffsetY <= 0) Then
                    .MoveOffsetY = 0
                    .scrollDirectionY = 0
                End If
            End If
        End If
       
        'If done moving stop animation
        If Not moved Then
            'Stop animations
            .Body.Walk(.Heading).Started = 0
            .Body.Walk(.Heading).FrameCounter = 1
           
            .Arma.WeaponWalk(.Heading).Started = 0
            .Arma.WeaponWalk(.Heading).FrameCounter = 1
           
            .Escudo.ShieldWalk(.Heading).Started = 0
            .Escudo.ShieldWalk(.Heading).FrameCounter = 1
           
            .Moving = False
        End If
       
        PixelOffsetX = PixelOffsetX + .MoveOffsetX
        PixelOffsetY = PixelOffsetY + .MoveOffsetY
                                                 
            If Not .invisible Then
            If .Aura_Index > 0 Then _
            Call Draw_Grh(.Aura, PixelOffsetX - 1, PixelOffsetY + 20, 48, 52, True, X, y)
                'Draw Body
               
                If .Aurt_Index > 0 Then
Call Draw_Grh(.Aurt, PixelOffsetX, PixelOffsetY + 20, 48, 52, True, X, y)
End If
If .Auro_Index > 0 Then
Call Draw_Grh(.Auro, PixelOffsetX, PixelOffsetY + 20, 48, 52, True, X, y)
End If
                If .Aure_Index > 0 Then
Call Draw_Grh(.Aure, PixelOffsetX, PixelOffsetY + 20, 48, 52, True, X, y)
End If
               
                If .Body.Walk(.Heading).grhindex Then _
                    Call Draw_Grh(.Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1, , X, y)
                   
                If .Head.Head(.Heading).grhindex Then
                    Call Draw_Grh(.Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.y, 1, 0, , X, y)
                    If .Casco.Head(.Heading).grhindex Then _
                        Call Draw_Grh(.Casco.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.y, 1, 0, , X, y)
                    If .Arma.WeaponWalk(.Heading).grhindex Then _
                        Call Draw_Grh(.Arma.WeaponWalk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1, , X, y)
                    If .Escudo.ShieldWalk(.Heading).grhindex Then _
                        Call Draw_Grh(.Escudo.ShieldWalk(.Heading), PixelOffsetX, PixelOffsetY, 1, 1, , X, y)
                End If
                'Draw name over head
                If Nombres Then
                    If Len(.Nombre) > 0 Then
                        Pos = InStr(.Nombre, "<")
                        If Pos = 0 Then Pos = Len(.Nombre) + 2
                       
                        If .priv = 0 Then
                            If .Criminal Then
                                color = D3DColorXRGB(ColoresPJ(50).r, ColoresPJ(50).g, ColoresPJ(50).B)
                            Else
                                color = D3DColorXRGB(ColoresPJ(49).r, ColoresPJ(49).g, ColoresPJ(49).B)
                            End If
                        Else
                            color = D3DColorXRGB(ColoresPJ(.priv).r, ColoresPJ(.priv).g, ColoresPJ(.priv).B)
                        End If
                       
                        'Nick
                        line = Left$(.Nombre, Pos - 2)
                        Call Text_Render(font_list(1), line, PixelOffsetY + 30, PixelOffsetX - 20, 72, 20, color, fa_center, True)
                       
                        'Clan
                        line = mid$(.Nombre, Pos)
                        Call Text_Render(font_list(1), line, PixelOffsetY + 45, PixelOffsetX - 35, 100, 20, D3DColorXRGB(255, 0, 0), fa_center, True)
                    End If
                End If
            Else
                'Draw Alpha Body
                'Dibujado del pj en alpha
                'Gus.Canaria
                If .Body.Walk(.Heading).grhindex Then _
                    Call Grh_Render(.Body.Walk(.Heading), PixelOffsetX, PixelOffsetY, LuzGrh(), , , True)
                If .Head.Head(.Heading).grhindex Then _
                    Call Grh_Render(.Head.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.y, LuzGrh(), , , True)
                If .Casco.Head(.Heading).grhindex Then _
                    Call Grh_Render(.Casco.Head(.Heading), PixelOffsetX + .Body.HeadOffset.X, PixelOffsetY + .Body.HeadOffset.y, LuzGrh(), , , True)
                If .Arma.WeaponWalk(.Heading).grhindex Then _
                    Call Grh_Render(.Arma.WeaponWalk(.Heading), PixelOffsetX, PixelOffsetY, LuzGrh(), , , True)
                If .Escudo.ShieldWalk(.Heading).grhindex Then _
                    Call Grh_Render(.Escudo.ShieldWalk(.Heading), PixelOffsetX, PixelOffsetY, LuzGrh(), , , True)
            End If 'If not visible
           
           
        ''Update dialogs
        Call Dialogos.UpdateDialogPos(PixelOffsetX + .Body.HeadOffset.X - 155, PixelOffsetY + .Body.HeadOffset.y, CharIndex)
       
        'particulas para meditar

        If .particle_count > 0 Then
            For i = 1 To .particle_count
                If .particle_group(i) > 0 Then
                    Particle_Group_Render .particle_group(i), PixelOffsetX, PixelOffsetY
                End If
            Next i
        End If
       
       
        'Draw FX
        If .FxIndex <> 0 Then
            Call Draw_Grh(.fX, PixelOffsetX + FxData(.FxIndex).OffsetX, PixelOffsetY + FxData(.FxIndex).OffsetY, 1, 1, True)
            If .fX.Started = 0 Then _
                .FxIndex = 0
        End If
    End With
End Sub
Y aca esta el otro:
Código:
Sub ShowNextFrame()
    Static OffsetCounterX As Single
    Static OffsetCounterY As Single
        If UserMoving Then
            '****** Move screen Left and Right if needed ******
            If AddtoUserPos.X <> 0 Then
                OffsetCounterX = OffsetCounterX - ScrollPixelsPerFrameX * AddtoUserPos.X * timerTicksPerFrame
                If Abs(OffsetCounterX) >= Abs(32 * AddtoUserPos.X) Then
                    OffsetCounterX = 0
                    AddtoUserPos.X = 0
                    UserMoving = False
                End If
            End If
           
            '****** Move screen Up and Down if needed ******
            If AddtoUserPos.y <> 0 Then
                OffsetCounterY = OffsetCounterY - ScrollPixelsPerFrameY * AddtoUserPos.y * timerTicksPerFrame
                If Abs(OffsetCounterY) >= Abs(32 * AddtoUserPos.y) Then
                    OffsetCounterY = 0
                    AddtoUserPos.y = 0
                    UserMoving = False
                End If
            End If
        End If
        Call RenderScreen(UserPos.X - AddtoUserPos.X, UserPos.y - AddtoUserPos.y, OffsetCounterX, OffsetCounterY)
       
End Sub
En el modulo de clsDX8engine tengo esto:
Código:
    ScrollPixelsPerFrameX = 9
    ScrollPixelsPerFrameY = 9
 

elgabii

Yo :)
Aca esta el sub start:
Código:
Public Sub Start()

Dim f As Boolean
Dim ulttick As Long, esttick As Long
Dim timers(1 To 2) As Integer
Dim loopc As Integer


    day_r_old = luz_dia(Hour(Time)).r
    day_g_old = luz_dia(Hour(Time)).g
    day_b_old = luz_dia(Hour(Time)).B
    base_light = ARGB(day_r_old, day_g_old, day_b_old, 255)
   
DoEvents
vertList(0).X = 0: vertList(0).y = 0
vertList(1).X = 800: vertList(1).y = 0
vertList(2).X = 0: vertList(2).y = 600
vertList(3).X = 800: vertList(3).y = 600
vertList(0).rhw = 1
vertList(1).rhw = 1
vertList(2).rhw = 1
vertList(3).rhw = 1
vertList(0).color = D3DColorXRGB(255, 255, 255)
vertList(1).color = D3DColorXRGB(255, 255, 255)
vertList(2).color = D3DColorXRGB(255, 255, 255)
vertList(3).color = D3DColorXRGB(255, 255, 255)
vertList(0).tu = 0
vertList(0).tv = 0
vertList(1).tu = 1
vertList(1).tv = 0
vertList(2).tu = 0
vertList(2).tv = 1
vertList(3).tu = 1
vertList(3).tv = 1
On Error Resume Next ' putos timers!!!!!
Do While prgRun

If frmMain.WindowState <> vbMinimized And frmMain.Visible = True Then
    CheckKeys
    Engine.Render
    Engine.DrawInv
Else
    Sleep 10&
End If
DoEvents
    Rem Limitar FPS
'    While (GetTickCount - lFrameLimiter) < FramesPerSecCounter
'        Sleep 1
'    Wend
'    While GetTickCount - lFrameLimiter < 55
'       Sleep 5
'    Wend

        esttick = GetTickCount
        For loopc = 1 To UBound(timers)
            timers(loopc) = timers(loopc) + (esttick - ulttick)
            'Timer de trabajo
            If timers(1) >= tUs Then
                timers(1) = 0
                NoPuedeUsar = False
            End If
            'timer de attaque (77)
            If timers(2) >= tAt Then
                timers(2) = 0
                UserCanAttack = 1
                UserPuedeRefrescar = True
            End If
        Next loopc
        ulttick = GetTickCount

        DoEvents
Loop
Engine.Engine_Deinit

    EngineRun = False
    frmCargando.Show

    'Destruimos los objetos públicos creados
    Set SurfaceDB = Nothing
    Set Dialogos = Nothing
    Set DialogosClanes = Nothing
    Set Audio = Nothing
    Set Inventario = Nothing
   
    Call UnloadAllForms
   
End
End Sub
Y aca el main:
Código:
Sub Main()
Call BuscarEngine
If MsgBox("Quieres cambiar la resolucion a 800x600?", vbYesNo, "Resolucion") = vbYes Then
Call Resolution.SetResolucion
End If
On Error Resume Next

    Call WriteClientVer

    If App.PrevInstance Then
        Call MsgBox("Argentum Online ya esta corriendo! No es posible correr otra instancia del juego. Haga click en Aceptar para salir.", vbApplicationModal + vbInformation + vbOKOnly, "Error al ejecutar")
        End
    End If

   
    ChDrive App.path
    ChDir App.path

    MD5HushYo = "0123456789abcdef"  'We aren't using a real MD5
   
    'Por default usamos el dinámico
    Set SurfaceDB = New clsSurfaceManDynDX8
    'Call Resolution.SetResolution
       
    frmCargando.Show
    frmCargando.Refresh
   
    frmMain.Socket1.Startup
       
    Call InicializarNombres
   


UserMap = 1
   
    LoadGrhData
    CargarCabezas
    CargarCascos
    CargarCuerpos
    CargarArrayLluvia
    CargarFxs
    Call Engine.Engine_Init
    Call Engine.setup_ambient
    Call CargarParticulas
    Call CargarArrayLluvia
    Call CargarAnimArmas
    Call CargarAnimEscudos
    Call CargarVersiones
    Call CargarColores

   
    Unload frmCargando
   
    'Inicializamos el sonido
     Call Audio.Initialize(frmMain.hWnd, App.path & "\" & "WAV" & "\", App.path & "\" & "MIDI" & "\")
    Audio.MusicActivated = Not ClientSetup.bNoMusic
    Audio.SoundActivated = Not ClientSetup.bNoSound
    Audio.SoundEffectsActivated = Not Audio.SoundEffectsActivated
   
    'Inicializamos el inventario gráfico
    Call Inventario.Initialize(frmMain.picInv)
   
        Call Audio.PlayMIDI(MIdi_Inicio & ".mid")


    'frmPres.Picture = LoadPicture(App.path & "\Graficos\bosquefinal.jpg")
    'frmPres.Show vbModal    'Es modal, así que se detiene la ejecución de Main hasta que se desaparece
   
    frmConnect.Visible = True

    'Inicialización de variables globales
    prgRun = True
    pausa = False
   
        Dialogos.font = frmMain.font
    DialogosClanes.font = frmMain.font

   
Engine.Start
   
Exit Sub
ManejadorErrores:
    MsgBox "Ha ocurrido un error irreparable, el cliente se cerrará."
    Debug.Print "Contexto:" & Err.HelpContext & " Desc:" & Err.Description & " Fuente:" & Err.source
    End
End Sub
 

Fariseo

Destino y karma
Proba 2 cosas.
1) pone ' en el sub dtart donde hace la llamada al inventario.. engine.drawinv
2) saca las comillas en el sub start donde dice
  1. ' While GetTickCount - lFrameLimiter < 55
  2. ' Sleep 5
  3. ' Wend
  4. Dejalo sin comillas
 
Arriba