Carga Comun de Init y Graficos

» 01 Feb 2012 20:43

Bueno, como hay que dar muchas vueltas para indexar y demas, ami no me gusta la carga de Graficos1.ind, Graficos2.ind y Graficos3.ind y los graficos comprimidos, aca les dejo como sacar, y dejarlo como en la 12.x

Cliente:

Sacamos el modCompression y remplazamos clsSurfaceManDyn por:

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

'**************************************************************
' clsSurfaceManDyn.cls - Inherits from clsSurfaceManager. Is designed to load
'surfaces dynamically without using more than an arbitrary amount of Mb.
'For removale it uses LRU, attempting to just keep in memory those surfaces
'that are actually usefull.
'
' Developed by Maraxus (Juan Martín Sotuyo Dodero - juansotuyo@hotmail.com)
' Last Modify Date: 3/06/2006
'**************************************************************
 
'**************************************************************
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'Affero General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'Argentum Online is based on Baronsoft's VB6 Online RPG
'You can contact the original creator of ORE at aaron@baronsoft.com
'for more information about ORE please visit http://www.baronsoft.com/
'**************************************************************
 
Option Explicit
 
'Inherit from the surface manager
Implements clsSurfaceManager
 
Private Const BYTES_PER_MB As Long = 1048576                        '1Mb = 1024 Kb = 1024 * 1024 bytes = 1048576 bytes
Private Const MIN_MEMORY_TO_USE As Long = 4 * BYTES_PER_MB          '4 Mb
Private Const DEFAULT_MEMORY_TO_USE As Long = 16 * BYTES_PER_MB     '16 Mb
 
Private Type SURFACE_ENTRY_DYN
    fileIndex As Long
    lastAccess As Long
    Surface As DirectDrawSurface7
End Type
 
Private surfaceList() As SURFACE_ENTRY_DYN
Private surfaceCount As Long
 
Private surfaceIndexes() As Long
Private surfaceIndexCount As Long
 
Private DirectDraw As DirectDraw7
 
Private maxBytesToUse As Long
Private usedBytes As Long
 
Private useVideoMemory As Boolean
 
Private GrhPath As String
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByRef source As Any, ByVal byteCount As Long)
 
Private Sub Class_Initialize()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'
'**************************************************************
    usedBytes = 0
    surfaceCount = 0
    surfaceIndexCount = 0
    ReDim surfaceList(0) As SURFACE_ENTRY_DYN
    ReDim surfaceIndexes(0) As Long
    maxBytesToUse = MIN_MEMORY_TO_USE
End Sub
 
Private Sub Class_Terminate()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Clean up
'**************************************************************
    Dim i  As Long
    
    'Destroy every surface in memory
    For i = 0 To surfaceCount - 1
        Set surfaceList(i).Surface = Nothing
    Next i
    
    'Destroy the arrays
    Erase surfaceList
    Erase surfaceIndexes
End Sub
 
Private Sub clsSurfaceManager_Initialize(ByRef DD As DirectDraw7, ByVal videoMemory As Boolean, ByVal graphicPath As String, Optional ByVal maxMemoryUsageInMb As Long = -1)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Initializes the manager
'**************************************************************
    Set DirectDraw = DD
    
    useVideoMemory = videoMemory
    
    GrhPath = graphicPath
    
    If maxMemoryUsageInMb = -1 Then
        maxBytesToUse = DEFAULT_MEMORY_TO_USE   ' 16 Mb by default
    ElseIf maxMemoryUsageInMb * BYTES_PER_MB < MIN_MEMORY_TO_USE Then
        maxBytesToUse = MIN_MEMORY_TO_USE       ' 4 Mb is the minimum allowed
    Else
        maxBytesToUse = maxMemoryUsageInMb * BYTES_PER_MB
    End If
End Sub
 
Private Property Get clsSurfaceManager_Surface(ByVal fileIndex As Long) As DirectDrawSurface7
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Retrieves the requested texture
'**************************************************************
    Dim Index As Long
    
    ' Search the index on the list
    Index = BinarySearch(fileIndex)
    
    If Index < 0 Then
        'Not found, we have to load the file and add it in the position given by the negation of the index
        '(it may be changed by the removal of indexes though, so we let the LoadSurface method notify us)
        Index = LoadSurface(fileIndex, Not Index)
    End If
    
    'Return it
    With surfaceList(surfaceIndexes(Index))
        .lastAccess = GetTickCount
        Set clsSurfaceManager_Surface = .Surface
    End With
