Descompresión de graficos directos en memoria

» 01 Sep 2011 19:20

Bueno, me pidieron este aporte, y me gustó la idea asi que lo aporto.

Explicación: A la hora de descomprimir los gráficos para leerlos, teniendo que crear un grafico nuevo y borrarlo cada vez, ahora podemos usarlo de forma que no haya necesidad de que nos lo descomprima en el disco, asi ganamos algo de seguridad ante los recursos.

Nota: Para implementar este codigo es necesario tener implementado antes el codigo de compresión de graficos y lectura.

Nota2: Está hecho para Directx8, pero es facilmente aplicable a Directx7, solo cambia una llamada.

Asi que empezamos, todo en el cliente.

Abrimos el modulo zlib.bas y lo remplazamos entero por este:

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Option Explicit
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, FreeBytesToCaller As Currency, BytesTotal As Currency, FreeBytesTotal As Currency) As Long
 
Public Type FILEHEADER
    lngFileSize As Long
    intNumFiles As Integer
End Type
 
Public Type INFOHEADER
    lngFileStart As Long
    lngFileSize As Long
    strFileName As String * 16
    lngFileSizeUncompressed As Long
End Type
 
Public Temp_Windows_Directory As String
 
Public Enum resource_file_type
    graphics
    Interface
End Enum
 
Private Const GRAPHIC_PATH As String = "\BMP\"
Private Const GRAPHIC_PNG_PATH As String = "\PNG\"
Private Const MIDI_PATH As String = "\Midi\"
Private Const MP3_PATH As String = "\Mp3\"
Private Const WAV_PATH As String = "\Wav\"
Private Const MAP_PATH As String = "\Mapas\"
Private Const INTERFACE_PATH As String = "\Interface\"
Private Const SCRIPT_PATH As String = "\Init\"
Private Const PATCH_PATH As String = "\Patches\"
Private Const OUTPUT_PATH As String = "\Output\"
 
Private Declare Function Compress Lib "zlib.dll" Alias "compress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function UnCompress Lib "zlib.dll" Alias "uncompress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
 
Private Const MAX_LENGTH = 512
 
Public Sub Compress_Data(ByRef Data() As Byte)
    Dim Dimensions As Long
    Dim DimBuffer As Long
    Dim BufTemp() As Byte
    Dim BufTemp2() As Byte
    Dim LoopC As Long
   
    Dimensions = UBound(Data)
    DimBuffer = Dimensions * 1.06
   
    ReDim BufTemp(DimBuffer)
    Compress BufTemp(0), DimBuffer, Data(0), Dimensions
    Erase Data
   
    ReDim Preserve BufTemp(DimBuffer - 1)
    Data = BufTemp
    Erase BufTemp
   
    Data(0) = Data(0) Xor 166
End Sub
 
Public Sub Decompress_Data(ByRef Data() As Byte, ByVal OrigSize As Long)
    Dim BufTemp() As Byte
   
    ReDim BufTemp(OrigSize - 1)
    Data(0) = Data(0) Xor 166
    UnCompress BufTemp(0), OrigSize, Data(0), UBound(Data) + 1
   
    ReDim Data(OrigSize - 1)
    Data = BufTemp
    Erase BufTemp
End Sub
Public Function Extract_File(ByVal file_type As resource_file_type, ByVal resource_path As String, ByVal File_Name As String, ByVal OutputFilePath As String) As Boolean
   
    Dim LoopC As Long
    Dim SourceFilePath As String
    Dim SourceData() As Byte
    Dim InfoHead As INFOHEADER
    Dim handle As Integer
   
On Local Error GoTo ErrHandler
   
    Select Case file_type
 
        Case graphics
                SourceFilePath = resource_path & "\Graficos.pak"
           
        Case Interface
                SourceFilePath = resource_path & "\Interface.pak"
       
        Case Else
            Exit Function
    End Select
   
    InfoHead = File_Find(SourceFilePath, File_Name)
   
    If InfoHead.strFileName = "" Or InfoHead.lngFileSize = 0 Then Exit Function
 
    handle = FreeFile
    Open SourceFilePath For Binary Access Read Lock Write As handle
   
    If InfoHead.lngFileSizeUncompressed > General_Drive_Get_Free_Bytes(Left$(App.Path, 3)) Then
        Close handle
        MsgBox "There is not enough drive space to extract the compressed file.", , "Error"
        Exit Function
    End If
   
   
    ReDim SourceData(InfoHead.lngFileSize - 1)
   
    Get handle, InfoHead.lngFileStart, SourceData
        Decompress_Data SourceData, InfoHead.lngFileSizeUncompressed
    Close handle
   
    handle = FreeFile
    Open OutputFilePath & InfoHead.strFileName For Binary As handle
        Put handle, 1, SourceData
    Close handle
   
    Erase SourceData
       
    Extract_File = True
