[Aportes] Renderizar Mapa a BMP o JPG DX8

xCrisx1

MarciAno
Bueno este metodo lo hice yo para mi editor de mapas hecho de 0, y lo adapte para ustedes.. asi que vamos ayá
(este foro fue mi inicio :'3 le tengo cariño)

para empezar el codigo a implementar es para capturar imagen por BitBlt sacada de recursosvisualbasic, yo solo lo implemente para hacerlo a dx8

¿Como Funciona?
Simple, al pulsar un boton o desde el menu como usds quieran, preguntara a que escala quieren guardar la imagen, tendra de 1 a 5
¿por que hasta 5?
pos por que no me anime a hacer mas, ya q yo necesitaba solo de 100 pixeles la cual seria a 1, y la de 5 son 500 pixeles

bien comencemos!

-Creamos un Formulario llamado: frmRenderer con las siguientes propiedades:
*Width: 15525
*Height: 8595
*ScaleMode: 3 - Pixel


-Creamos 2 Picturebox, uno con nombre Picture1 y el otro Picture2, y le ponemos las siguientes propiedades:
*Width:500
*Height:500
*ScaleMode: 3 - Pixel
*BackColor: Negro

(Recuerden dejarlas posicionadas una al lado de la otra)

-Creamos un CommandButton llamado: cmdGuardar y ponemos en:
*Caption: Guardar


-Ahora dentro del codigo del boton ponemos: (deben hacerle doble click al codigo del boton para acceder a el)
Código:
Call Capturar_Imagen(Picture1, Picture2)

Call SavePicture(frmRenderer.Picture2.Image, App.Path & "\Mapa1.bmp")

Unload Me

-En el codigo del formulario que creamos (frmRenderer), en la primera linea deberia decir Option Explicit, sino ustedes lo ponen y debajo ponen:
Código:
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
 
' Recupera la imagen del área del control
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

-Luego al final del codigo del formulario ponen:
Código:
Private Sub Capturar_Imagen(Control As Control, Destino As Object)
 
    Dim hdc As Long
    Dim Escala_Anterior As Integer
    Dim Ancho As Long
    Dim Alto As Long
 
    ' Para que se mantenga la imagen por si se repinta la ventana
    Destino.AutoRedraw = True
 
    On Error Resume Next
    ' Si da error es por que el control está dentro de un Frame _
      ya que  los Frame no tiene  dicha propiedad
    Escala_Anterior = Control.Container.ScaleMode
 
    If Err.Number = 438 Then
       ' Si el control está en un Frame, convierte la escala
       Ancho = ScaleX(Control.Width, vbTwips, vbPixels)
       Alto = ScaleY(Control.Height, vbTwips, vbPixels)
    Else
       ' Si no cambia la escala del  contenedor a pixeles
       Control.Container.ScaleMode = vbPixels
       Ancho = Control.Width
       Alto = Control.Height
    End If
 
    ' limpia el error
    On Error GoTo 0
    ' Captura el área de pantalla correspondiente al control
    hdc = GetWindowDC(Control.hwnd)
    ' Copia esa área al picturebox
    BitBlt Destino.hdc, 0, 0, Ancho, Alto, hdc, 0, 0, vbSrcCopy
    ' Convierte la imagen anterior en un Mapa de bits
    Destino.Picture = Destino.Image
    ' Borra la imagen ya que ahora usa el Picture
    Destino.Cls
 
    On Error Resume Next
    If Err.Number = 0 Then
       ' Si el control no está en un  Frame, restaura la escala del contenedor
       Control.Container.ScaleMode = Escala_Anterior
    End If
 
End Sub


-En Mod_Declaraciones o un modulo cualquiera pongan debajo de Option Explicit:
Código:
Public Radio As Byte

Ahora viene lo jodido, deberia funcionarles creo yo... (espero tengan un engine similar)
-Arriba de:
Código:
Sub Draw_GrhIndex(ByVal grh_index As Integer, ByVal X As Integer, ByVal Y As Integer)

-Ponemos:
Código:
Public Sub Draw_GrhIndexMiniMap(ByVal grh_index As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal PixelWidth As Long, ByVal PixelHeight As Long, ByVal Radio As Integer, Optional ByVal Center As Byte = 0)
If grh_index <= 0 Then Exit Sub
Dim rgb_list(3) As Long

rgb_list(0) = D3DColorXRGB(255, 255, 255)
rgb_list(1) = D3DColorXRGB(255, 255, 255)
rgb_list(2) = D3DColorXRGB(255, 255, 255)
rgb_list(3) = D3DColorXRGB(255, 255, 255)

If Center Then
        If GrhData(grh_index).TileWidth <> 1 Then
            X = X - Int(PixelWidth / 2)
        End If
        If GrhData(grh_index).TileHeight <> 1 Then
            Y = Y - Int(PixelHeight + Radio)
        End If
End If

Device_Box_Textured_RenderTam grh_index, _
X, Y, _
GrhData(grh_index).PixelWidth, GrhData(grh_index).PixelHeight, _
rgb_list, _
GrhData(grh_index).sX, GrhData(grh_index).sY, PixelWidth, PixelHeight

End Sub

-Ahora arriba del sub que agregamos recien, llamado:
Código:
Public Sub Draw_GrhIndexMiniMap(ByVal grh_index As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal PixelWidth As Long, ByVal PixelHeight As Long, ByVal Radio As Integer, Optional ByVal Center As Byte = 0)

-Ponemos:
Código:
Public Sub RenderToPicture()
    Dim Y As Integer
    Dim X As Integer
 
    Dim destRect As RECT
 
    destRect.bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
 
    D3DDevice.BeginScene
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0
 
    'Capa 1 y 2
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
            If MapData(X, Y).Graphic(2).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
        Next X
    Next Y
 
    'Capa 3
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(3).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    'capa 4 (si no quieres techos elimina estos for completos hasta el next)
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(4).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    D3DDevice.EndScene
    D3DDevice.Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
End Sub

-Buscamos:
Código:
Sub Device_Box_Textured_Render

-Arriba Agregamos:
Código:
Public Sub Device_Box_Textured_RenderTam(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 Width As Long, Optional ByVal Height As Long, Optional ByVal alpha_blend As Boolean, Optional ByVal angle As Single)
    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 = SurfaceDB.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 Not char_current_blind Then
        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
    'Else
    '    light_value(0) = &HFFFFFFFF 'blind_color
    '    light_value(1) = &HFFFFFFFF 'blind_color
    '    light_value(2) = &HFFFFFFFF 'blind_color
    '    light_value(3) = &HFFFFFFFF 'blind_color
    'End If
     
    '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 + Height
        .left = dest_x
        .Right = dest_x + 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 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

Ahora Pongan mucha atencion!
en algunos engines de WE salen de una forma y en otros de otra, asi que hagamos los ultimos pasos

-Buscan(en algunos engine es algo similar):
Código:
If Chkflag = 3 Then

-Debajo de:
Código:
Call RenderScreen(UserPos.X - AddtoUserPos.X, UserPos.y - AddtoUserPos.y, OffsetCounterX, OffsetCounterY)

O

-Buscan (En otros engines es asi o puede salir engine.RenderScreen):
Código:
engine.Render

-Debajo Ponen:
Código:
If frmRenderer.Visible Then engine.RenderToPicture

Y finalmente agregan un commandbutton en su frmMain del WE o sino lo agregan al menu ven ustedes! con este codigo dentro:
Código:
Radio = Val(InputBox("Escriba la escala de 1 a 5 en la que generemos su mapa", "la escala se multiplica x 32"))
If Radio = 0 Then Radio = 1

frmRenderer.Picture1.Width = (Radio * 100)
frmRenderer.Picture1.Height = (Radio * 100)

frmRenderer.Picture2.Width = (Radio * 100)
frmRenderer.Picture2.Height = (Radio * 100)

frmRenderer.Show

Y Listo!

NOTA: Si ustedes no tienen el clsDX8Engine entonces en la parte que diga: engine.RenderToPicture borran el engine. dejandolo asi: RenderToPicture

espero les sirva n.n
Salu2s

(si saben como poner en el foro el VBCode me dicen por q hace años q no vengo aqui o_O)

ACTUALIZACION: 12/25/17 4:06am
cambie el nombre del Sub grhindexTam por grhindexMinimap y arregle varios bugs, ahora se ve mas bonito n.n (tambien agregue una nueva funcion)
 
Última edición:

Gastin.-

COME BACK BABY
Gracias me funciono pero tengo 1 problema esta mal acomodado los layer 3 y 4

te paso los subs


Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
    Dim destRect As RECT
 
    destRect.Bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
        
    With ddevice
        .BeginScene
        .Clear 0, ByVal 0, D3DCLEAR_TARGET, Color, 1#, 0
    End With

    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(1), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(2).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(2), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(3).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(3), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(4).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(4), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
        Next X
    Next Y

    With ddevice
        .EndScene
        .Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
    End With

End Sub


Código:
Public Sub Grh_Render_minimap(ByRef Grh As Grh, ByVal screen_x As Long, ByVal screen_y As Long, ByVal PixelWidth As Integer, ByVal PixelHeight As Integer, ByRef rgb_list() As Long, Optional ByVal center As Boolean)
'**************************************************************
'Author: Aaron Perkins
'Last Modify Date: 2/28/2003
'
'**************************************************************
    Dim tile_width As Single
    Dim tile_height As Single
    Dim grh_index As Long

  
    If Grh.grh_index = 0 Then Exit Sub
  
    'Animation
    If Grh.Started Then
        Grh.frame_counter = Grh.frame_counter + (timer_ticks_per_frame * Grh.frame_speed / 1000)
        If Grh.frame_counter > Grh_list(Grh.grh_index).frame_count Then
            If Grh.LoopTimes < 2 Then
                Grh.frame_counter = 1
                Grh.Started = False
            Else
                Grh.frame_counter = 1
                If Grh.LoopTimes <> LoopAdEternum Then
                    Grh.LoopTimes = Grh.LoopTimes - 1
                End If
            End If
        End If
    End If
  
    'Figure out what frame to draw (always 1 if not animated)
    If Grh.frame_counter <= 0 Then Grh.frame_counter = 1
    grh_index = Grh_list(Grh.grh_index).frame_list(Grh.frame_counter)
  
    If grh_index = 0 Then Exit Sub 'This is an error condition
  
    'Center Grh over X,Y pos
    If center Then
        tile_width = Grh_list(grh_index).src_width / base_tile_size
        tile_height = Grh_list(grh_index).src_height / base_tile_size
        If tile_width <> 1 Then
            screen_x = screen_x - Int(tile_width * base_tile_size / 2) + base_tile_size / 2
        End If
        If tile_height <> 1 Then
            screen_y = screen_y - Int(tile_height * base_tile_size) + base_tile_size
        End If
    End If
  
    'Draw it to device
    DXEngine_TextureRender Grh_list(grh_index).texture_index, _
        screen_x, screen_y, _
        Grh_list(grh_index).src_width, Grh_list(grh_index).src_height, _
        rgb_list, _
        Grh_list(grh_index).Src_X, Grh_list(grh_index).Src_Y, _
        PixelWidth, PixelHeight, _
        Grh.alpha_blend, _
        Grh.angle
End Sub

WQW3vlg.png


como podes ver los layer 4 no estan o estan pedazitos de ellos en cualquier lado y algunos layer 3 estan desacomodados
 

xCrisx1

MarciAno
Gracias me funciono pero tengo 1 problema esta mal acomodado los layer 3 y 4

te paso los subs


Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
    Dim destRect As RECT
 
    destRect.Bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
     
    With ddevice
        .BeginScene
        .Clear 0, ByVal 0, D3DCLEAR_TARGET, Color, 1#, 0
    End With

    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(1), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(2).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(2), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(3).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(3), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(4).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(4), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
        Next X
    Next Y

    With ddevice
        .EndScene
        .Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
    End With

End Sub


Código:
Public Sub Grh_Render_minimap(ByRef Grh As Grh, ByVal screen_x As Long, ByVal screen_y As Long, ByVal PixelWidth As Integer, ByVal PixelHeight As Integer, ByRef rgb_list() As Long, Optional ByVal center As Boolean)
'**************************************************************
'Author: Aaron Perkins
'Last Modify Date: 2/28/2003
'
'**************************************************************
    Dim tile_width As Single
    Dim tile_height As Single
    Dim grh_index As Long

 
    If Grh.grh_index = 0 Then Exit Sub
 
    'Animation
    If Grh.Started Then
        Grh.frame_counter = Grh.frame_counter + (timer_ticks_per_frame * Grh.frame_speed / 1000)
        If Grh.frame_counter > Grh_list(Grh.grh_index).frame_count Then
            If Grh.LoopTimes < 2 Then
                Grh.frame_counter = 1
                Grh.Started = False
            Else
                Grh.frame_counter = 1
                If Grh.LoopTimes <> LoopAdEternum Then
                    Grh.LoopTimes = Grh.LoopTimes - 1
                End If
            End If
        End If
    End If
 
    'Figure out what frame to draw (always 1 if not animated)
    If Grh.frame_counter <= 0 Then Grh.frame_counter = 1
    grh_index = Grh_list(Grh.grh_index).frame_list(Grh.frame_counter)
 
    If grh_index = 0 Then Exit Sub 'This is an error condition
 
    'Center Grh over X,Y pos
    If center Then
        tile_width = Grh_list(grh_index).src_width / base_tile_size
        tile_height = Grh_list(grh_index).src_height / base_tile_size
        If tile_width <> 1 Then
            screen_x = screen_x - Int(tile_width * base_tile_size / 2) + base_tile_size / 2
        End If
        If tile_height <> 1 Then
            screen_y = screen_y - Int(tile_height * base_tile_size) + base_tile_size
        End If
    End If
 
    'Draw it to device
    DXEngine_TextureRender Grh_list(grh_index).texture_index, _
        screen_x, screen_y, _
        Grh_list(grh_index).src_width, Grh_list(grh_index).src_height, _
        rgb_list, _
        Grh_list(grh_index).Src_X, Grh_list(grh_index).Src_Y, _
        PixelWidth, PixelHeight, _
        Grh.alpha_blend, _
        Grh.angle
End Sub

WQW3vlg.png


como podes ver los layer 4 no estan o estan pedazitos de ellos en cualquier lado y algunos layer 3 estan desacomodados

Este Sub:
Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
    Dim destRect As RECT
    destRect.Bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
    
    With ddevice
        .BeginScene
        .Clear 0, ByVal 0, D3DCLEAR_TARGET, Color, 1#, 0
    End With
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(1), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(2).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(2), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(3).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(3), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(4).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(4), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
        Next X
    Next Y
    With ddevice
        .EndScene
        .Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
    End With
End Sub

Remplazalo por este:
Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
 
    Dim destRect As RECT
 
    destRect.bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
 
    D3DDevice.BeginScene
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0
 
    'Capa 1 y 2
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
            If MapData(X, Y).Graphic(2).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
        Next X
    Next Y
 
    'Capa 3
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(3).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    'capa 4 (si no quieres techos elimina estos for completos hasta el next)
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(4).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    D3DDevice.EndScene
    D3DDevice.Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
End Sub

y en vez del Sub Draw_GrhIndexTam (remplazalo o borra este sub y agrega el siguiente) agregas este:
Código:
Public Sub Draw_GrhIndexMiniMap(ByVal grh_index As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal PixelWidth As Long, ByVal PixelHeight As Long, ByVal Radio As Integer, Optional ByVal Center As Byte = 0)
If grh_index <= 0 Then Exit Sub
Dim rgb_list(3) As Long

rgb_list(0) = D3DColorXRGB(255, 255, 255)
rgb_list(1) = D3DColorXRGB(255, 255, 255)
rgb_list(2) = D3DColorXRGB(255, 255, 255)
rgb_list(3) = D3DColorXRGB(255, 255, 255)

If Center Then
        If GrhData(grh_index).TileWidth <> 1 Then
            X = X - Int(PixelWidth / 2)
        End If
        If GrhData(grh_index).TileHeight <> 1 Then
            Y = Y - Int(PixelHeight + Radio)
        End If
End If

Device_Box_Textured_RenderTam grh_index, _
X, Y, _
GrhData(grh_index).PixelWidth, GrhData(grh_index).PixelHeight, _
rgb_list, _
GrhData(grh_index).sX, GrhData(grh_index).sY, PixelWidth, PixelHeight

End Sub

y arriba de:
Código:
Sub Device_Box_Textured_Render(

Pones:
Código:
Public Sub Device_Box_Textured_RenderTam(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 Width As Long, Optional ByVal Height As Long, Optional ByVal alpha_blend As Boolean, Optional ByVal angle As Single)
    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 = SurfaceDB.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 Not char_current_blind Then
        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
    'Else
    '    light_value(0) = &HFFFFFFFF 'blind_color
    '    light_value(1) = &HFFFFFFFF 'blind_color
    '    light_value(2) = &HFFFFFFFF 'blind_color
    '    light_value(3) = &HFFFFFFFF 'blind_color
    'End If
     
    '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 + Height
        .left = dest_x
        .Right = dest_x + 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 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

Y Listo!! :D
gracias por avisar de mi error, la verdad es que ni yo me di cuenta, y como estamos en fecha de navidad pues no pude responder antes :3, lo testee desde un cliente dx8 ahora, asi que no deberias tener problemas n.n
suerte ^^

EDIT: porsia, el Sub Device_Box_Textured_RenderTam te sirve para renderizar imagenes agrandandolas o achicandolas en cualquier tamaño, si lo usas bien por ejemplo podrias hacer lo q yo aagregare en mi game que es (bichos de diferentes tamaños, bichos jefes que aparezcan de vez en cuando aumentando el tamaño y potenciados, etc) suerte n.n
 
Última edición:

Gastin.-

COME BACK BABY
Este Sub:
Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
    Dim destRect As RECT
    destRect.Bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
   
    With ddevice
        .BeginScene
        .Clear 0, ByVal 0, D3DCLEAR_TARGET, Color, 1#, 0
    End With
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(1), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(2).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(2), (X * Radio) - Radio, (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(3).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(3), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
            If MapData(X, Y).Graphic(4).grh_index > 0 Then modGrh.Grh_Render_minimap MapData(X, Y).Graphic(4), (X * Radio), (Y * Radio) - Radio, Radio, Radio, MapData(X, Y).light_value, True
        Next X
    Next Y
    With ddevice
        .EndScene
        .Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
    End With
End Sub

Remplazalo por este:
Código:
Public Sub MapCapture()
    Dim Y As Integer
    Dim X As Integer
 
    Dim destRect As RECT
 
    destRect.bottom = 100 * Radio
    destRect.Right = 100 * Radio
    destRect.left = 0
    destRect.top = 0
 
    D3DDevice.BeginScene
    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0
 
    'Capa 1 y 2
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(1).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(1).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
            If MapData(X, Y).Graphic(2).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1), (X * Radio) - Radio, (Y * Radio) - Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(2).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio
        Next X
    Next Y
 
    'Capa 3
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(3).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(3).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    'capa 4 (si no quieres techos elimina estos for completos hasta el next)
    For Y = 1 To 100
        For X = 1 To 100
            If MapData(X, Y).Graphic(4).grhindex > 0 Then Draw_GrhIndexMiniMap GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1), (X * Radio) - (Radio / 2), (Y * Radio) + Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelWidth / 32) * Radio, (GrhData(GrhData(MapData(X, Y).Graphic(4).grhindex).Frames(1)).PixelHeight / 32) * Radio, Radio, 1
        Next X
    Next Y
 
    D3DDevice.EndScene
    D3DDevice.Present destRect, ByVal 0, frmRenderer.Picture1.hwnd, ByVal 0