End Property
 
Private Function BinarySearch(ByVal fileIndex As Long) As Long
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Returns the index of the surface in the list, or the negation
'of the position were it should be if not found (for binary insertion)
'**************************************************************
    Dim min As Long
    Dim max As Long
    Dim mid As Long
    
    min = 0
    max = surfaceIndexCount - 1
    
    Do While min <= max
        mid = (min + max) \ 2
        
        If surfaceList(surfaceIndexes(mid)).fileIndex < fileIndex Then
            min = mid + 1
        ElseIf surfaceList(surfaceIndexes(mid)).fileIndex > fileIndex Then
            max = mid - 1
        Else
            'We found it
            BinarySearch = mid
            Exit Function
        End If
    Loop
    
    'Not found, return the negation of the position where it should be
    '(all higher values are to the right of the list and lower values are to the left)
    BinarySearch = Not min
End Function
 
Private Function LoadSurface(ByVal fileIndex As Long, ByVal listIndex As Long) As Long
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Loads the surface named fileIndex + ".bmp" and inserts it to the
'surface list in the listIndex position
'**************************************************************
On Error GoTo ErrHandler
 
    Dim newSurface As SURFACE_ENTRY_DYN
    Dim ddsd As DDSURFACEDESC2
    Dim ddck As DDCOLORKEY
    Dim filePath As String
    
    'Store complete file path
    filePath = GrhPath & CStr(fileIndex) & ".bmp"
    
    'Set up the surface desc
    ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    
    If useVideoMemory Then
        ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    Else
        ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    End If
    
    Call surfaceDimensions(filePath, ddsd.lHeight, ddsd.lWidth)
    
    With newSurface
        .fileIndex = fileIndex
        
        'Set last access time (if we didn't we would reckon this texture as the one lru)
        .lastAccess = GetTickCount
        
        'Load surface
        Set .Surface = DirectDraw.CreateSurfaceFromFile(filePath, ddsd)
        
        'Set colorkey
        ddck.high = 0
        ddck.low = 0
        Call .Surface.SetColorKey(DDCKEY_SRCBLT, ddck)
        
        'Retrieve the updated surface desc
        Call .Surface.GetSurfaceDesc(ddsd)
    End With
    
    'Insert surface to the list at the given pos
    Call InsertSurface(newSurface, listIndex)
    
    'Update used bytes
    usedBytes = usedBytes + ddsd.lHeight * ddsd.lPitch
    
    Dim removedFile As Integer
    'Check if we have exceeded our allowed share of memory usage
    Do While usedBytes > maxBytesToUse And surfaceCount > 1
        'Remove a file
        removedFile = RemoveLRU
        
        'If no file could be removed we continue, if the file was previous to our surface we update the index
        If removedFile = 0 Then
            Exit Do
        ElseIf removedFile < listIndex Then
            listIndex = listIndex - 1
        End If
    Loop
    
    'Return the real index in wich it ended after removing any necessary files
    LoadSurface = listIndex
Exit Function
 
ErrHandler:
    If err.number = DDERR_OUTOFMEMORY Or err.number = DDERR_OUTOFVIDEOMEMORY Then
        If surfaceCount Then
            'Remove a surface and try again
            Call RemoveLRU
            Resume Next
        Else
            MsgBox "No hay memoria disponible! El programa abortará. Cierra algunos programas e intenta de nuevo"
            End
        End If
    Else
        MsgBox "Un error inesperado ocurrió al intentar cargar el gráfico " & filePath & ". " & vbCrLf & _
                "El código de error es " & CStr(err.number) & " - " & err.Description & vbCrLf & "Copia este mensaje y notifica a los administradores.", _
                vbOKOnly Or vbCritical Or vbExclamation, "Error"
        End
    End If
End Function
 
Private Sub surfaceDimensions(ByVal Archivo As String, ByRef Height As Long, ByRef Width As Long)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Loads the headers of a bmp file to retrieve it's dimensions at rt
'**************************************************************
    Dim handle As Integer
    Dim bmpFileHead As BITMAPFILEHEADER
    Dim bmpInfoHead As BITMAPINFOHEADER
    
    handle = FreeFile()
    Open Archivo For Binary Access Read Lock Write As handle
        Get handle, , bmpFileHead
        Get handle, , bmpInfoHead
    Close handle
    
    Height = bmpInfoHead.biHeight
    Width = bmpInfoHead.biWidth
