Sombras en dx8

Hola, aca les dejo el Sistema de Sombras adaptado para Fenix.

Reemplazar el Device_Box_Textured_Render_Advance por este:

Código:

Private Sub Device_Box_Textured_Render_Advance(ByVal GrhIndex As Long, ByVal dest_x As Integer, ByVal dest_y As Integer, ByVal src_width As Integer, _
                                            ByVal src_height As Integer, ByRef rgb_list() As Long, ByVal src_x As Integer, _
                                            ByVal src_y As Integer, Optional ByVal alpha_blend As Boolean, Optional ByVal angle As Single, _
                                            Optional ByVal shadow As Byte = 0)
    Static src_rect As RECT
    Static dest_rect As RECT
    Static temp_verts(3) As TLVERTEX
    Static d3dTextures As D3D8Textures
    Static light_value(0 To 3) As Long
   
    If GrhIndex = 0 Then Exit Sub
    Set d3dTextures.texture = GetTexture(GrhData(GrhIndex).FileNum, d3dTextures.texwidth, d3dTextures.texheight)
   
    light_value(0) = rgb_list(0)
    light_value(1) = rgb_list(1)
    light_value(2) = rgb_list(2)
    light_value(3) = rgb_list(3)
   
    If (light_value(0) = 0) Then light_value(0) = base_light
    If (light_value(1) = 0) Then light_value(1) = base_light
    If (light_value(2) = 0) Then light_value(2) = base_light
    If (light_value(3) = 0) Then light_value(3) = base_light
       
    'Set up the source rectangle
    With src_rect
        .bottom = src_y + src_height
        .Left = src_x
        .Right = src_x + src_width
        .Top = src_y
    End With
               
    'Set up the destination rectangle
    With dest_rect
        .bottom = dest_y + src_height
        .Left = dest_x
        .Right = dest_x + src_width
        .Top = dest_y
    End With
   
    'Set up the TempVerts(3) vertices
    Geometry_Create_Box temp_verts(), dest_rect, src_rect, light_value(), d3dTextures.texwidth, d3dTextures.texheight, angle
   
    'Set Textures
    D3DDevice.SetTexture 0, d3dTextures.texture
   
    If shadow Then
        temp_verts(1).X = temp_verts(1).X + src_width / 2
        temp_verts(1).Y = temp_verts(1).Y - src_height / 2
     
        temp_verts(3).X = temp_verts(3).X + src_width
        temp_verts(3).Y = temp_verts(3).Y - src_width
    End If
   
    If alpha_blend Then
      'Set Rendering for alphablending
        D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
        D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
    End If
   
    'Draw the triangles that make up our square Textures
    D3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, temp_verts(0), Len(temp_verts(0))
   
    If alpha_blend Then
        'Set Rendering for colokeying
        D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
        D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
    End If
 
End Sub


Arriba del Device_Box_Textured_Render_Advance, poner este Sub:

Código:

Private Sub DDrawSombraGrhToSurface(ByRef Grh As Grh, ByVal X As Integer, ByVal Y As Integer, ByVal center As Byte, ByVal Animate As Byte, Optional ByVal alpha As Boolean, Optional ByVal map_x As Byte = 1, Optional ByVal map_y As Byte = 1, Optional ByVal angle As Single, Optional ByVal shadow As Byte = 0)
 
    Dim CurrentGrhIndex As Integer
    If Grh.GrhIndex = 0 Then Exit Sub
    If Animate Then
        If Grh.Started = 1 Then
            Grh.FrameCounter = Grh.FrameCounter + (timerElapsedTime * GrhData(Grh.GrhIndex).NumFrames / Grh.SpeedCounter)
            If Grh.FrameCounter > GrhData(Grh.GrhIndex).NumFrames Then
                Grh.FrameCounter = (Grh.FrameCounter Mod GrhData(Grh.GrhIndex).NumFrames) + 1
             
                If Grh.SpeedCounter <> -1 Then
                    If Grh.SpeedCounter > 0 Then
                        Grh.SpeedCounter = Grh.SpeedCounter - 1
                    Else
                        Grh.Started = 0
                    End If
                End If
            End If
        End If
    End If
 
    'Figure out what frame to draw (always 1 if not animated)
    CurrentGrhIndex = GrhData(Grh.GrhIndex).Frames(Grh.FrameCounter)
 
    'Center Grh over X,Y pos
    If center Then
        If GrhData(CurrentGrhIndex).TileWidth <> 1 Then
            X = X - Int(GrhData(CurrentGrhIndex).TileWidth * (32 \ 2)) + 32 \ 2
        End If
 
        If GrhData(Grh.GrhIndex).TileHeight <> 1 Then
            Y = Y - Int(GrhData(CurrentGrhIndex).TileHeight * 32) + 32
        End If
    End If
 
    Dim shadowRgb(3) As Long
    shadowRgb(0) = 1677721600
    shadowRgb(1) = 1677721600
    shadowRgb(2) = 1677721600
    shadowRgb(3) = 1677721600
 
    Device_Box_Textured_Render_Advance CurrentGrhIndex, _
        X, Y, _
        GrhData(CurrentGrhIndex).pixelWidth, GrhData(CurrentGrhIndex).pixelHeight, _
        shadowRgb(), _
        GrhData(CurrentGrhIndex).sX, GrhData(CurrentGrhIndex).sY, _
        alpha, angle, 1
     
   