End Sub

y en vez del Sub Draw_GrhIndexTam (remplazalo o borra este sub y agrega el siguiente) agregas este:
Código:
Public Sub Draw_GrhIndexMiniMap(ByVal grh_index As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal PixelWidth As Long, ByVal PixelHeight As Long, ByVal Radio As Integer, Optional ByVal Center As Byte = 0)
If grh_index <= 0 Then Exit Sub
Dim rgb_list(3) As Long

rgb_list(0) = D3DColorXRGB(255, 255, 255)
rgb_list(1) = D3DColorXRGB(255, 255, 255)
rgb_list(2) = D3DColorXRGB(255, 255, 255)
rgb_list(3) = D3DColorXRGB(255, 255, 255)

If Center Then
        If GrhData(grh_index).TileWidth <> 1 Then
            X = X - Int(PixelWidth / 2)
        End If
        If GrhData(grh_index).TileHeight <> 1 Then
            Y = Y - Int(PixelHeight + Radio)
        End If
End If

Device_Box_Textured_RenderTam grh_index, _
X, Y, _
GrhData(grh_index).PixelWidth, GrhData(grh_index).PixelHeight, _
rgb_list, _
GrhData(grh_index).sX, GrhData(grh_index).sY, PixelWidth, PixelHeight

End Sub