End Sub
 
Private Sub InsertSurface(ByRef Surface As SURFACE_ENTRY_DYN, ByVal listIndex As Long)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Inserts the given surface in the requested position of the surface list
'**************************************************************
On Error GoTo ErrHandler
    Dim i As Long
    
    'Search for an empty spot in the list
    For i = 0 To surfaceCount - 1
        If surfaceList(i).Surface Is Nothing Then Exit For
    Next i
    
    'Enlarge the list if no empty spot was found
    If i = surfaceCount Then
        ReDim Preserve surfaceList(surfaceCount) As SURFACE_ENTRY_DYN
        
        'Increase surface count
        surfaceCount = surfaceCount + 1
    End If
    
    'Insert the new surface
    surfaceList(i) = Surface
    
    'Resize the list
    ReDim Preserve surfaceIndexes(surfaceIndexCount) As Long
    
    'Update the index list
    If surfaceIndexCount > listIndex Then
        'Move back the list - Copying this way is up to 6 times faster than a For
        Dim tempList() As Long
        ReDim tempList(surfaceIndexCount - listIndex) As Long
        
        CopyMemory tempList(0), surfaceIndexes(listIndex), (surfaceIndexCount - listIndex) * 4
        surfaceIndexes(listIndex) = i
        CopyMemory surfaceIndexes(listIndex + 1), tempList(0), (surfaceIndexCount - listIndex) * 4
    Else
        'We are inserting at the bottom of the list
        surfaceIndexes(listIndex) = i
    End If
    
    surfaceIndexCount = surfaceIndexCount + 1
Exit Sub
 
ErrHandler:
    MsgBox "Un error irreparable ocurrió al insertar un nuevo gráfico en la lista." & vbCrLf _
            & "El cliente se cerrará" & vbCrLf _
            & "Intente usar el cliente no dinámico"
    End
End Sub
 
Private Function RemoveLRU() As Integer
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Removes the Least Recently Used surface to make some room for new ones
'**************************************************************
    Dim LRU As Long
    Dim i As Long
    Dim ddsd As DDSURFACEDESC2
    
    'Should never happen, but just in case....
    If surfaceCount = 0 Then Exit Function
    
    'Initialize with the first element of the list
    LRU = 0
    
    'Check out through the whole list for the least recently used
    For i = 1 To surfaceIndexCount - 1
        If surfaceList(surfaceIndexes(LRU)).lastAccess > surfaceList(surfaceIndexes(i)).lastAccess Then
            LRU = i
        End If
    Next i
    
    'Store the index of the surface removed
    RemoveLRU = LRU
    
    'Retrieve the surface desc
    Call surfaceList(surfaceIndexes(LRU)).Surface.GetSurfaceDesc(ddsd)
    
    'Remove it
    Set surfaceList(surfaceIndexes(LRU)).Surface = Nothing
    surfaceList(surfaceIndexes(LRU)).fileIndex = 0
    
    'Move back the list (if necessary)
    If LRU < surfaceIndexCount - 1 Then
        CopyMemory surfaceIndexes(LRU), surfaceIndexes(LRU + 1), (surfaceIndexCount - LRU - 1) * 4
    End If
    
    'Resize the list
    ReDim Preserve surfaceIndexes(surfaceIndexCount - 1) As Long
    
    'Decrease index count
    surfaceIndexCount = surfaceIndexCount - 1
    
    'Update the used bytes
    usedBytes = usedBytes - ddsd.lHeight * ddsd.lPitch
End Function

Remplazamos el clsSurfaceManStatic por:

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

'**************************************************************
' clsSurfaceManStatic.cls - Inherits from clsSurfaceManager. Is designed to load
' surfaces at startup, and never deallocating them.
' This grants high performance can use a lot of RAM.
'
' Developed by Maraxus (Juan Martín Sotuyo Dodero - juansotuyo@hotmail.com)
' Last Modify Date: 3/06/2006
'**************************************************************
 
'**************************************************************
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'Affero General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'Argentum Online is based on Baronsoft's VB6 Online RPG
'You can contact the original creator of ORE at aaron@baronsoft.com
'for more information about ORE please visit http://www.baronsoft.com/
'**************************************************************
 
Option Explicit
 
'Inherit from the surface manager
Implements clsSurfaceManager
 