Exit Function
 
ErrHandler:
    Close handle
    Erase SourceData
End Function
 
Public Function Extract_File_Memory(ByVal file_type As resource_file_type, ByVal resource_path As String, ByVal File_Name As String, byref SourceData() As Byte) As Boolean
 
    ' Parra was here (;
    Dim LoopC As Long
    Dim SourceFilePath As String
    Dim InfoHead As INFOHEADER
    Dim handle As Integer
   
On Local Error GoTo ErrHandler
   
    Select Case file_type
 
        Case graphics
                SourceFilePath = resource_path & "\Graficos.pak"
           
        Case Interface
                SourceFilePath = resource_path & "\Interface.pak"
       
        Case Else
            Exit Function
    End Select
   
    InfoHead = File_Find(SourceFilePath, File_Name)
   
    If InfoHead.strFileName = "" Or InfoHead.lngFileSize = 0 Then Exit Function
 
    handle = FreeFile
    Open SourceFilePath For Binary Access Read Lock Write As handle
   
    If InfoHead.lngFileSizeUncompressed > General_Drive_Get_Free_Bytes(Left$(App.Path, 3)) Then
        Close handle
        MsgBox "There is not enough drive space to extract the compressed file.", , "Error"
        Exit Function
    End If
   
   
    ReDim SourceData(InfoHead.lngFileSize - 1)
   
    Get handle, InfoHead.lngFileStart, SourceData
        Decompress_Data SourceData, InfoHead.lngFileSizeUncompressed
    Close handle
       
    Extract_File_Memory = True
Exit Function
 
ErrHandler:
    Close handle
    Erase SourceData
End Function
 
Public Sub Delete_File(ByVal file_path As String)
    Dim handle As Integer
    Dim Data() As Byte
   
    On Error GoTo Error_Handler
   
    handle = FreeFile
    Open file_path For Binary Access Write Lock Read As handle
   
    ReDim Data(LOF(handle) - 1)
    Put handle, 1, Data
   
    Close handle
   
    Kill file_path
   
    Exit Sub
   
Error_Handler:
    Kill file_path
       
End Sub
 
Public Function File_Find(ByVal resource_file_path As String, ByVal File_Name As String) As INFOHEADER
 
On Error GoTo ErrHandler
 
    Dim Max As Integer
    Dim Min As Integer
    Dim mid As Integer
    Dim file_handler As Integer
   
    Dim file_head As FILEHEADER
    Dim info_head As INFOHEADER
   
    If Len(File_Name) < Len(info_head.strFileName) Then _
        File_Name = File_Name & Space$(Len(info_head.strFileName) - Len(File_Name))
   
    file_handler = FreeFile
    Open resource_file_path For Binary Access Read Lock Write As file_handler
   
    Get file_handler, 1, file_head
   
    Min = 1
    Max = file_head.intNumFiles
   
    Do While Min <= Max
        mid = (Min + Max) / 2
       
        Get file_handler, CLng(Len(file_head) + CLng(Len(info_head)) * CLng((mid - 1)) + 1), info_head
               
        If File_Name < info_head.strFileName Then
            If Max = mid Then
                Max = Max - 1
            Else
                Max = mid
            End If
        ElseIf File_Name > info_head.strFileName Then
            If Min = mid Then
                Min = Min + 1
            Else
                Min = mid
            End If
        Else
            File_Find = info_head
           
            Close file_handler
            Exit Function
        End If
    Loop
   
ErrHandler:
    Close file_handler
    File_Find.strFileName = ""
    File_Find.lngFileSize = 0
End Function
 
Public Function General_Get_Temp_Dir() As String
   Dim s As String
   Dim c As Long
   s = Space$(MAX_LENGTH)
   c = GetTempPath(MAX_LENGTH, s)
   If c > 0 Then
       If c > Len(s) Then
           s = Space$(c + 1)
           c = GetTempPath(MAX_LENGTH, s)
       End If
   End If
   General_Get_Temp_Dir = IIf(c > 0, Left$(s, c), "")