End Sub


Reemplazar todo el Sub RenderScreen por este:

Código:

Sub RenderScreen(ByVal tilex As Integer, ByVal tiley As Integer, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer)
'**************************************************************
'Author: Aaron Perkins
'Last Modify Date: 28/04/2010
'Last modified by: Franco (Thusing)
'Renders everything to the viewport
'**************************************************************
    Dim Y                  As Integer    'Keeps track of where on map we are
    Dim X                  As Integer    'Keeps track of where on map we are
    Dim screenminY          As Integer  'Start Y pos on current screen
    Dim screenmaxY          As Integer  'End Y pos on current screen
    Dim screenminX          As Integer  'Start X pos on current screen
    Dim screenmaxX          As Integer  'End X pos on current screen
    Dim minY                As Integer  'Start Y pos on current map
    Dim maxY                As Integer  'End Y pos on current map
    Dim minX                As Integer  'Start X pos on current map
    Dim maxX                As Integer  'End X pos on current map
    Dim ScreenX            As Integer  'Keeps track of where to place tile on screen
    Dim ScreenY            As Integer  'Keeps track of where to place tile on screen
    Dim minXOffset          As Integer
    Dim minYOffset          As Integer
    Dim PixelOffsetXTemp    As Integer 'For centering grhs
    Dim PixelOffsetYTemp    As Integer 'For centering grhs
    Dim CurrentGrhIndex    As Integer
    Dim offx                As Integer
    Dim offy                As Integer
    Dim TempChar As Char
    Dim Moved    As Byte
    Dim iPPx    As Integer
    Dim iPPy    As Integer
   
    'Figure out Ends and Starts of screen
    screenminY = tiley - HalfWindowTileHeight
    screenmaxY = tiley + HalfWindowTileHeight
    screenminX = tilex - HalfWindowTileWidth
    screenmaxX = tilex + HalfWindowTileWidth
   
    minY = screenminY - TileBufferSize
    maxY = screenmaxY + TileBufferSize
    minX = screenminX - TileBufferSize
    maxX = screenmaxX + TileBufferSize
   
    'Make sure mins and maxs are allways in map bounds
    If minY < XMinMapSize Then
        minYOffset = YMinMapSize - minY
        minY = YMinMapSize
    End If
   
    If maxY > YMaxMapSize Then maxY = YMaxMapSize
   
    If minX < XMinMapSize Then
        minXOffset = XMinMapSize - minX
        minX = XMinMapSize
    End If
   
    If maxX > XMaxMapSize Then maxX = XMaxMapSize
   
    'If we can, we render around the view area to make it smoother
    If screenminY > YMinMapSize Then
        screenminY = screenminY - 1
    Else
        screenminY = 1
        ScreenY = 1
    End If
   
    If screenmaxY < YMaxMapSize Then screenmaxY = screenmaxY + 1
   
    If screenminX > XMinMapSize Then
        screenminX = screenminX - 1
    Else
        screenminX = 1
        ScreenX = 1
    End If
   
    If screenmaxX < XMaxMapSize Then screenmaxX = screenmaxX + 1
   
 
   
    'Draw floor layer
    For Y = screenminY To screenmaxY
        For X = screenminX To screenmaxX
            'Layer 1 **********************************
           