'Size to which we resize the list when we start loading textures to prevent ReDim Preserve on each add
'Once done the list is trimmed to the proper size if it's larger than needed.
'A ReDim Preserve is executed for each surface after DEFAULT_LIST_SIZE + 1
Private Const DEFAULT_LIST_SIZE As Integer = 1500
 
Private Type SURFACE_ENTRY_STATIC
    fileIndex As Long
    Surface As DirectDrawSurface7
End Type
 
Private surfaceList() As SURFACE_ENTRY_STATIC
Private surfaceCount As Long
 
Private DirectDraw As DirectDraw7
 
Private useVideoMemory As Boolean
 
Private Sub Class_Initialize()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'
'**************************************************************
    surfaceCount = 0
    ReDim surfaceList(0) As SURFACE_ENTRY_STATIC
End Sub
 
Private Sub Class_Terminate()
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Clean up
'**************************************************************
    Dim i  As Long
    
    'Destroy every surface in memory
    For i = 0 To surfaceCount - 1
        Set surfaceList(i).Surface = Nothing
    Next i
    
    'Destroy the array
    Erase surfaceList
End Sub
 
Private Sub clsSurfaceManager_Initialize(ByRef DD As DirectDraw7, ByVal videoMemory As Boolean, ByVal graphicPath As String, Optional ByVal maxMemoryUsageInMb As Long = -1&)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'
'**************************************************************
    Set DirectDraw = DD
    
    useVideoMemory = videoMemory
    
    Call LoadSurfaces(graphicPath)
End Sub
 
Private Property Get clsSurfaceManager_Surface(ByVal fileIndex As Long) As DirectDrawSurface7
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Retrieves the requested texture
'**************************************************************
On Error GoTo ErrHandler:
    Dim Index As Long
    
    ' Search the index on the list
    Index = BinarySearch(fileIndex)
    
    'Return it
    Set clsSurfaceManager_Surface = surfaceList(Index).Surface
Exit Property
 
ErrHandler:
    If Index < 0 Then
        MsgBox "No se encuentra el archivo " & CStr(fileIndex) & ".bmp. Reinstale el juego, " _
                & "y si el problema persiste contactese con los adminsitradores", vbOKOnly Or vbCritical Or vbExclamation, "Error"
    Else
        MsgBox "Un error inesperado ocurrió a intentar cargar el archivo " & CStr(fileIndex) & ".bmp. & vbcrlf" _
                & "Error: " & CStr(err.number), vbOKOnly Or vbCritical Or vbExclamation, "Error"
    End If
    
    End
End Property
 
Private Sub LoadSurfaces(ByVal GrhPath As String)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Loads all surfaces in random order and then sorts them
'**************************************************************
On Error Resume Next
    Dim FileName As String
    Dim surfaceIndex As Long
    
    'Set up the list at a standard value big enough to prevent using ReDim Preserve constantly (which is slow)
    ReDim surfaceList(DEFAULT_LIST_SIZE) As SURFACE_ENTRY_STATIC
    
    FileName = Dir$(GrhPath & "*.bmp", vbArchive)
    
    While FileName <> ""
        'Get the surface index (numeric part of the number) - NEVER use Val() here or the error won't be raised!!! - Don't use IsNumeric or hexa strings will be accepted
        surfaceIndex = CLng(Left$(FileName, Len(FileName) - 4))
        
        If err.number = 13 Then
            'Type mysmatch - the name of the file isn't numneric, therefore it isn't a surface
            err.Clear
        Else
            'Increase surface count and resize list if needed
            surfaceCount = surfaceCount + 1
            If surfaceCount > DEFAULT_LIST_SIZE + 1 Then
                ReDim Preserve surfaceList(surfaceCount - 1) As SURFACE_ENTRY_STATIC
            End If
            
            Call LoadSurface(GrhPath, surfaceIndex, surfaceCount - 1)
        End If
        
        'Get next .bmp file
        FileName = Dir$()
    Wend
    
    'Trim the list if needed
    If surfaceCount <> UBound(surfaceList) + 1 Then
        ReDim Preserve surfaceList(surfaceCount - 1) As SURFACE_ENTRY_STATIC
    End If
    
    'Sort the list
    Call SortSurfaces(0, surfaceCount - 1)
End Sub
 