End Function
Public Sub General_Quick_Sort(ByRef SortArray As Variant, ByVal first As Long, ByVal last As Long)
    Dim Low As Long, High As Long
    Dim temp As Variant
    Dim List_Separator As Variant
   
    Low = first
    High = last
    List_Separator = SortArray((first + last) / 2)
    Do While (Low <= High)
        Do While SortArray(Low) < List_Separator
            Low = Low + 1
        Loop
        Do While SortArray(High) > List_Separator
            High = High - 1
        Loop
        If Low <= High Then
            temp = SortArray(Low)
            SortArray(Low) = SortArray(High)
            SortArray(High) = temp
            Low = Low + 1
            High = High - 1
        End If
    Loop
    If first < High Then General_Quick_Sort SortArray, first, High
    If Low < last Then General_Quick_Sort SortArray, Low, last
End Sub
 
Public Function General_Drive_Get_Free_Bytes(ByVal DriveName As String) As Currency
    Dim RetVal As Long
    Dim FB As Currency
    Dim BT As Currency
    Dim FBT As Currency
   
    RetVal = GetDiskFreeSpace(Left(DriveName, 2), FB, BT, FBT)
   
    General_Drive_Get_Free_Bytes = FB * 10000
End Function
 
Public Function Get_Extract(ByVal file_type As resource_file_type, ByVal File_Name As String) As String
    Extract_File file_type, App.Path & "\Recursos\Graficos", LCase$(File_Name), App.Path & "\Recursos\amdInData\"
    Get_Extract = App.Path & "\Recursos\amdInData\" & LCase$(File_Name)
End Function
Public Function Get_Interface(ByVal file_type As resource_file_type, ByVal File_Name As String) As String
    Extract_File file_type, App.Path & "\Recursos\Interface", LCase$(File_Name), App.Path & "\Recursos\Interface\"
    Get_Interface = App.Path & "\Recursos\Interface\" & LCase$(File_Name)
End Function

Luego, podrán encontrar en este modulo todos los paths del cliente, por ejemplo:

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

        Case graphics
                SourceFilePath = resource_path & "\Graficos.pak"
           
        Case Interface
                SourceFilePath = resource_path & "\Interface.pak"

Remplazan .pak por su extension, o si tienen los paths ordenados de otra forma cambienlos.

Ahora buscan esta parte del codigo:

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Dim InfoHead As INFOHEADER
    Dim file As String
 
            InfoHead = File_Find(App.Path & "\Recursos\Graficos\Graficos.TLAO", CStr(Archivo) & ".png")
           
        If InfoHead.lngFileSize <> 0 Then
            file = zLib.Get_Extract(graphics, CStr(Archivo) & ".png")
           
            Set .texture = mD3D.CreateTextureFromFileEx(device, file, _
                D3DX_DEFAULT, D3DX_DEFAULT, 0, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, D3DX_FILTER_POINT, _
                D3DX_FILTER_NONE, &HFF000000, texture_info, ByVal 0)
                                               
        End If

Y lo reemplazan por esta:

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

    Dim InfoHead As INFOHEADER
    dim Buffer() As Byte
    
    InfoHead = File_Find(App.Path & "\Recursos\Graficos\Graficos.pak", CStr(Archivo) & ".png")
    
    If InfoHead.lngFileSize <> 0 Then
                ' Parra was here (;
        Extract_File_Memory graphics, App.Path & "\Recursos\Graficos", LCase$(CStr(Archivo) & ".png"), Buffer()
            
        Set .texture = mD3D.CreateTextureFromFileInMemoryEx(device, Buffer(0), UBound(Buffer()) + 1, D3DX_DEFAULT, _
                                                            D3DX_DEFAULT, 0, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, _
                                                            D3DX_FILTER_POINT, D3DX_FILTER_NONE, _
                                                            &HFF000000, texture_info, ByVal 0)
        Erase Buffer
    End If

De nuevo, cambiamos el formato ".png" por el nuestro. Es customizable.

Finalmente, para las interfaces podemos hacer exactamente lo mismo, y nos funcionaria. Aunque habria que ver la manera de cargarlas. Pero si quieren esas pueden dejarlas como estan ahora.

Si no funciona el codigo, avisen, y lo reviso! Suerte, y a disfrutarlo!

» 01 Sep 2011 20:22

Gracias Parra en todo. Siempre ayudando a TLAO,

Ya lo probamos y te avisamos.

» 01 Sep 2011 21:44