#If HARDCODED = True Then
                    If MapData(X, Y).Graphic(1).Started = 1 Then
                        MapData(X, Y).Graphic(1).FrameCounter = MapData(X, Y).Graphic(1).FrameCounter + (timerElapsedTime * GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames / MapData(X, Y).Graphic(1).Speed)
                        If MapData(X, Y).Graphic(1).FrameCounter > GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames Then
                            MapData(X, Y).Graphic(1).FrameCounter = (MapData(X, Y).Graphic(1).FrameCounter Mod GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames) + 1
                           
                            If MapData(X, Y).Graphic(1).Loops <> -1 Then
                                If MapData(X, Y).Graphic(1).Loops > 0 Then
                                    MapData(X, Y).Graphic(1).Loops = MapData(X, Y).Graphic(1).Loops - 1
                                Else
                                    MapData(X, Y).Graphic(1).Started = 0
                                End If
                            End If
                        End If
                    End If
 
                CurrentGrhIndex = GrhData(MapData(X, Y).Graphic(1).GrhIndex).Frames(MapData(X, Y).Graphic(1).FrameCounter)
 
                Device_Box_Textured_Render CurrentGrhIndex, _
                    (ScreenX - 1) * 32 + PixelOffsetX, (ScreenY - 1) * 32 + PixelOffsetY, _
                    GrhData(CurrentGrhIndex).pixelWidth, GrhData(CurrentGrhIndex).pixelHeight, _
                    MapData(X, Y).light_value, _
                    GrhData(CurrentGrhIndex).sX, GrhData(CurrentGrhIndex).sY, _
                    False _
                    , 0
#Else
                Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(1), _
                        (ScreenX - 1) * 32 + PixelOffsetX, _
                        (ScreenY - 1) * 32 + PixelOffsetY, _
                        0, 1, , X, Y)
                If MapData(X, Y).Graphic(2).GrhIndex <> 0 Then
                Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(2), (ScreenX - 1) * 32 + PixelOffsetX, (ScreenY - 1) * 32 + PixelOffsetY, 1, 1, , X, Y)
                End If