Private Function BinarySearch(ByVal fileIndex As Long) As Long
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Returns the index of the surface in the list, or the negation
'of the position were it should be if not found (for binary insertion)
'**************************************************************
    Dim min As Long
    Dim max As Long
    Dim mid As Long
    
    min = 0
    max = surfaceCount - 1
    
    Do While min <= max
        mid = (min + max) \ 2
        
        If surfaceList(mid).fileIndex < fileIndex Then
            min = mid + 1
        ElseIf surfaceList(mid).fileIndex > fileIndex Then
            max = mid - 1
        Else
            'We found it
            BinarySearch = mid
            Exit Function
        End If
    Loop
    
    'Not found, return the negation of the position where it should be
    '(all higher values are to the right of the list and lower values are to the left)
    BinarySearch = Not min
End Function
 
Private Sub LoadSurface(ByVal GrhPath As String, ByVal fileIndex As Long, ByVal listIndex As Long)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Loads the surface named fileIndex + ".bmp" and inserts it to the
'surface list in the listIndex position
'**************************************************************
On Error GoTo ErrHandler
 
    Dim newSurface As SURFACE_ENTRY_STATIC
    Dim ddsd As DDSURFACEDESC2
    Dim ddck As DDCOLORKEY
    Dim filePath As String
    
    'Store complete file path
    filePath = GrhPath & CStr(fileIndex) & ".bmp"
    
    'Set up the surface desc
    ddsd.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    
    If useVideoMemory Then
        ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    Else
        ddsd.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    End If
    
    Call surfaceDimensions(filePath, ddsd.lHeight, ddsd.lWidth)
    
    With newSurface
        .fileIndex = fileIndex
        
        'Load surface
        Set .Surface = DirectDraw.CreateSurfaceFromFile(filePath, ddsd)
        
        'Set colorkey
        ddck.high = 0
        ddck.low = 0
        Call .Surface.SetColorKey(DDCKEY_SRCBLT, ddck)
    End With
    
    'Store the surface in the given index (it MUST be empty or data will be lost)
    surfaceList(listIndex) = newSurface
Exit Sub
 
ErrHandler:
    MsgBox "Un error inesperado ocurrió al intentar cargar el gráfico " & filePath & ". " & vbCrLf & _
            "El código de error es " & CStr(err.number) & " - " & err.Description & vbCrLf & "Copia este mensaje y notifica a los administradores.", _
            vbOKOnly Or vbCritical Or vbExclamation, "Error"
        End
End Sub
 
Private Sub surfaceDimensions(ByVal Archivo As String, ByRef Height As Long, ByRef Width As Long)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 3/06/2006
'Loads the headers of a bmp file to retrieve it's dimensions at rt
'**************************************************************
    Dim handle As Integer
    Dim bmpFileHead As BITMAPFILEHEADER
    Dim bmpInfoHead As BITMAPINFOHEADER
    
    handle = FreeFile()
    Open Archivo For Binary Access Read Lock Write As handle
        Get handle, , bmpFileHead
        Get handle, , bmpInfoHead
    Close handle
    
    Height = bmpInfoHead.biHeight
    Width = bmpInfoHead.biWidth
End Sub
 
Private Sub SortSurfaces(ByVal first As Integer, ByVal last As Integer)
'**************************************************************
'Author: Juan Martín Sotuyo Dodero
'Last Modify Date: 5/04/2005
'Sorts the list using quicksort, this allows the use of BinarySearch for faster searches
'**************************************************************
    Dim min As Integer      'First item in the list
    Dim max As Integer      'Last item in the list
    Dim comp As Long        'Item used to compare
    Dim temp As SURFACE_ENTRY_STATIC
    
    min = first
    max = last
    
    comp = surfaceList((min + max) \ 2).fileIndex
    
    Do While min <= max
        Do While surfaceList(min).fileIndex < comp And min < last
            min = min + 1
        Loop
        Do While surfaceList(max).fileIndex > comp And max > first
            max = max - 1
        Loop
        If min <= max Then
            temp = surfaceList(min)
            surfaceList(min) = surfaceList(max)
            surfaceList(max) = temp
            min = min + 1
            max = max - 1
        End If
    Loop
    
    If first < max Then SortSurfaces first, max
    If min < last Then SortSurfaces min, last
End Sub

Buscamos:

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

''
' Loads grh data using the new file format.
'
' @return   True if the load was successfull, False otherwise.
 
Private Function LoadGrhData() As Boolean