I love You PARRA (L

Se te agradece, yo estaba intentando hacerlo con el CreateTextureFromFileInMemory y no entendia muy bien cual era la data para la funcion.

Muchas gracias.

Edit: Anda perfecto, aclaremos que el codigo de extraccion mediante la Zlib.bas ( para el que no lo tiene ) Va en la funcion CrearGrafico

» 02 Sep 2011 07:25

Mafia escribió:I love You PARRA (L

Se te agradece, yo estaba intentando hacerlo con el CreateTextureFromFileInMemory y no entendia muy bien cual era la data para la funcion.

Muchas gracias.

Edit: Anda perfecto, aclaremos que el codigo de extraccion mediante la Zlib.bas ( para el que no lo tiene ) Va en la funcion CrearGrafico

Fantastico, espero que les sirva de mucho. Si tienen algun problema avisen, y si necesitan algun consejo mas tambien!

» 02 Sep 2011 09:55

Se crean y se dejan en memoria? Al poco tiempo chau memoria si es asi

» 02 Sep 2011 10:07

Vernet escribió:Se crean y se dejan en memoria? Al poco tiempo chau memoria si es asi

Grave error, se nota que ni has leido el codigo.

Una vez lo carga el buffer se libera, dejando la memoria libre, y simplemente cargandolo en DirectX. Luego el sistema de memoria dinámica de AO ya se encarga de hacer todo lo demás.

Fijate en la linea esta:

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo

Erase Buffer

Edit: Otra cosa Mafia, has chequeado si es más rapido de esta forma? Deberia de funcionar mas rapido, fijate que ahora nos evitamos algo de codigo, y es mas directo..

» 02 Sep 2011 12:46

•Parra escribió:
Vernet escribió:Se crean y se dejan en memoria? Al poco tiempo chau memoria si es asi

Grave error, se nota que ni has leido el codigo.

Una vez lo carga el buffer se libera, dejando la memoria libre, y simplemente cargandolo en DirectX. Luego el sistema de memoria dinámica de AO ya se encarga de hacer todo lo demás.

Fijate en la linea esta:
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
Erase Buffer

Edit: Otra cosa Mafia, has chequeado si es más rapido de esta forma? Deberia de funcionar mas rapido, fijate que ahora nos evitamos algo de codigo, y es mas directo..

Entonces no peligra en nada la memoria, o si?

» 02 Sep 2011 12:59

[JuliaaN] escribió:
•Parra escribió:
Vernet escribió:Se crean y se dejan en memoria? Al poco tiempo chau memoria si es asi

Grave error, se nota que ni has leido el codigo.

Una vez lo carga el buffer se libera, dejando la memoria libre, y simplemente cargandolo en DirectX. Luego el sistema de memoria dinámica de AO ya se encarga de hacer todo lo demás.

Fijate en la linea esta:
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
Erase Buffer

Edit: Otra cosa Mafia, has chequeado si es más rapido de esta forma? Deberia de funcionar mas rapido, fijate que ahora nos evitamos algo de codigo, y es mas directo..

Entonces no peligra en nada la memoria, o si?

No, la memoria no, no pasa nada, se limpia el buffer cada tanto, yo le pregunté a Parra si pasaba por valor las cosas ya que no leí el código y me dijo que no asi que en este caso no es problema

Mi Canal YouTube · » 02 Sep 2011 13:56

siempre impresionando con cosas nueva parra jaja

gracias

» 02 Sep 2011 17:13

Ya me parecia, lo habia leido muy por arriba y no vi esa linea

saludos

» 03 Sep 2011 15:32

Buen aporte Parra, me podrias pasar el aporte posterior a este.

Saludos

» 03 Sep 2011 18:33

Muy bueno parra. Realmente my buenoo

» 04 Sep 2011 03:04

Buenisimo Parra , siempre aportando a la comunidad!

» 04 Sep 2011 17:20

Samke escribió:Buen aporte Parra, me podrias pasar el aporte posterior a este.

Saludos

Te refieres al de compresion? Al anterior? Pues no se donde debe estar, seguro que está aportado.. pero igualmente, puedes extraerlo de ORE, usando su compressor también. Igual creo que solo implementando este quizás ya sea funcional, aunque no estoy seguro.

» 10 Sep 2011 01:32

Deberia de ir unas mil veces mas rapido en cada operacion. El disco duro trabaja en ms y la ram en ns por lo que si directamente descomprimimos en memoria y planchamos desde ahi, tendria que ser en verdad mucho mas rapido.
Buen aporte Parra!

Descompresión de graficos directos en memoria

¿Quién está conectado?