[Aporte] IAO clon con Inframundo

Código:

Private Function CrearGrafico

Código:

Private Function CrearGrafico(ByVal Archivo As Integer, _
                              ByRef texwidth As Long, _
                              ByRef textheight As Long) As Direct3DTexture8
 
    '**************************************************************
  'Author: Juan Martín Sotuyo Dodero
    'menduz was here
  '
    '**************************************************************
  'On Error GoTo Err
    Dim surface_desc As D3DSURFACE_DESC
    Dim texture_info As D3DXIMAGE_INFO
    Dim Index        As Integer
 
    Index = Archivo Mod HASH_TABLE_SIZE
 
    With TexList(Index)
        .surfaceCount = .surfaceCount + 1
        ReDim Preserve .SurfaceEntry(1 To .surfaceCount) As SURFACE_ENTRY_DYN
 
        With .SurfaceEntry(.surfaceCount)
     
            .FileName = Archivo
 
            .UltimoAcceso = GetTickCount
         
            Set .Texture = D3DX.CreateTextureFromFileEx(device, _
            App.Path & "\GRAFICOS\" & CStr(Archivo) & ".bmp", _
            D3DX_DEFAULT, D3DX_DEFAULT, 3, 0, D3DFMT_A8R8G8B8, _
            D3DPOOL_MANAGED, D3DX_FILTER_NONE, D3DX_FILTER_NONE, _
            &HFF000000, texture_info, ByVal 0)
 
            .Texture.GetLevelDesc 0, surface_desc
            .texture_width = texture_info.width
            .texture_height = texture_info.height
            .size = surface_desc.size
            texwidth = .texture_width
            textheight = .texture_height
         
            Set CrearGrafico = .Texture
            mFreeMemoryBytes = mFreeMemoryBytes - surface_desc.size
 
            Do While mFreeMemoryBytes < 0
 
                If Not RemoveLRU() Then
 
                    Exit Do
 
                End If
 
            Loop
 
            Exit Function
 
Err:
            Debug.Print "ERROR EN GRHLOAD>" & Archivo & ".bmp" & "-Desc:" & Err.Description
        End With
    End With
 
End Function

Saurus escribió:y los npcs ?