Y remplazamos toda la Function por:

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

''
' Loads grh data using the new file format.
'
' @return   True if the load was successfull, False otherwise.
 
Private Function LoadGrhData() As Boolean
On Error GoTo ErrorHandler
    Dim Grh As Long
    Dim Frame As Long
    Dim grhCount As Long
    Dim handle As Integer
    Dim fileVersion As Long
    
    'Open files
    handle = FreeFile()
    
    Open IniPath & "Graficos.ind" For Binary Access Read As handle
    Seek #1, 1
    
    'Get file version
    Get handle, , fileVersion
    
    'Get number of grhs
    Get handle, , grhCount
    
    'Resize arrays
    ReDim GrhData(1 To grhCount) As GrhData
    
    While Not EOF(handle)
        Get handle, , Grh
        
        With GrhData(Grh)
            'Get number of frames
            Get handle, , .NumFrames
            If .NumFrames <= 0 Then GoTo ErrorHandler
            
            ReDim .Frames(1 To GrhData(Grh).NumFrames)
            
            If .NumFrames > 1 Then
                'Read a animation GRH set
                For Frame = 1 To .NumFrames
                    Get handle, , .Frames(Frame)
                    If .Frames(Frame) <= 0 Or .Frames(Frame) > grhCount Then
                        GoTo ErrorHandler
                    End If
                Next Frame
                
                Get handle, , .Speed
                
                If .Speed <= 0 Then GoTo ErrorHandler
                
                'Compute width and height
                .pixelHeight = GrhData(.Frames(1)).pixelHeight
                If .pixelHeight <= 0 Then GoTo ErrorHandler
                
                .pixelWidth = GrhData(.Frames(1)).pixelWidth
                If .pixelWidth <= 0 Then GoTo ErrorHandler
                
                .TileWidth = GrhData(.Frames(1)).TileWidth
                If .TileWidth <= 0 Then GoTo ErrorHandler
                
                .TileHeight = GrhData(.Frames(1)).TileHeight
                If .TileHeight <= 0 Then GoTo ErrorHandler
            Else
                'Read in normal GRH data
                Get handle, , .FileNum
                If .FileNum <= 0 Then GoTo ErrorHandler
                
                Get handle, , GrhData(Grh).sX
                If .sX < 0 Then GoTo ErrorHandler
                
                Get handle, , .sY
                If .sY < 0 Then GoTo ErrorHandler
                
                Get handle, , .pixelWidth
                If .pixelWidth <= 0 Then GoTo ErrorHandler
                
                Get handle, , .pixelHeight
                If .pixelHeight <= 0 Then GoTo ErrorHandler
                
                'Compute width and height
                .TileWidth = .pixelWidth / TilePixelHeight
                .TileHeight = .pixelHeight / TilePixelWidth
                
                .Frames(1) = Grh
            End If
        End With
    Wend
    
    Close handle
    
    LoadGrhData = True
Exit Function
 
ErrorHandler:
    LoadGrhData = False
End Function

Buscamos y borramos:

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

Public GraphicsFile As String 'Que graficos.ind usamos

Buscamos y borramos:

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

If InStr(1, ClientSetup.sGraficos, "Graficos") Then
        GraphicsFile = ClientSetup.sGraficos
    Else
        GraphicsFile = "Graficos3.ind"
    End If

Solo resta ir a la carpeta "Init" y borrar Graficos1.ind y Graficos2.ind y despues Graficos3.ind, le cambian el nombre por Graficos.ind

Saludos

» 01 Feb 2012 20:44

Buen Aporte!

» 01 Feb 2012 20:47

Buen aporte!

A mi tampoco me gusta

» 01 Feb 2012 22:14

pero y los arbolitos chicos ?

» 01 Feb 2012 22:22

Te los metes bien en el .......

Buen aporte

» 01 Feb 2012 22:53

maTih.- escribió:pero y los arbolitos chicos ?

eh?? que arbolitos chicos?

Saludos

» 02 Feb 2012 13:24

Con el AOSetup, se puede elegir arboles chicos, medianos o grandes. eso corresponde al Graficos1.ind, Graficos2.ind y Graficos3.ind, creo que si alguien cambia los arbolitos se le va a armar un error de la rre put* madre, ustedes creen que esos archivos estan de adorno? xd

Samke escribió:
maTih.- escribió:pero y los arbolitos chicos ?