y arriba de:
Código:
Sub Device_Box_Textured_Render(

Pones:
Código:
Public Sub Device_Box_Textured_RenderTam(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 Width As Long, Optional ByVal Height As Long, Optional ByVal alpha_blend As Boolean, Optional ByVal angle As Single)
    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 = SurfaceDB.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 Not char_current_blind Then
        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
    'Else
    '    light_value(0) = &HFFFFFFFF 'blind_color
    '    light_value(1) = &HFFFFFFFF 'blind_color
    '    light_value(2) = &HFFFFFFFF 'blind_color
    '    light_value(3) = &HFFFFFFFF 'blind_color
    'End If
    
    '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 + Height
        .left = dest_x
        .Right = dest_x + 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 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

Y Listo!! :D
gracias por avisar de mi error, la verdad es que ni yo me di cuenta, y como estamos en fecha de navidad pues no pude responder antes :3, lo testee desde un cliente dx8 ahora, asi que no deberias tener problemas n.n
suerte ^^

EDIT: porsia, el Sub Device_Box_Textured_RenderTam te sirve para renderizar imagenes agrandandolas o achicandolas en cualquier tamaño, si lo usas bien por ejemplo podrias hacer lo q yo aagregare en mi game que es (bichos de diferentes tamaños, bichos jefes que aparezcan de vez en cuando aumentando el tamaño y potenciados, etc) suerte n.n

Muchas gracias ya lo solucione! fotito :D
tcgWA0x.png
 

Dr. Miqueas150

The Prophet
Ex-Staff
  1. Dim rgb_list(3) As Long

  2. rgb_list(0) = D3DColorXRGB(255, 255, 255)
  3. rgb_list(1) = D3DColorXRGB(255, 255, 255)
  4. rgb_list(2) = D3DColorXRGB(255, 255, 255)
  5. rgb_list(3) = D3DColorXRGB(255, 255, 255)
Cambiando eso por la que usan para darle color al mapa, ya les va a dibujar los lugares donde hay luces en el mapa

En cuanto a las partículas y animaciones que dijeron por hay arriba, quedaría para el orto algo asi estático en la imagen, seria mas molesto que algo embellecedor.
 

Agushh

MR BROWNSTONE
Gracias por el aporte. Cuál es el peso final de la imágen que guardas?, sé que depende de cada mapa, pero aproximadamente?
 

xCrisx1

MarciAno
Gracias por el aporte. Cuál es el peso final de la imágen que guardas?, sé que depende de cada mapa, pero aproximadamente?
en BMP(que es el que pesa mas):
-En potencia 1 pesa aproximadamente 32kb, no llega mas de 40 kb
-En potencia 5 pesa unos 800kb aproximadamente, y no mas de 1mb (es tedioso revisar en la potencia 2,3 y 4 xD)

si quieres alivianar y bajar un poc mas la calidad puedes remplazar el .bmp por .jpg y listo, ya pesaria menos :p

((recuerda, potencia> 1 = 100pixeles, 2 = 200 pixeles, 3 = 300 pixeles y asi.., osea es el tamaño de la imagen en cuanto a el Ancho y la Altura))
 
Arriba