#End If
            '******************************************
            ScreenX = ScreenX + 1
        Next X
 
        'Reset ScreenX to original value and increment ScreenY
        ScreenX = ScreenX - X + screenminX
        ScreenY = ScreenY + 1
    Next Y
   
   
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
            PixelOffsetXTemp = ScreenX * 32 + PixelOffsetX
            PixelOffsetYTemp = ScreenY * 32 + PixelOffsetY
            With MapData(X, Y)
                '******************************************
 
                'Object Layer **********************************
                If .ObjGrh.GrhIndex <> 0 Then
 
                    Call DDrawTransGrhtoSurface(.ObjGrh, _
                            PixelOffsetXTemp, PixelOffsetYTemp, 1, 1, , X, Y)
                End If
               
                'Renderizado del personaje ************************
                            If MapData(X, Y).CharIndex > 0 Then
                TempChar = CharList(MapData(X, Y).CharIndex)
                PixelOffsetXTemp = PixelOffsetX
                PixelOffsetYTemp = PixelOffsetY
                Moved = 0
   
            If TempChar.MoveOffset.X <> 0 Then
                TempChar.Body.Walk(TempChar.Heading).Started = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 1
                PixelOffsetXTemp = PixelOffsetXTemp + TempChar.MoveOffset.X
                TempChar.MoveOffset.X = TempChar.MoveOffset.X - (ScrollPixelsPerFrame * Sgn(TempChar.MoveOffset.X))
                Moved = 1
            End If
 
            If TempChar.MoveOffset.Y <> 0 Then
                TempChar.Body.Walk(TempChar.Heading).Started = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 1
                PixelOffsetYTemp = PixelOffsetYTemp + TempChar.MoveOffset.Y
                TempChar.MoveOffset.Y = TempChar.MoveOffset.Y - (ScrollPixelsPerFrame * Sgn(TempChar.MoveOffset.Y))
                Moved = 1
            End If
 
 
 
            If Moved = 0 And TempChar.Moving = 1 Then
                TempChar.Moving = 0
                TempChar.Body.Walk(TempChar.Heading).FrameCounter = 1
                TempChar.Body.Walk(TempChar.Heading).Started = 0
                TempChar.arma.WeaponWalk(TempChar.Heading).FrameCounter = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 0
                TempChar.escudo.ShieldWalk(TempChar.Heading).FrameCounter = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 0
                TempChar.haciendoataque = 0
            End If
           
            If TempChar.haciendoataque = 0 And TempChar.MoveOffset.X = 0 And TempChar.MoveOffset.Y = 0 Then
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 0
                TempChar.arma.WeaponWalk(TempChar.Heading).FrameCounter = 1
                End If
            If TempChar.haciendoataque = 1 Then
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.haciendoataque = 0
            End If
           
                iPPx = ((32 * ScreenX) - 32) + PixelOffsetXTemp + 32
                iPPy = ((32 * ScreenY) - 32) + PixelOffsetYTemp + 32
               
                If Len(TempChar.Nombre) = 0 Then
                    Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                    Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                                            'Cabeza
                        If TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawSombraGrhToSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X + 19, iPPy + TempChar.Body.HeadOffset.Y - 19, 1, 0, , X, Y, , 1)
                        Call DDrawTransGrhtoSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                Else
                    If TempChar.Navegando = 1 Then
                        'Cuerpo (Barca / Galeon / Galera)
                        Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                        Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                    ElseIf Not CharList(MapData(X, Y).CharIndex).invisible And TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                       
                        'Cuerpo
                        Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                        Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                       
                        'Cabeza
                        If TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawSombraGrhToSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X + 19, iPPy + TempChar.Body.HeadOffset.Y - 19, 1, 0, , X, Y, , 1)
                        Call DDrawTransGrhtoSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                       
                        'Casco
                        If TempChar.casco.Head(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.casco.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                       
                        'Arma
                        If TempChar.arma.WeaponWalk(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.arma.WeaponWalk(TempChar.Heading), iPPx, iPPy, 1, 1)
                        End If
                       
                        'Escudo
                        If TempChar.escudo.ShieldWalk(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.escudo.ShieldWalk(TempChar.Heading), iPPx, iPPy, 1, 1)
                        End If
                   
                    End If
                       
                    If Nombres Then
                       
                        If Not (TempChar.invisible Or TempChar.Navegando = 1) Then
                     
                            Dim lCenter As Long
                            If InStr(TempChar.Nombre, "<") > 0 And InStr(TempChar.Nombre, ">") > 0 Then
                                Dim sClan As String
                                lCenter = (frmMain.textwidth(Left$(TempChar.Nombre, InStr(TempChar.Nombre, "<") - 1)) / 2) - 16
                                sClan = Mid$(TempChar.Nombre, InStr(TempChar.Nombre, "<"))
                                Text_Render font_list(1), Left$(TempChar.Nombre, InStr(TempChar.Nombre, "<") - 1), iPPy + 30, iPPx - lCenter, 100, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                                lCenter = (frmMain.textwidth(sClan) / 2) - 16
                                Text_Render font_list(1), sClan, iPPy + 45, iPPx - lCenter, 200, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                            Else
                                lCenter = (frmMain.textwidth(TempChar.Nombre) / 2) - 16
                                Text_Render font_list(1), TempChar.Nombre, iPPy + 30, iPPx - lCenter, 100, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                            End If
                     
                        End If
                     
                    End If
                End If
   
                If Dialogos.CantidadDialogos > 0 Then Call Dialogos.Update_Dialog_Pos((iPPx + TempChar.Body.HeadOffset.X), (iPPy + TempChar.Body.HeadOffset.Y), MapData(X, Y).CharIndex)
               
                CharList(MapData(X, Y).CharIndex) = TempChar
   
                If CharList(MapData(X, Y).CharIndex).FX <> 0 Then Call DDrawTransGrhtoSurface(FxData(TempChar.FX).FX, iPPx + FxData(TempChar.FX).OffsetX, iPPy + FxData(TempChar.FX).OffsetY, 1, 1, MapData(X, Y).CharIndex)
               
            End If
 
       
                '*************************************************
               
               
                'Layer 3 *****************************************
                If .Graphic(3).GrhIndex <> 0 Then
                    Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(3), _
                            ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, , X, Y)
                End If
                '************************************************
 
            End With
            ScreenX = ScreenX + 1
        Next X
        ScreenY = ScreenY + 1
    Next Y
    ScreenY = minYOffset - 5
                   
                   
                    D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
                    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
   
    Dim tmplng As Long
    Dim tmblng2 As Long
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
            With MapData(X, Y)
                '***********************************************
                If .particle_group > 0 Then
                  Particles_Update .particle_group, ScreenY * 32 + PixelOffsetY, ScreenX * 32 + PixelOffsetX
                   
                    'D3DDevice.SetTexture 0, GetTexture(GrhData(particle_group_list(.particle_group).texture).FileNum, iPPx, iPPy)
                    D3DDevice.SetRenderState D3DRS_POINTSIZE, Engine_FToDW(particle_group_list(.particle_group).size)
                    D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, particle_group_list(.particle_group).nParticles, particle_group_list(.particle_group).PrtVertList(0), Len(particle_group_list(.particle_group).PrtVertList(0))
 
                End If
                'If .FXS_group_group <> 0 Then Call fxs_list(.FXS_group).Render(PixelOffsetXTemp, PixelOffsetYTemp)
            End With
            ScreenX = ScreenX + 1
        Next X
        ScreenY = ScreenY + 1
    Next Y
                   
                    D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
                    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
   
 