eh?? que arbolitos chicos?

Saludos

» 02 Feb 2012 13:49

Feer159 escribió:Con el AOSetup, se puede elegir arboles chicos, medianos o grandes. eso corresponde al Graficos1.ind, Graficos2.ind y Graficos3.ind, creo que si alguien cambia los arbolitos se le va a armar un error de la rre put* madre, ustedes creen que esos archivos estan de adorno? xd

Samke escribió:
maTih.- escribió:pero y los arbolitos chicos ?

eh?? que arbolitos chicos?

Saludos

Y yo quiero saber quien usa esos arbolitos?, nadie, todos usan los normales, es decision de cada 1 si le gusta o no la carga.

Saludos

Mi Canal YouTube · » 02 Feb 2012 14:24

ta bueno

es util lo de los graficos.ind, aunke, con el tema de graficos, prefiero los comprimidos, es simple, solo cambiamos el code del indexador, o extramos los graficos en otra carpeta

pero me gusto el de los graficos, es un ahorro

y con el tema de los arboles, se puede hace una function como el hayagua, pero con el grh de los arboles, y dentro del ddrawgrhtranstosurface le metemos un condicional #UsaMiniArbolitos = 1 then

y le mandan resize al hayarbol = true

creo q ise medio bolnki pero me entiendo

» 02 Feb 2012 16:23

Samke escribió:
Feer159 escribió:Con el AOSetup, se puede elegir arboles chicos, medianos o grandes. eso corresponde al Graficos1.ind, Graficos2.ind y Graficos3.ind, creo que si alguien cambia los arbolitos se le va a armar un error de la rre put* madre, ustedes creen que esos archivos estan de adorno? xd

Samke escribió:
eh?? que arbolitos chicos?

Saludos

Y yo quiero saber quien usa esos arbolitos?, nadie, todos usan los normales, es decision de cada 1 si le gusta o no la carga.

Saludos

Todo alkon los usa, vah, yo los uso en todos los servers que juego, se me hace mas cómodo ver arbolitos mini y no unos arboles gigantes que te cagan la vida.

Mi Canal YouTube · » 02 Feb 2012 16:29

maTih.- escribió:
Todo alkon los usa, vah, yo los uso en todos los servers que juego, se me hace mas cómodo ver arbolitos mini y no unos arboles gigantes que te cagan la vida.

boske dork + lvl bajo + araña = casper

» 02 Feb 2012 18:12

GoDKeR escribió:
maTih.- escribió:
Todo alkon los usa, vah, yo los uso en todos los servers que juego, se me hace mas cómodo ver arbolitos mini y no unos arboles gigantes que te cagan la vida.

boske dork + lvl bajo + araña = casper

ahi esta el claro ejemplo de alguien que entiende el juego.

si quieren usar este post, por favor borren el Graficos2 y el Graficos3 y al Graficos1 cambienle el nombre como explica en el post

» 02 Feb 2012 19:50

maTih.- escribió:
GoDKeR escribió:
maTih.- escribió:
Todo alkon los usa, vah, yo los uso en todos los servers que juego, se me hace mas cómodo ver arbolitos mini y no unos arboles gigantes que te cagan la vida.

boske dork + lvl bajo + araña = casper

ahi esta el claro ejemplo de alguien que entiende el juego.

si quieren usar este post, por favor borren el Graficos2 y el Graficos3 y al Graficos1 cambienle el nombre como explica en el post

Aguante los arboles medianos ^_^
buen code para los que no tienen gana de indexar mucho

» 02 Feb 2012 20:06

YO prefieron que carge con arboles medianos ya que son casi iguales que los grandes y ademas tienen transparencia.

» 02 Feb 2012 20:55

Samke escribió:
Feer159 escribió:Con el AOSetup, se puede elegir arboles chicos, medianos o grandes. eso corresponde al Graficos1.ind, Graficos2.ind y Graficos3.ind, creo que si alguien cambia los arbolitos se le va a armar un error de la rre put* madre, ustedes creen que esos archivos estan de adorno? xd

Samke escribió:
eh?? que arbolitos chicos?

Saludos

Y yo quiero saber quien usa esos arbolitos?, nadie, todos usan los normales, es decision de cada 1 si le gusta o no la carga.

Saludos

no hables en plural, yo en la netbook uso arboles medianos o chicos porque me molestan.

Carga Comun de Init y Graficos

¿Quién está conectado?