If Not bTecho Then
        'Draw blocked tiles and grid
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
                'Layer 4 **********************************
                If MapData(X, Y).Graphic(4).GrhIndex Then
                    'Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(4), _
                        ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, , X, Y)
                End If
                '**********************************
             
                ScreenX = ScreenX + 1
            Next X
            ScreenY = ScreenY + 1
        Next Y
    Else
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
                'Layer 4 **********************************
                If MapData(X, Y).Graphic(4).GrhIndex Then
                    'Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(4), _
                        ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, True, X, Y)
                End If
                '**********************************
             
                ScreenX = ScreenX + 1
            Next X
            ScreenY = ScreenY + 1
        Next Y
    End If
 
   
End Sub



Listo, eso es todo, con eso renderizarían sombras en los pjs y los npcs.

Plus:
Los que agregaron el sistema de mañana, dia, tarde y noche, y quieren que al ser de noche desaparezca la sombra , reemplazen todo el sub renderscreen por este:

Código:

Sub RenderScreen(ByVal tilex As Integer, ByVal tiley As Integer, ByVal PixelOffsetX As Integer, ByVal PixelOffsetY As Integer)
'**************************************************************
'Author: Aaron Perkins
'Last Modify Date: 28/04/2010
'Last modified by: Franco (Thusing)
'Renders everything to the viewport
'**************************************************************
    Dim Y                  As Integer    'Keeps track of where on map we are
    Dim X                  As Integer    'Keeps track of where on map we are
    Dim screenminY          As Integer  'Start Y pos on current screen
    Dim screenmaxY          As Integer  'End Y pos on current screen
    Dim screenminX          As Integer  'Start X pos on current screen
    Dim screenmaxX          As Integer  'End X pos on current screen
    Dim minY                As Integer  'Start Y pos on current map
    Dim maxY                As Integer  'End Y pos on current map
    Dim minX                As Integer  'Start X pos on current map
    Dim maxX                As Integer  'End X pos on current map
    Dim ScreenX            As Integer  'Keeps track of where to place tile on screen
    Dim ScreenY            As Integer  'Keeps track of where to place tile on screen
    Dim minXOffset          As Integer
    Dim minYOffset          As Integer
    Dim PixelOffsetXTemp    As Integer 'For centering grhs
    Dim PixelOffsetYTemp    As Integer 'For centering grhs
    Dim CurrentGrhIndex    As Integer
    Dim offx                As Integer
    Dim offy                As Integer
    Dim TempChar As Char
    Dim Moved    As Byte
    Dim iPPx    As Integer
    Dim iPPy    As Integer
   
    'Figure out Ends and Starts of screen
    screenminY = tiley - HalfWindowTileHeight
    screenmaxY = tiley + HalfWindowTileHeight
    screenminX = tilex - HalfWindowTileWidth
    screenmaxX = tilex + HalfWindowTileWidth
   
    minY = screenminY - TileBufferSize
    maxY = screenmaxY + TileBufferSize
    minX = screenminX - TileBufferSize
    maxX = screenmaxX + TileBufferSize
   
    'Make sure mins and maxs are allways in map bounds
    If minY < XMinMapSize Then
        minYOffset = YMinMapSize - minY
        minY = YMinMapSize
    End If
   
    If maxY > YMaxMapSize Then maxY = YMaxMapSize
   
    If minX < XMinMapSize Then
        minXOffset = XMinMapSize - minX
        minX = XMinMapSize
    End If
   
    If maxX > XMaxMapSize Then maxX = XMaxMapSize
   
    'If we can, we render around the view area to make it smoother
    If screenminY > YMinMapSize Then
        screenminY = screenminY - 1
    Else
        screenminY = 1
        ScreenY = 1
    End If
   
    If screenmaxY < YMaxMapSize Then screenmaxY = screenmaxY + 1
   
    If screenminX > XMinMapSize Then
        screenminX = screenminX - 1
    Else
        screenminX = 1
        ScreenX = 1
    End If
   
    If screenmaxX < XMaxMapSize Then screenmaxX = screenmaxX + 1
   
 
   
    'Draw floor layer
    For Y = screenminY To screenmaxY
        For X = screenminX To screenmaxX
            'Layer 1 **********************************
           
#If HARDCODED = True Then
                    If MapData(X, Y).Graphic(1).Started = 1 Then
                        MapData(X, Y).Graphic(1).FrameCounter = MapData(X, Y).Graphic(1).FrameCounter + (timerElapsedTime * GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames / MapData(X, Y).Graphic(1).Speed)
                        If MapData(X, Y).Graphic(1).FrameCounter > GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames Then
                            MapData(X, Y).Graphic(1).FrameCounter = (MapData(X, Y).Graphic(1).FrameCounter Mod GrhData(MapData(X, Y).Graphic(1).GrhIndex).NumFrames) + 1
                           
                            If MapData(X, Y).Graphic(1).Loops <> -1 Then
                                If MapData(X, Y).Graphic(1).Loops > 0 Then
                                    MapData(X, Y).Graphic(1).Loops = MapData(X, Y).Graphic(1).Loops - 1
                                Else
                                    MapData(X, Y).Graphic(1).Started = 0
                                End If
                            End If
                        End If
                    End If
 
                CurrentGrhIndex = GrhData(MapData(X, Y).Graphic(1).GrhIndex).Frames(MapData(X, Y).Graphic(1).FrameCounter)
 
                Device_Box_Textured_Render CurrentGrhIndex, _
                    (ScreenX - 1) * 32 + PixelOffsetX, (ScreenY - 1) * 32 + PixelOffsetY, _
                    GrhData(CurrentGrhIndex).pixelWidth, GrhData(CurrentGrhIndex).pixelHeight, _
                    MapData(X, Y).light_value, _
                    GrhData(CurrentGrhIndex).sX, GrhData(CurrentGrhIndex).sY, _
                    False _
                    , 0
#Else
                Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(1), _
                        (ScreenX - 1) * 32 + PixelOffsetX, _
                        (ScreenY - 1) * 32 + PixelOffsetY, _
                        0, 1, , X, Y)
                If MapData(X, Y).Graphic(2).GrhIndex <> 0 Then
                Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(2), (ScreenX - 1) * 32 + PixelOffsetX, (ScreenY - 1) * 32 + PixelOffsetY, 1, 1, , X, Y)
                End If
#End If
            '******************************************
            ScreenX = ScreenX + 1
        Next X
 
        'Reset ScreenX to original value and increment ScreenY
        ScreenX = ScreenX - X + screenminX
        ScreenY = ScreenY + 1
    Next Y
   
   
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
            PixelOffsetXTemp = ScreenX * 32 + PixelOffsetX
            PixelOffsetYTemp = ScreenY * 32 + PixelOffsetY
            With MapData(X, Y)
                '******************************************
 
                'Object Layer **********************************
                If .ObjGrh.GrhIndex <> 0 Then
 
                    Call DDrawTransGrhtoSurface(.ObjGrh, _
                            PixelOffsetXTemp, PixelOffsetYTemp, 1, 1, , X, Y)
                End If
               
                'Renderizado del personaje ************************
                            If MapData(X, Y).CharIndex > 0 Then
                TempChar = CharList(MapData(X, Y).CharIndex)
                PixelOffsetXTemp = PixelOffsetX
                PixelOffsetYTemp = PixelOffsetY
                Moved = 0
   
            If TempChar.MoveOffset.X <> 0 Then
                TempChar.Body.Walk(TempChar.Heading).Started = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 1
                PixelOffsetXTemp = PixelOffsetXTemp + TempChar.MoveOffset.X
                TempChar.MoveOffset.X = TempChar.MoveOffset.X - (ScrollPixelsPerFrame * Sgn(TempChar.MoveOffset.X))
                Moved = 1
            End If
 
            If TempChar.MoveOffset.Y <> 0 Then
                TempChar.Body.Walk(TempChar.Heading).Started = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 1
                PixelOffsetYTemp = PixelOffsetYTemp + TempChar.MoveOffset.Y
                TempChar.MoveOffset.Y = TempChar.MoveOffset.Y - (ScrollPixelsPerFrame * Sgn(TempChar.MoveOffset.Y))
                Moved = 1
            End If
 
 
 
            If Moved = 0 And TempChar.Moving = 1 Then
                TempChar.Moving = 0
                TempChar.Body.Walk(TempChar.Heading).FrameCounter = 1
                TempChar.Body.Walk(TempChar.Heading).Started = 0
                TempChar.arma.WeaponWalk(TempChar.Heading).FrameCounter = 1
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 0
                TempChar.escudo.ShieldWalk(TempChar.Heading).FrameCounter = 1
                TempChar.escudo.ShieldWalk(TempChar.Heading).Started = 0
                TempChar.haciendoataque = 0
            End If
           
            If TempChar.haciendoataque = 0 And TempChar.MoveOffset.X = 0 And TempChar.MoveOffset.Y = 0 Then
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 0
                TempChar.arma.WeaponWalk(TempChar.Heading).FrameCounter = 1
                End If
            If TempChar.haciendoataque = 1 Then
                TempChar.arma.WeaponWalk(TempChar.Heading).Started = 1
                TempChar.haciendoataque = 0
            End If
           
                iPPx = ((32 * ScreenX) - 32) + PixelOffsetXTemp + 32
                iPPy = ((32 * ScreenY) - 32) + PixelOffsetYTemp + 32
               
                If Len(TempChar.Nombre) = 0 Then
                    'Cuerpo NPC
                    If Not Tiempo = "Noche" Then
                    Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                    End If
                    Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                                            'Cabeza NPC
                        If TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                        If Not Tiempo = "Noche" Then
                        Call DDrawSombraGrhToSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X + 19, iPPy + TempChar.Body.HeadOffset.Y - 19, 1, 0, , X, Y, , 1)
                        End If
                        Call DDrawTransGrhtoSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                Else
                    If TempChar.Navegando = 1 Then
                        'Cuerpo (Barca / Galeon / Galera)
                        If Not Tiempo = "Noche" Then
                        Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                        End If
                        Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                    ElseIf Not CharList(MapData(X, Y).CharIndex).invisible And TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                       
                        'Cuerpo
                        If Not Tiempo = "Noche" Then
                        Call DDrawSombraGrhToSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 0, , X, Y, , 1)
                        End If
                        Call DDrawTransGrhtoSurface(TempChar.Body.Walk(TempChar.Heading), iPPx, iPPy, 1, 1)
                       
                        'Cabeza
                        If TempChar.Head.Head(TempChar.Heading).GrhIndex > 0 Then
                        If Not Tiempo = "Noche" Then
                        Call DDrawSombraGrhToSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X + 19, iPPy + TempChar.Body.HeadOffset.Y - 19, 1, 0, , X, Y, , 1)
                        End If
                        Call DDrawTransGrhtoSurface(TempChar.Head.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                       
                        'Casco
                        If TempChar.casco.Head(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.casco.Head(TempChar.Heading), iPPx + TempChar.Body.HeadOffset.X, iPPy + TempChar.Body.HeadOffset.Y, 1, 0)
                        End If
                       
                        'Arma
                        If TempChar.arma.WeaponWalk(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.arma.WeaponWalk(TempChar.Heading), iPPx, iPPy, 1, 1)
                        End If
                       
                        'Escudo
                        If TempChar.escudo.ShieldWalk(TempChar.Heading).GrhIndex > 0 Then
                        Call DDrawTransGrhtoSurface(TempChar.escudo.ShieldWalk(TempChar.Heading), iPPx, iPPy, 1, 1)
                        End If
                   
                    End If
                       
                    If Nombres Then
                       
                        If Not (TempChar.invisible Or TempChar.Navegando = 1) Then
                     
                            Dim lCenter As Long
                            If InStr(TempChar.Nombre, "<") > 0 And InStr(TempChar.Nombre, ">") > 0 Then
                                Dim sClan As String
                                lCenter = (frmMain.textwidth(Left$(TempChar.Nombre, InStr(TempChar.Nombre, "<") - 1)) / 2) - 16
                                sClan = Mid$(TempChar.Nombre, InStr(TempChar.Nombre, "<"))
                                Text_Render font_list(1), Left$(TempChar.Nombre, InStr(TempChar.Nombre, "<") - 1), iPPy + 30, iPPx - lCenter, 100, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                                lCenter = (frmMain.textwidth(sClan) / 2) - 16
                                Text_Render font_list(1), sClan, iPPy + 45, iPPx - lCenter, 200, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                            Else
                                lCenter = (frmMain.textwidth(TempChar.Nombre) / 2) - 16
                                Text_Render font_list(1), TempChar.Nombre, iPPy + 30, iPPx - lCenter, 100, 20, D3DColorXRGB(RG(TempChar.Criminal, 1), RG(TempChar.Criminal, 2), RG(TempChar.Criminal, 3)), DT_TOP Or DT_LEFT, True
                            End If
                     
                        End If
                     
                    End If
                End If
   
                If Dialogos.CantidadDialogos > 0 Then Call Dialogos.Update_Dialog_Pos((iPPx + TempChar.Body.HeadOffset.X), (iPPy + TempChar.Body.HeadOffset.Y), MapData(X, Y).CharIndex)
               
                CharList(MapData(X, Y).CharIndex) = TempChar
   
                If CharList(MapData(X, Y).CharIndex).FX <> 0 Then Call DDrawTransGrhtoSurface(FxData(TempChar.FX).FX, iPPx + FxData(TempChar.FX).OffsetX, iPPy + FxData(TempChar.FX).OffsetY, 1, 1, MapData(X, Y).CharIndex)
               
            End If
 
       
                '*************************************************
               
               
                'Layer 3 *****************************************
                If .Graphic(3).GrhIndex <> 0 Then
                    Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(3), _
                            ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, , X, Y)
                End If
                '************************************************
 
            End With
            ScreenX = ScreenX + 1
        Next X
        ScreenY = ScreenY + 1
    Next Y
    ScreenY = minYOffset - 5
                   
                   
                    D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
                    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE
   
    Dim tmplng As Long
    Dim tmblng2 As Long
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
            With MapData(X, Y)
                '***********************************************
                If .particle_group > 0 Then
                  Particles_Update .particle_group, ScreenY * 32 + PixelOffsetY, ScreenX * 32 + PixelOffsetX
                   
                    'D3DDevice.SetTexture 0, GetTexture(GrhData(particle_group_list(.particle_group).texture).FileNum, iPPx, iPPy)
                    D3DDevice.SetRenderState D3DRS_POINTSIZE, Engine_FToDW(particle_group_list(.particle_group).size)
                    D3DDevice.DrawPrimitiveUP D3DPT_POINTLIST, particle_group_list(.particle_group).nParticles, particle_group_list(.particle_group).PrtVertList(0), Len(particle_group_list(.particle_group).PrtVertList(0))
 
                End If
                'If .FXS_group_group <> 0 Then Call fxs_list(.FXS_group).Render(PixelOffsetXTemp, PixelOffsetYTemp)
            End With
            ScreenX = ScreenX + 1
        Next X
        ScreenY = ScreenY + 1
    Next Y
                   
                    D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
                    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
   
 
If Not bTecho Then
        'Draw blocked tiles and grid
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
                'Layer 4 **********************************
                If MapData(X, Y).Graphic(4).GrhIndex Then
                    'Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(4), _
                        ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, , X, Y)
                End If
                '**********************************
             
                ScreenX = ScreenX + 1
            Next X
            ScreenY = ScreenY + 1
        Next Y
    Else
    ScreenY = minYOffset - TileBufferSize
    For Y = minY To maxY
        ScreenX = minXOffset - TileBufferSize
        For X = minX To maxX
                'Layer 4 **********************************
                If MapData(X, Y).Graphic(4).GrhIndex Then
                    'Call DDrawTransGrhtoSurface(MapData(X, Y).Graphic(4), _
                        ScreenX * 32 + PixelOffsetX, _
                        ScreenY * 32 + PixelOffsetY, _
                        1, 1, True, X, Y)
                End If
                '**********************************
             
                ScreenX = ScreenX + 1
            Next X
            ScreenY = ScreenY + 1
        Next Y
    End If
 
   
End Sub



Saludos!

Buen aporte santi55, seguí asi

Te dejo 10 marios: