Attribute VB_Name = "Module1"
Option Explicit
Option Base 0

Public Const DebugVersion = 1
Public Const dist1 = 17    'distancias en pixels donde se codifica distinto
Public Const dist2 = 257
Public Const dist3 = 272
Public Const speedwav = 4000 'velocidad de los sonidos
Public Const version = "Graphreader (VB) "
Public Const maxformatos = 20

Global scaleconst As Byte
Public flag As Boolean, flag2 As Boolean, bucleflag As Boolean, multi As Boolean
Public bucleextract As Boolean, graficomodificado As Boolean
Public byte1 As Byte, byte2 As Byte, byte3 As Byte, byte4 As Byte, clarity As Byte, pc As Byte
Public fh As Integer, fh2 As Integer, fh3 As Integer, fh4 As Integer, fh5 As Integer, fh6 As Integer
Public registro As Integer, couleur As Integer, xx As Integer, yy As Integer
Public bits As Integer, bitcolor As Integer, code As Integer, maxcode As Integer, old As Integer
Public p2 As Single
Public ultimox As Single, xactual As Single, totalbits As Single, total As Single, primersalteo As Single
Public contador As Single, contador2 As Single, contador3 As Single, contador4 As Single
Public contador5 As Single, contador6 As Single, contador7 As Single, contador8 As Single
Public contador9 As Single, hexlus As Single, hexalire As Single
Public ReturnValue As Double
Public distancia As Long, offset As Long, offset2 As Long
Public color As Long, color2 As Long, color3 As Long, color4 As Long, color5 As Long
Public ultimocolor As Long, coloractual As Long, colordibujado As Long, colorprevio As Long, colorpalette As Long
Public archivo As String, archivo2 As String, archivo3 As String
Public pathdefault As String, pathdefault2 As String, inipath As String
Public inisphenx As String, dirgraphic As String, inifile As String, inibmp As String
Public bitsretenue As String, byteplus As String, hexcolor As String, hexs As String, hexsretenue As String
Public cadena As String, cadena2 As String, cadenahecha As String, letra As String, cadenaespecial As String
Public knownformats As String
Public colors(16) As Long, maxcolors(16) As Long
Public codigos() As Byte
Public palettes(15) As Long, rgbpalettes(15, 2) As Byte
Public palettesDM2(15, 2, 15) As Single
Public nompalettes(15) As String, nomcolors(16) As String, palettedm2(15) As String
Public dimensions() As Single, nombres() As String, pile() As Integer, columnas() As Integer
Public formatos() As String, maxobjetos() As String, tablacodigos() As String
Public matriz(190) As String

Sub Main()
Splash.Show 0
Load Graphread
End Sub
Sub writecolor()
'je détermine la couleur
bitcolor = 4
If ultimocolor < 0 Then 'couleur transparente
    contador3 = 16
    hexcolor = "E"
Else
    For contador3 = 8 To 13 'couleur prioritaire, palette relative
        If colors(contador3) = ultimocolor Then Exit For
    Next
    hexcolor = Hex(contador3)
    If contador3 = 14 Then
        For contador4 = 0 To 15 'palette absolue
            If palettes(contador4) = ultimocolor Then Exit For
        Next
        hexcolor = "F" + Hex(contador4)
        bitcolor = 8
    End If
End If
End Sub
Sub leercolor()
Dim contador3
leer
Select Case byte1
'----------------------1 sólo pixel----------------------------------------------
Case Is < 6 '1 solo pixel de color x+8 (color muy usado)
    distancia = 1
    color2 = colors(byte1 + 8)
Case Is = 6 'transparente 1 pixel
    distancia = 1
    color2 = -1
Case Is = 7     'palette absolue con 1 pixel
    distancia = 1
    leer
    color2 = palettes(byte1)
 '-------------------varios pixeles-----------------------------------------
Case Is = 14    'E=transparente
    color2 = -1
    leerdistancia
Case Is = 15    'F colores absolutos
    leer
    color2 = palettes(byte1)
    leerdistancia
Case Else   '8,9,A,B,C,D
    color2 = colors(byte1)
    leerdistancia
End Select

If cadenaespecial = "pcdm2 graphics" And Info.Label5.Tag < 32700 And Info.Label20.Tag < 32700 And color2 > 0 Then
    For contador3 = 0 To 15
        If color2 = palettes(contador3) Then Exit For
    Next
    color2 = palettedm2(contador3)
End If

End Sub
Sub leercolornopc()
leer
Select Case byte1
'----------------------1 sólo pixel----------------------------------------------
Case Is < 8     'distancia de 1 a 8     +1 digito de color
    distancia = 1 + byte1
    leer
    color2 = palettes(byte1)
Case Is = 8     'distancia de 9 a 256   +1 digito de color  + 2 digitos de distancia
    leer
    color2 = palettes(byte1)
    leer
    distancia = 16 * CSng(byte1)
    leer
    distancia = distancia + byte1 + 1
Case Is = 9 'FORMATO ESPECIAL: PIXEL1+DISTANCE+OTHERS PIXELS
    distancia = 1
    leer
    color2 = palettes(byte1)
    leer
    contador8 = CInt(byte1) * 16
    leer
    contador6 = byte1 + contador8
    contador8 = byte1 Mod 2
    If contador8 = 0 Then inc distancia
    For contador5 = 1 To contador6 + contador8
        leer
        color2 = palettes(byte1)
        If contador5 < contador6 + contador8 Then inc distancia
    Next
Case Is = &HB    'transparente      +1 digito de color  + 2 digitos de distancia
    leer
    color2 = -1
    color = palettes(byte1)
    leer
    distancia = 16 * CInt(byte1)
    leer
    distancia = distancia + byte1 + 1
    inc distancia
    color2 = color
    distancia = 1
Case Is = &HC     'distancia de 257+   +1 digito de color  + 4 digitos de distancia ?
    leer
    color2 = palettes(byte1)
    leer
    distancia = CSng(byte1) * 256 * 16
    leer
    distancia = distancia + 256 * CSng(byte1)
    leer
    distancia = distancia + 16 * CSng(byte1)
    leer
    distancia = distancia + byte1 + 1
Case Is = &HF   'transparente  distancia de 257 a mucho!   +1 digito de color  + 4 digitos de distancia
    leer
    color2 = -1
    color = palettes(byte1)
    leer
    distancia = CSng(byte1) * 256 * 16
    leer
    distancia = distancia + CSng(byte1) * 256
    leer
    distancia = distancia + CSng(byte1) * 16
    leer
    distancia = distancia + byte1 + 1
    inc distancia
    color2 = color
    distancia = 1
Case Else   'A,B?, C,D,E  no sé
cadenahecha = cadenahecha + "***"
Beep
End Select
End Sub
Sub writedistancia()
'Hex codes
Select Case distancia
Case Is < 2 'un sólo pixel
    bits = 4
    Select Case contador3
    Case Is = 16                       'transparent
        hexs = "6"
    Case Is > 13                                'palette absolue
        hexs = "7" & Hex(contador4)
        bits = 8
    Case Else                                   'palette relative
        hexs = Hex(contador3 - 8)
    End Select
    '------------------------------------------------------------------------------------
Case Is < dist1  'sólo se usan los clásicos 4 bits
    bits = bitcolor + 4
    hexs = hexcolor + Hex(distancia - 2)
    '------------------------------------------------------------------------------------
Case Is < dist2 'se marca 1111 y se usan 8 bits (a partir de 18+)
    bits = bitcolor + 4 + 8
    hexs = Hex(distancia - dist1)
    hexs = hexcolor + "F" + String(2 - Len(hexs), "0") + hexs
    '------------------------------------------------------------------------------------
Case Is < dist3  'se marca 1111 1111 y se usan 4 bits (a partir de 257+)
    bits = bitcolor + 8 + 4
    hexs = Hex(distancia - dist2)
    hexs = hexcolor + "FF" + hexs
    '------------------------------------------------------------------------------------
Case Else 'se marca 1111 1111 1111 y se usan 16 bits (a partir de 273+)
    bits = bitcolor + 12 + 16
    hexs = Hex(distancia)
    hexs = hexcolor + "FFF" + String(4 - Len(hexs), "0") + hexs
End Select
End Sub
Sub writedistancianopc()
'je détermine la couleur du pixel suivant
For contador4 = 0 To 15 'palette absolue
    If palettes(contador4) = coloractual Then Exit For
Next
'je détermine la couleur
For contador3 = 0 To 15 'palette absolue
    If palettes(contador3) = IIf(distancia = 1, Abs(ultimocolor), ultimocolor) Then Exit For
Next
If contador3 = 16 Then
    hexcolor = Hex(contador4)
    xactual = xactual + 1
    ultimocolor = coloractual
Else
    hexcolor = Hex(contador3)
End If
    hexs = Hex(distancia - 1)

'Hex codes
Select Case distancia
Case Is < 1 ' se saltea
    hexs = ""
    bits = 0
    hexcolor = "0"
    distancia = 0
Case Is < 9 '1 a 8 pixels         distance (1 digits) puis couleur
    Select Case contador3
    Case Is = 16                       'transparent
        hexs = "B" + hexcolor + "0" + hexs
        bits = 16
    Case Else
        hexs = hexs + hexcolor
        bits = 8
    End Select
Case Is < dist2 '9 a 256 pixels         B o 8   puis couleur    puis distance (2 digits)
    hexs = String(2 - Len(hexs), "0") + hexs
    bits = 16
    Select Case contador3
    Case Is = 16                       'transparent
        hexs = "B" + hexcolor + hexs
    Case Else
        hexs = "8" + hexcolor + hexs
    End Select
Case Else '>256         F o C   puis couleur    puis distance (4 digits)
    hexs = String(4 - Len(hexs), "0") + hexs
    bits = 24
    Select Case contador3
    Case Is = 16                       'transparent
        hexs = "F" + hexcolor + hexs
    Case Else
        hexs = "C" + hexcolor + hexs
    End Select
End Select
End Sub
Sub leerdistancia()
leer
If byte1 = &HF Then 'F
    leer
    If byte1 = &HF Then 'FF
        leer
        If byte1 = &HF Then 'FFF se usan 4 bytes
            leer
            distancia = CSng(byte1) * 256 * 16
            leer
            distancia = distancia + CSng(byte1) * 256
            leer
            distancia = distancia + CSng(byte1) * 16
            leer
            distancia = distancia + byte1
        Else   '<273,1 byte
            distancia = CSng(byte1) + dist2
        End If
    Else '<257, 2 bytes
        distancia = CSng(byte1) * 16
        leer
        distancia = dist1 + distancia + CSng(byte1)
    End If
 Else   'normal, <18, 1 byte
    distancia = CSng(byte1) + 2
End If
End Sub

 Function calc_wavlength(a)
contador = a Mod 256
contador2 = (a - contador) / 256 Mod 256
contador3 = (a - contador2 - contador) / 256 / 256
calc_wavlength = String(2 - Len(Hex(contador)), "0") + Hex(contador) _
+ String(2 - Len(Hex(contador2)), "0") + Hex(contador2) _
+ String(2 - Len(Hex(contador3)), "0") + Hex(contador3) + "00"
End Function
 Function unknown(numero) As String
If numero < 0 Or numero > UBound(nombres) Then Exit Function
Dim contador, contador2, contador5, contador6
'intenta identificar un item
If Graphread.viewhex.Checked Then
    unknown = "Unknown"
    Exit Function
End If
If Graphread.viewtext.Checked Then
    unknown = "Text"
    Exit Function
End If
If Graphread.viewencrypted.Checked Then
    unknown = "Encrypted"
    Exit Function
End If
If Graphread.viewgraphics.Checked Then
    unknown = "Picture"
    Exit Function
End If
If Graphread.Viewsound.Checked Then
    unknown = "Sound"
    Exit Function
End If
If Graphread.Viewmidi.Checked Then
    unknown = "Midi"
    Exit Function
End If
If Graphread.viewmapa.Checked Then
    unknown = "Mapa"
    Exit Function
End If
fh3 = FreeFile(1)
Open dirgraphic For Binary Shared As fh3
    Seek fh3, dimensions(numero, 3) + 1
    Get fh3, , byte1
    Get fh3, , byte2
    Get fh3, , byte3
    Get fh3, , byte4
    swap
    contador = CSng(byte2) * 256 + byte1    'read x
    contador2 = CSng(byte4) * 256 + byte3   'read y
    contador5 = CSng(byte1) * 256 + byte2    'read x
    contador6 = CSng(byte3) * 256 + byte4   'read y
    If pc > 1 And pc <> 6 Then contador5 = contador: contador6 = contador2
Close fh3
unknown = Left(nombres(numero), 4)
'Si la longitud es 0, es un Free:
If dimensions(numero, 0) = 0 Then
    unknown = "Free "
    Exit Function
End If
'Si empieza por "HMIM" es un midi
If contador = 19784 And contador2 = 19785 Then
    unknown = "Midi "
    Exit Function
End If

If contador = 11127 And contador2 = 264 Then
    unknown = "Sound "
    Exit Function
End If
If contador5 > 0 And contador5 >= dimensions(numero, 0) - 4 _
 And contador5 <= dimensions(numero, 0) Then
    unknown = "Sound "
    Exit Function
End If
'Si las dimensiones correponden, es un picture:
If val2(Info.Text1(0).Text) > 0 And val2(Info.Text1(1).Text) > 0 Then
    If Graphread.Viewnotbig.Checked And val2(Info.Text1(1).Text) < 241 And val2(Info.Text1(0).Text) < 321 Then
        unknown = "Picture "
        Exit Function
    End If
End If
If unknown = "" Then unknown = "Unknown"
End Function
 Function dm2colors(dm2colorscolor, dm2colorscolor2)
dm2colors = RGB(palettesDM2(dm2colorscolor, 0, dm2colorscolor2), palettesDM2(dm2colorscolor, 1, dm2colorscolor2), palettesDM2(dm2colorscolor, 2, dm2colorscolor2))
End Function
Sub savedefaults()
If Len(Dir(pathdefault + "\data", 16)) = 0 Then
    MkDir (pathdefault + "\data")
End If
fh5 = FreeFile(1)
Open pathdefault + "\data\graphread.ini" For Output As fh5
    Print #fh5, inipath
    Print #fh5, dirgraphic
    Print #fh5, inifile
    Print #fh5, inibmp
    Print #fh5, inisphenx
    Print #fh5,
    Print #fh5, "; Definitions of recognized formats"
    Print #fh5, "; (FORMAT, PLATFORM, VARIETY, TEST1, TEST2, HEADER LENGTH and FIRST OFFSET of DATA)"
    Print #fh5, "; The TEST parameters are the test to be performed to identify the file"
    Print #fh5, "; as belowing to this format."
    Print #fh5, "; #xxxx=yyyy means 'offset xxxx must be equal to yyyy."
    Print #fh5, "; colons (,) are used to separate each parameter"
    
    Print #fh5,
    For contador = 1 To UBound(formatos, 2)
        Print #fh5, "FILE:"
        For contador2 = 0 To 6
            Print #fh5, formatos(contador2, contador) & IIf(contador2 = 6, "", ",");
        Next
        Print #fh5,
        Print #fh5,
    Next
Close fh5

putcaption
End Sub
Sub leer()
If DebugVersion = 1 And Graphread.Filedebug.Checked Then
    If Len(cadena2) = 0 Then
        byte1 = 0
    Else
        byte1 = val2("&H" + Left(cadena2, 1))
        contador7 = contador7 + 0.5
        cadenahecha = cadenahecha + Left(cadena2, 1)
        cadena2 = Right(cadena2, Len(cadena2) - 1)
    End If
    Exit Sub
End If
contador7 = contador7 + 0.5
If Len(cadena2) > 0 Then
        byte1 = val2("&H" + cadena2)
        cadena2 = ""
Else
    Get fh3, , byte1
    cadena2 = Hex(byte1 Mod 16)
    byte1 = Int(byte1 / 16)
End If
End Sub
Sub leergraphics(Optional identificado = True)
GoTo inicio2
On Error GoTo inicio

inicio:
identificado = Not identificado
On Error GoTo 0

inicio2:
Graphread.MousePointer = 11
Dim cadena1 As String, cadena2 As String, contador, contador2, contador3
Graphread.Label8.Caption = "Initializing..."
putcaption
Graphread.Label8.Visible = True
DoEvents
Erase dimensions, nombres
defaults
pc = 0
ReDim columnas(0, 0)
fh = FreeFile(1)
Open dirgraphic For Binary Access Read Shared As fh
    For contador = 1 To UBound(formatos, 2) 'recorro los formatos conocidos
        flag = True 'determina si se logra el test
        For contador2 = 3 To 4
            cadena = Trim(formatos(contador2, contador))
            If Len(cadena) > 0 Then
                contador3 = InStr(cadena, "=")
                cadena1 = parser(Trim(Left(cadena, contador3 - 1)))
                cadena2 = parser(Trim(Right(cadena, Len(cadena) - contador3)))
                If val2("&H" + cadena1) <> val2("&H" + cadena2) Then flag = False
            End If
        Next
        If flag = True Then pc = contador: Exit For
    Next
    If pc = 0 Then askpc
    putcaption
    If Right(LCase(formatos(0, pc)), 7) = "dungeon" And Len(Dir(inisphenx)) > 0 Then
        If MsgBox("Do you want to open this file with its predetermined editor for better results?", 4) = 6 Then
            cadena = inisphenx
            contador3 = 2
            Do While Len(cadena) > contador3 And contador3 > 1
                contador3 = InStr(1, cadena, "\") + 1
                cadena = Mid$(cadena, contador3)
            Loop
            cadena = Left(inisphenx, Len(inisphenx) - Len(cadena) - 1)
            ChDir (cadena)
            Wav.MMControl1.Command = "Close"
            ReturnValue = Shell(inisphenx + " " + Chr(34) + Trim(dirgraphic) + Chr(34), 6)
            If ReturnValue <> 0 Then
                Close fh
                contador3 = Timer + 1
                Do While Timer < contador3
                    DoEvents
                Loop
                
                End
            Else
                MsgBox ("Couldn't load the editor!")
            End If
        End If
    End If
    
    
    initgraphics (identificado)
    
    cadena1 = inipath + "\" + dm("dm", 0) + "_Extracted"
    If Len(Dir(cadena1, 16)) = 0 Then
        MkDir (cadena1)
    End If
    
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then
        fh5 = FreeFile(1)
        Open cadena1 + "\Info.txt" For Output As fh5
            For contador = 0 To dm("objects", 0) - 1
            If pc = 1 Or pc > 3 Then
                    Print #fh5, Hex(dimensions(contador, 0)) & " " & Hex(dimensions(contador, 1)) _
                    & " " & Hex(dimensions(contador, 2)) & " " & Hex(dimensions(contador, 3));
                        Print #fh5, " " & nombres(contador);
                Else
                        Print #fh5, Hex(dimensions(contador, 0)) & " " & Hex(dimensions(contador, 3));
                        Print #fh5, " " & nombres(contador);
                End If
                    Print #fh5,
            Next
        Close (fh5)
    End If
    
    'Lleno el combo
    contador3 = Graphread.List2.ListIndex
    Graphread.List2.Clear
    For contador = 0 To dm("objects", 0) - 1 'numero de objetos que leer
        Graphread.List2.AddItem (nombres(contador) & " (" & String(6 - Len(Trim(Str(contador))), "0") & Trim(Str(contador)) & ")")
    Next
    If Graphread.List2.ListCount = 0 Then
        Graphread.List2.ListIndex = -1
    Else
        If contador3 < Graphread.List2.ListCount And contador2 > -1 And contador3 > -1 Then
            Graphread.List2.ListIndex = contador3
        Else
            Graphread.List2.ListIndex = 0
        End If
    End If
    Graphread.List2_LostFocus
    Graphread.Command16_Click
    
    archivo = pathdefault + "\data\" + dm("dm", 0) + ".ini"
    If Len(Dir(archivo)) = 0 Then
        fh2 = FreeFile(1)
        Open archivo For Output As fh2
            Print #fh2, "; Definitions of recognized categories:"
            Print #fh2, "; (NUMBER, TOTAL BYTES OF DEFINITION, PREDEFINED LENGTH,"
            Print #fh2, "; LENGHT1, LENGHT2, STATS, NAME)"
            Print #fh2,
            For contador = 0 To 25
                contador3 = 0
                For contador2 = 0 To 6
                    contador3 = contador3 + objetos(contador, contador2, pc)
                Next
                If contador3 > 0 Then 'Hay una categoria!
                    Print #fh2, "CATEGORY:"
                    For contador2 = 0 To 6
                        Print #fh2, Trim(maxobjetos(contador, contador2, pc)) & IIf(contador2 = 6, "", ",");
                    Next
                    Print #fh2,
                End If
            Next
            'si es un dungeon no graba los nombres
            If Right(LCase(formatos(0, pc)), 7) <> "dungeon" Then
                Print #fh2, "; List of items:"
                Print #fh2,
                For contador = 0 To UBound(nombres)
                    Print #fh2, nombres(contador)
                Next
            End If
        Close fh2
    End If
Close fh
putcaption
Graphread.MousePointer = 0
Graphread.Label8.Visible = False

End Sub
Sub askpc()
If DebugVersion = 1 And Graphread.Filedebug.Checked Then
        Stop
End If
cadena = Trim(UCase(InputBox("Unknown format! " + Chr(13) _
+ dirgraphic + Chr(13) _
+ "Please type the format " + Chr(13) + knownformats)))
For pc = 1 To UBound(formatos, 2)
    If cadena = Trim(UCase(dm("dm", 0))) Then Exit For
Next
If pc > UBound(formatos, 2) Then pc = 0: MsgBox ("Unknown Format!")
End Sub
Sub initgraphics(Optional identificado = True)
initcategorias
contador9 = dm("objects", 0)
ReDim dimensions(contador9, 5), nombres(contador9)
contador = 0    'numero items
contador3 = 0   'numero categoria
archivo = pathdefault + "\data\" + dm("dm", 0) + ".ini"
If Len(Dir(archivo)) > 0 And identificado Then
    fh2 = FreeFile(1)
    Open archivo For Input As fh2
        Do While Not EOF(fh2) And contador <= UBound(nombres)
            Line Input #fh2, cadena
            cadena = Trim(cadena)
            If cadena > "" And Left(cadena, 1) <> ";" Then
                If cadena = "CATEGORY:" Then 'no lee los comentarios
                    For contador2 = 0 To 6
                        If Not EOF(fh2) Then Input #fh2, cadena
                        maxobjetos(contador3, contador2, pc) = cadena
                    Next
                    contador3 = contador3 + 1
                Else
                    'Si es un dungeon, no levanta los nombres
                    If Right(LCase(formatos(0, pc)), 7) <> "dungeon" Then
                        nombres(contador) = cadena
                        contador = contador + 1
                    End If
                End If
            End If
        Loop
    Close fh2
End If
fh6 = FreeFile(1)
Open dirgraphic For Binary Access Read Shared As fh6    'lo abro dos veces
    Seek fh6, 1 + formato(6, pc)
    For contador = 0 To 25
        If objetos(contador, 2, pc) > 0 Then prelength
        If objetos(contador, 3, pc) > 0 Then length1
        If objetos(contador, 4, pc) > 0 Then length2
        If objetos(contador, 5, pc) > 0 Then dim1
    Next
Close fh6
End Sub
Sub dim1()
Dim contador5, contador9, contador8
'Dimensiones
For contador5 = dm("suma", contador) To dm("suma", contador) + objetos(contador, 0, pc) - 1
    For contador9 = 1 To objetos(contador, 5, pc) / 2
        contador8 = IIf(contador9 > 2, contador9 + 1, contador9)
        dimensions(contador5, contador8) = getbyte(fh6, 2, -1)
    Next
Next
End Sub
Sub length2()
Dim contador5, contador9, contador8, contador3
'Chequeo
For contador5 = dm("suma", contador) To dm("suma", contador) + objetos(contador, 0, pc) - 1
    For contador9 = 1 To objetos(contador, 4, pc) / 2
        contador8 = IIf(contador9 > 2, contador9 + 1, contador9) - 1
        contador3 = getbyte(fh6, 2, -1)
        dimensions(contador5, contador8) = contador3
    Next
    If dimensions(contador5, 0) <> contador3 Then
        MsgBox ("Error in the length checking!")
        Graphread.Label8.Visible = False
        Exit Sub
    End If
Next
End Sub
Sub prelength()
Dim contador5, contador9, contador8
'Prelengths
For contador5 = dm("suma", contador) To dm("suma", contador) + objetos(contador, 0, pc) - 1
    dimensions(contador5, 0) = objetos(contador, 2, pc)
    If contador5 = 0 Then    'offset
        dimensions(contador5, 3) = dm("offset", 1)
    Else
        dimensions(contador5, 3) = dimensions(contador5 - 1, 3) + dimensions(contador5 - 1, 0)
    End If
    nameit contador5, contador
Next
End Sub
Sub nameit(contador5, contador)
'contador5=numero objeto
'contador=numero categoria
If nombres(contador5) = "" Then
    nombres(contador5) = maxobjetos(contador, 6, pc) + unknown(contador5) _
    & String(6 - Len(Trim(Str(contador5))), "0") & contador5
End If
End Sub
Sub length1()
Dim contador5, contador9, contador8
'Primera lista de lengths
For contador5 = dm("suma", contador) To dm("suma", contador) + objetos(contador, 0, pc) - 1
    For contador9 = 1 To objetos(contador, 3, pc) / 2
        contador8 = IIf(contador9 > 2, contador9 + 1, contador9) - 1
        dimensions(contador5, contador8) = getbyte(fh6, 2, -1)
    Next
    If objetos(contador, 2, pc) > 0 Then
        dimensions(contador5, 4) = dimensions(contador5, 0)
        dimensions(contador5, 0) = objetos(contador, 2, pc)
    End If
    If contador5 = 0 Then    'offset
        dimensions(contador5, 3) = dm("offset", 1)
    Else
        dimensions(contador5, 3) = dimensions(contador5 - 1, 3) + dimensions(contador5 - 1, 0)
    End If
    nameit contador5, contador
Next
End Sub
 Function getbyte(filehandle, bytes, Optional offsetget = -1)
Dim contador9
If offsetget > -1 Then Seek filehandle, 1 + offsetget
getbyte = 0
If formato(1, pc) <> "PC" Then 'si hay que convertir a ST
    For contador9 = bytes - 1 To 0 Step -1
        Get filehandle, , byte1
        getbyte = getbyte + CSng(byte1) * 256 ^ contador9
    Next
Else
    For contador9 = 0 To bytes - 1
        Get filehandle, , byte1
        getbyte = getbyte + CSng(byte1) * 256 ^ contador9
    Next
End If
End Function
 Function redefinecolor(cadena2, color3, flag)
'flag=true para un cambio automatico de color
Dim rgb1 As Integer, rgb2 As Integer, rgb3 As Integer
Dim colora As Long, colorb As Long, colorc As Long
Dim contadora As Integer, contadorb As Double, contadorc As Double
'recomendado
rgb1 = color3 Mod 256
rgb2 = ((color3 - rgb1) / 256) Mod 256
rgb3 = ((color3 - rgb1) / 256 - rgb2) / 256
contadorc = CLng(255) * CLng(255) * CLng(255)
'je calcule le barycentre
colora = (rgb1 + rgb2 + rgb3) / 3
rgb1 = rgb1 + (rgb1 - colora) * clarity / 25
rgb2 = rgb2 + (rgb2 - colora) * clarity / 25
rgb3 = rgb3 + (rgb3 - colora) * clarity / 25
If rgb1 < 0 Then rgb1 = 0
If rgb1 > 255 Then rgb1 = 255
If rgb2 < 0 Then rgb2 = 0
If rgb2 > 255 Then rgb2 = 255
If rgb3 < 0 Then rgb3 = 0
If rgb3 > 255 Then rgb3 = 255
colorc = 0
For contadora = 0 To 15
    contadorb = (CLng(rgb1) - CLng(rgbpalettes(contadora, 0))) ^ 2 _
    + (CLng(rgb2) - CLng(rgbpalettes(contadora, 1))) ^ 2 _
    + (CLng(rgb3) - CLng(rgbpalettes(contadora, 2))) ^ 2
    If contadorb < contadorc Then contadorc = contadorb: colorc = contadora
Next
If Not flag Then
    colora = Graphread.BackColor
    Graphread.BackColor = color3
    letra = InputBox(cadena2 & "Please type the color to replace this color, from 0 to F. (Right column)." _
        + Chr(13) + "I recommend: " & Hex(colorc) + " (" + nompalettes(colorc) + ")", "Choose the new color", Hex(colorc))
    If letra = "" Then Graphread.BackColor = colora: redefinecolor = color3: Exit Function
    colorc = val2("&H" + letra)
    Graphread.BackColor = colora
    For contadorb = 0 To Graphread.Picture2.Height - 1
        For contadora = 0 To Graphread.Picture2.Width - 1
            If Graphread.Picture2.Point(contadora, contadorb) = color3 Then
                'Stop
                Graphread.Picture2.PSet (contadora, contadorb), palettes(colorc)
            End If
        Next
    Next
    SavePicture Graphread.Picture2.Image, "tmpimage"
    Graphread.Picture2.Picture = LoadPicture("tmpimage")
    If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
    Zoom.image1_DragDrop Graphread.Picture2, 1, 1
End If
redefinecolor = palettes(colorc)
End Function
Sub choosecolor(Index As Integer)
colorpalette = colors(Index)
PictureTools.Shape2.Top = PictureTools.Label4(Index).Top - 8
PictureTools.Shape2.Left = PictureTools.Label4(Index).Left - 8
End Sub
Sub setcolors()
Erase colors, nomcolors
For couleur = 0 To 15
    colors(couleur) = palettes(couleur)
    nomcolors(couleur) = nompalettes(couleur)
    PictureTools.Label4(couleur).BackColor = 0
Next
couleur = 7 'defino los colores 8 a D.
If formatos(1, pc) <> "PC" Then cadena = Info.Text2.Text: Info.Text2.Text = "&H89ABCD"
For contador = 1 To Len(Info.Text2.Text)
    If couleur > 13 Then Exit For
    hexs = Mid$(Info.Text2.Text, contador, 1)
    If hexs <> "&" And hexs <> "H" Then
    couleur = couleur + 1
    contador2 = val2("&H" & hexs)
    For contador3 = 0 To 15
        If colors(contador3) = palettes(contador2) Then Exit For
    Next
    colors(contador3) = colors(couleur)
    nomcolors(contador3) = nomcolors(couleur)
    colors(couleur) = palettes(contador2)
    nomcolors(couleur) = nompalettes(contador2)
    End If
Next
For contador = 0 To 15
    PictureTools.Label4(contador).BackColor = colors(contador)
Next
putcaptionpalette
If formatos(1, pc) <> "PC" Then Info.Text2.Text = cadena
End Sub
Sub putcaptionpalette()
Dim contador As Integer, contador3 As Single, contador4 As Single, contador5 As Single, contador2
For contador = 0 To 15
    contador2 = PictureTools.Label4(contador).BackColor
    contador3 = contador2 Mod 256
    contador4 = ((contador2 - contador3) / 256) Mod 256
    contador5 = (contador2 - contador3 - contador4 * 256) / 256 / 256
    contador3 = 128 + (128 - contador3) * 1.5: If contador3 < 0 Then contador3 = 0
    contador4 = 128 + (128 - contador4) * 1.5: If contador4 < 0 Then contador4 = 0
    contador5 = 128 + (128 - contador5) * 1.5: If contador5 < 0 Then contador5 = 0
    PictureTools.Label4(contador).ForeColor = RGB(contador3, contador4, contador5)
    For contador2 = 0 To 15
        If palettes(contador2) = PictureTools.Label4(contador).BackColor Then Exit For
    Next
    PictureTools.Label4(contador).Caption = Hex(contador2)
Next

End Sub


Sub cargarheader(a)
Dim fh, contador2, contador3
'cargo las dimensiones
fh = FreeFile(1)
Open dirgraphic For Binary Shared As fh
    If a = -1 Then  'leo del texto
        Seek fh, val2(Info.Text3.Text) + 1
    Else    'automático
        Seek fh, dimensions(a, 3) + 1
    End If
    Get fh, , byte1
    Get fh, , byte2
    Get fh, , byte3
    Get fh, , byte4
    swap
    contador2 = byte1 + CSng(byte2) * 256
    contador3 = CSng(byte3) + CSng(byte4) * 256
    Info.Label20.Caption = "(" & dimensions(Graphread.List2.ListIndex, 1) & " x " & dimensions(Graphread.List2.ListIndex, 2) & ")"
    Info.Label5.Caption = contador2 & " x " & contador3
    Info.Label5.Tag = contador2
    Info.Label20.Tag = contador3
    Info.label5_Click
    'cargo el header
    Get fh, , byte1
    Get fh, , byte2
    Get fh, , byte3
Close fh
Info.Text2.Text = "&H" & String(2 - Len(Hex(byte1)), "0") + Hex(byte1) _
& String(2 - Len(Hex(byte2)), "0") + Hex(byte2) _
& String(2 - Len(Hex(byte3)), "0") + Hex(byte3)

End Sub
Sub loadbmp2()
For contador2 = 0 To Bmp.Picture1.Height - 1
    For contador = 0 To Bmp.Picture1.Width - 1
        If Bmp.Picture1.Point(contador, contador2) = 0 Then Bmp.Picture1.PSet (contador, contador2), 1
    Next
Next
SavePicture Bmp.Picture1.Image, "tmpimage"
Bmp.Picture1.Picture = LoadPicture("tmpimage")
Graphread.Picture2.Picture = LoadPicture("tmpimage")
Zoom.Image1.Picture = LoadPicture("tmpimage")
If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
Zoom.image1_DragDrop Bmp.Picture1, 1, 1
Graphread.Picture2_DragDrop Bmp.Picture1, 1, 1
contador = val2(Mid$(Graphread.CommonDialog1.filename, Len(Trim(Graphread.CommonDialog1.filename)) - 7, 4)) - 1000
setcolors
graficomodificado = True
End Sub
Sub readhex()
Dim contador As Single, cadena2 As String, fh3
If bucleextract = True Then Exit Sub
If DebugVersion = 1 Then
    'Unknown
    Hexa.Text6.Text = ""
    Hexa.Caption = "Hexadecimals Tools - " + Trim(Graphread.List2.Text)
    Hexa.Show 0, Graphread
    If val2(Info.Text4.Text) > 32767 Then
        MsgBox ("This is too much data to be read!")
    Else
        fh3 = FreeFile(1)
        Open dirgraphic For Binary Shared As fh3
            Seek fh3, val2(Info.Text3.Text) + 1
            cadena2 = ""
            DoEvents
            For contador = 1 To val2(Info.Text4.Text)
                Get fh3, , byte1
                cadena2 = cadena2 + String(2 - Len(Hex(byte1)), "0") + Hex(byte1) + " "
                If Len(cadena2) > 2500 Then Hexa.Text6.Text = Hexa.Text6.Text + cadena2: cadena2 = ""
            Next
            If val2(Info.Text4.Text) = 0 Then cadena2 = "Lord Librasulus Smithes Thee Down"
            Hexa.Text6.Text = Hexa.Text6.Text + cadena2
        Close fh3
    End If
    If LCase(Left(Trim(Graphread.List2.Text), 9)) = "datalevel" Then
        contador = Val("&H" + Mid$(cadena2, 26, 1))
        Hexa.Label1.Caption = "Dimensions: " & columnas(0, contador) & " x " & columnas(1, contador) _
        & "     Wall graphics: " & columnas(2, contador) _
        & Chr(13) & "Pad graphics: " & columnas(3, contador) _
        & "     Monsters: " & columnas(4, contador) _
        & Chr(13) & "Door ornements: " & columnas(5, contador) _
        & "     Depth: " & columnas(6, contador)
        Hexa.Label1.Visible = True
    Else
        Hexa.Label1.Visible = False
    End If
End If
Graphread.Label8.Visible = False
End Sub
Sub readsonido()
Graphread.Label8.Caption = "Reading..."
Graphread.Label8.Visible = True
If DebugVersion = 1 And Graphread.autoopen.Checked Then
    Wav.Caption = "Wav and Midi Tools - " + Trim(Graphread.List2.Text)
    Wav.Show 0, Graphread
End If
fh3 = FreeFile(1)
Open dirgraphic For Binary Shared As fh3
    Seek fh3, val2(Info.Text3.Text) + 1
    'Intento determinar automaticamente un formato conocido
    Get fh3, , byte1
    Get fh3, , byte2
Close fh3
swap
If pc = 1 Or pc = 9 Or pc = 6 Then
    contador = CSng(byte1) * 256 + byte2
Else
    contador = CSng(byte2) * 256 + byte1
    If pc = 4 Then dimensions(Graphread.List2.ListIndex, 2) = (dimensions(Graphread.List2.ListIndex, 2) Mod 256) * 256 + Int(dimensions(Graphread.List2.ListIndex, 2) / 256)
End If
Wav.Text8.Text = contador 'Sound length ?
Wav.Text9.Text = dimensions(Graphread.List2.ListIndex, 2) 'Volume ?

cadena = "52494646" + calc_wavlength(val2(Info.Text4.Text) + 2 + 32 + 58) _
+ "57415645666D74201200000001000100" + calc_wavlength(speedwav + 1) + calc_wavlength(speedwav + 1) _
+ "0100080000006661637404000000" + calc_wavlength(val2(Info.Text4.Text) + 2 + 58) _
+ "64617461" + calc_wavlength(val2(Info.Text4.Text) + 2 + 58)

DoEvents
archivo = inipath + "\" + dm("dm", 0) + "_Extracted\" + Trim(Graphread.List2.Text) & ".wav"
fh5 = FreeFile(1)
Open archivo For Binary Access Write As fh5
    For contador = 1 To Len(cadena) - 1 Step 2
        Put fh5, , CByte(val2("&H" + Mid$(cadena, contador, 2)))
    Next
    fh3 = FreeFile(1)
    Open dirgraphic For Binary Shared As fh3
        Seek fh3, val2(Info.Text3.Text) + 1 + IIf(pc = 9, 0, 2)
                For contador = 1 + IIf(pc = 9, 0, 2) To val2(Info.Text4.Text)
                    Get fh3, , byte1
                    If pc > 1 And pc <> 6 Then 'format ST et DM2: swap 80 et 00
                        If byte1 > 127 Then byte1 = byte1 - 128 Else byte1 = byte1 + 128
                    End If
                    Put fh, , byte1
                Next
    Close fh3
Close fh5
Graphread.Label8.Visible = False
Wav.MMControl1.DeviceType = "WaveAudio"
escuchar archivo
End Sub
Sub readmidi()
Graphread.Label8.Caption = "Reading..."
Graphread.Label8.Visible = True
DoEvents

archivo = pathdefault + "\tmp.hmp"
archivo2 = inipath + "\" + dm("dm", 0) + "_Extracted\" + Trim(Graphread.List2.Text) & ".mid"
archivo3 = pathdefault + "\tmp.mid"
If Len(Dir(archivo3)) > 0 Then Kill archivo3
If Len(Dir(archivo2)) > 0 Then Kill archivo2
fh5 = FreeFile(1)
Open archivo For Binary Access Write As fh5
    fh3 = FreeFile(1)
    Open dirgraphic For Binary Shared As fh3
        Seek fh3, val2(Info.Text3.Text) + 1
                For contador = 1 To val2(Info.Text4.Text)
                    Get fh3, , byte1
                    Put fh5, , byte1
                Next
    Close fh3
Close fh5
Graphread.Label8.Caption = "Converting..."
DoEvents

If Len(Dir(pathdefault + "\Converter.exe")) = 0 Then MsgBox ("Can't find the Converter program"): Graphread.Label8.Visible = False: Exit Sub
ReturnValue = Shell(pathdefault + "\Converter.exe tmp.hmp tmp.mid", 6)
If ReturnValue = 0 Then MsgBox ("Can't execute the Converter program"): Graphread.Label8.Visible = False: Exit Sub
contador9 = Timer + 4
Do While Timer < contador9
    Graphread.Label8.Caption = "Converting... " & Int(contador9 - Timer + 1)
    DoEvents
Loop

Err.Clear
On Error Resume Next
Kill archivo
Do While Err <> 0 And Len(Dir(archivo)) > 0
    Err.Clear
    Kill archivo
    DoEvents
Loop
Err.Clear
On Error GoTo 0

AppActivate ReturnValue
SendKeys "%{F4}", True
DoEvents
AppActivate Graphread.Caption, True
DoEvents

Err.Clear
On Error Resume Next
FileCopy archivo3, archivo2
Do While Err <> 0 And Len(Dir(archivo2)) = 0
    Err.Clear
    FileCopy archivo3, archivo2
    DoEvents
    If Len(Dir(archivo3)) = 0 Then MsgBox ("Conversion Failed!"): Exit Do
Loop

Err.Clear
Kill archivo3
Do While Err <> 0 And Len(Dir(archivo3)) > 0
    Err.Clear
    Kill archivo3
    DoEvents
Loop
On Error GoTo 0

Graphread.Label8.Visible = False
Wav.MMControl1.DeviceType = ""
escuchar archivo2
End Sub
Sub escuchar(musica As String)
If bucleextract Then Exit Sub
Wav.MMControl1.Command = "Stop"
Wav.MMControl1.Command = "Close"
Wav.MMControl1.filename = musica
Wav.MMControl1.Command = "Open"
Wav.MMControl1.Command = "play"
Wav.MMControl1.Visible = True
End Sub
Sub readtexto(encriptado As Boolean)
Dim cadena2 As String, contador As Single, contador2 As Integer
Textos.Caption = "Text Tools - " + Trim(Graphread.List2.Text)
Textos.Show 0, Graphread
Graphread.Label8.Visible = True
Graphread.Label8.Caption = "Reading..."
If pc < 7 And Not encriptado Then
    Textos.Command2.Visible = True  'permite modificar los textos
    Textos.Command9.Visible = True  'permite grabar
End If
Textos.List1(1).Clear
DoEvents
fh3 = FreeFile(1)
Open dirgraphic For Binary Shared As fh3
    Seek fh3, val2(Info.Text3.Text) + 1
    cadena2 = ""
    For contador2 = 1 To val2(Info.Text4.Text)
        flag = False
        If encriptado Then
            contador = getbyte(fh3, 2, -1)
            byte3 = contador Mod 32
            contador = (contador - byte3) / 32
            byte4 = contador Mod 32
            contador = (contador - byte4) / 32
            cadena2 = cadena2 + matriz(contador) + matriz(byte4) + matriz(byte3)
            If byte3 = 31 Or byte4 = 31 Or contador = 31 Then flag = True
            contador2 = contador2 + 1 'Porque leo de dos en dos
        Else
            Get fh3, , byte1
            If byte1 > 127 Then byte1 = byte1 - 128: flag = True
            letra = Chr(byte1)
            If byte1 > 31 Then
                cadena2 = cadena2 + letra
            Else
                byte1 = byte1 + 128
                cadena2 = cadena2 + Chr(byte1)
                flag = True
            End If
        End If
        If flag Or contador = val2(Info.Text4.Text) Then
            Textos.List1(1).AddItem (cadena2)
            cadena2 = "" 'fin de palabra
        End If
    Next
    Textos.Text5.Text = Textos.List1(1).List(Textos.List1(1).ListCount - 1)
    archivo = inipath + "\" + dm("dm", 0) + "_Extracted\" + Trim(Graphread.List2.Text) & ".txt"
    fh5 = FreeFile(1)
    Open archivo For Output As fh5
        For contador = 0 To Textos.List1(1).ListCount - 1
            If Textos.List1(0).ListCount = Textos.List1(1).ListCount Then Print #fh5, Textos.List1(0).List(contador) + "   :   ";
            Print #fh5, Textos.List1(1).List(contador)
        Next
    Close fh5
    If Textos.List1(1).ListCount > 0 Then Textos.List1(1).ListIndex = 0
    Textos.Command2_Click
Close fh3
Textos.List1(0).Visible = Textos.List1(0).ListCount = Textos.List1(1).ListCount
Textos.Label6(3).Caption = val2(Info.Text4.Text)

End Sub
Sub readimagen()
    Graphread.Label8.Caption = "Reading..."
    Info.Text1(0).Enabled = True    'width
    Info.Text1(1).Enabled = True    'height
    Graphread.Label8.Visible = False
    If val2(Info.Text1(0).Text) = 0 Or val2(Info.Text1(1).Text) = 0 Then Exit Sub
    If (val2(Info.Text1(0).Text) > 320 Or val2(Info.Text1(1).Text) > 240) And Graphread.Viewnotbig.Checked Then Exit Sub
    If Trim(Left(Graphread.List2.Text, 4)) = "Free" Then Exit Sub
    If pc < 4 Or pc = 6 Then Info.Text2.Enabled = True 'header
    Graphread.Label8.Visible = True
    Graphread.Picture2.Visible = True
    Graphread.Picture2.Width = Info.Text1(0).Text
    Graphread.Picture2.Height = Info.Text1(1).Text
    setcolors
    Graphread.Label8.Caption = "Uncompressing..."
    DoEvents
    uncompressing
    
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then
        fh5 = FreeFile(1)
        Open inipath + "\" + dm("dm", 0) + "_Extracted\read.txt" For Output As fh5
            Print #fh5, cadenahecha
            Print #fh5, "length=" & Int(contador7 + 7.5)
            Print #fh5, "Unprocessed: " & cadena2
        Close fh5
    End If
    Graphread.Picture2.Refresh
    SavePicture Graphread.Picture2.Image, "tmpimage"
    Graphread.Picture2.Picture = LoadPicture("tmpimage")
    If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
    For contador = 1 To 8
        If contador * Graphread.Picture2.Width > 800 Or contador * Graphread.Picture2.Height > 600 Then Exit For
    Next
    contador = contador - 1
    Zoom.Width = 336 + (Graphread.Picture2.Width * contador) * 12
    Zoom.Height = 384 + (Graphread.Picture2.Height * contador) * 12
    Zoom.image1_DragDrop Graphread.Picture2, 1, 1
    If (DebugVersion = 0 Or Graphread.autoopen.Checked) And bucleextract = False Then Zoom.Show 0, Graphread
    If Graphread.autoopen.Checked And DebugVersion = 1 And bucleextract = False Then PictureTools.Show 0, Graphread
    graficomodificado = False
End Sub
Sub uncompressing()
Dim contador As Integer
fh3 = FreeFile(1)
Open dirgraphic For Binary Shared As fh3
    Seek fh3, val2(Info.Text3.Text) + 5 + formato(5, pc)
    bucleflag = True
    cadenaespecial = LCase(Trim(formatos(1, pc) + formatos(0, pc)))
    Select Case cadenaespecial
    Case "pcdm graphics"
        uncompress 1
    Case "pcdm2 graphics"
        If Info.Label5.Tag > 32700 Or Info.Label20.Tag > 32700 Then
            uncompress 3    '256 colores
        Else
            '16 colores
            cadena2 = ""
            Seek fh3, 1 + val2(Info.Text3.Text) + val2(Info.Text4.Text) - 16
            For contador = 0 To 15
                leer
                byte2 = byte1
                leer
                palettedm2(contador) = dm2colors(byte2, byte1)
            Next
            Seek fh3, val2(Info.Text3.Text) + 5 + formato(5, pc)
            uncompress 1
        End If
    Case Else
        If Right(LCase(formatos(0, pc)), 7) = "dungeon" Then
            uncompress 4
        Else
        If Info.Text1(0).Text = Info.Label5.Tag / 2 And Info.Text1(1).Text = Info.Label20.Tag / 8 Then
            uncompress 5
            Else
            uncompress 2
            End If
        End If
    End Select
Close fh3
End Sub
Sub inc(p As Long)
Dim contador3
If Graphread.Filedebug.Checked And DebugVersion = 1 Then
    For contador3 = 15 To 0 Step -1
        If colors(contador3) = color2 Then Exit For
    Next
    Print #fh4, "Color: " & contador3 & "     Distancia: " & p
End If
If p > val2(Info.Text1(0).Text) Then p2 = p - val2(Info.Text1(0).Text): p = p - p2 Else p2 = 0
contador3 = contador + p - 1
If color2 > 0 Then
    If contador3 < val2(Info.Text1(0).Text) Then  'se dibuja la columna normal
        Graphread.Picture2.Line (contador, contador2)-(contador3, val2(Info.Text1(1).Text)), color2, BF
    Else    'se dibuja en dos veces
        Graphread.Picture2.Line (contador, contador2)-(val2(Info.Text1(0).Text) - 1, val2(Info.Text1(1).Text)), color2, BF
        Graphread.Picture2.Line (0, contador2 + 1)-(contador3 Mod val2(Info.Text1(0).Text), val2(Info.Text1(1).Text)), color2, BF
    End If
End If
contador3 = contador3 + p2 + 1
contador = contador3 Mod val2(Info.Text1(0).Text)
contador2 = contador2 + Int((contador3 - contador) / val2(Info.Text1(0).Text))
If contador3 > contador Then Graphread.Picture2.Refresh
End Sub
Sub uncompress(modo As Integer)
If DebugVersion = 1 And Graphread.Filedebug.Checked Then
    fh4 = FreeFile(1)
    Open inipath + "\plainread.txt" For Output As fh4
End If
If Graphread.Algorithm(0).Checked = False Then
    For modo = 1 To 5
        If Graphread.Algorithm(modo).Checked Then Exit For
    Next
End If
ReDim Preserve tablacodigos(255)
distancia = 0
cadena2 = ""
contador7 = 0   'length
contador = 0    'pixel x
contador2 = 0   'pixel y
cadenahecha = ""
letra = "00000000"

Select Case modo
Case 1  'PC prioritized palette with run length encoding
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then prepararcadena2
    Do While contador2 < val2(Info.Text1(1).Text) And bucleflag And contador7 < val2(Info.Text4.Text)
        leercolor
        inc distancia
        If DebugVersion = 1 And Graphread.Filedebug.Checked Then cadenahecha = cadenahecha + " "
    Loop
Case 2  'Run length encoding
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then prepararcadena2
    Do While contador2 < val2(Info.Text1(1).Text) And bucleflag
        leercolornopc
        inc distancia
        If DebugVersion = 1 And Graphread.Filedebug.Checked Then cadenahecha = cadenahecha + " "
    Loop
Case 3  'Raw 256 colours palette
    Get fh3, , byte1: Get fh3, , byte1: Get fh3, , byte1 'Header?
    cadenahecha = ""
    For contador2 = 0 To Graphread.Picture2.Height - 1
        For contador = 0 To Graphread.Picture2.Width - 1
            Get fh3, , byte1
            If DebugVersion = 1 And Graphread.Filedebug.Checked Then cadenahecha = cadenahecha + String(2 - Len(Hex(byte1)), "0") & Hex(byte1)
            color2 = dm2colors(Int(byte1 / 16), (byte1 Mod 16))
            Graphread.Picture2.PSet (contador, contador2), color2
        Next
        Graphread.Picture2.Refresh
    Next
    
    cadena2 = ""
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then
   'Si sobró algo no procesado
        For contador = 1 + Graphread.Picture2.Width * Graphread.Picture2.Height To val2(Info.Text4.Text) - 4 - formato(5, pc)
            letra = String(2 - Len(Hex(byte1)), "0") & Hex(byte1)
            cadena2 = cadena2 + letra
        Next
    End If
Case 4  'Raw 16 colours palette
    Seek fh3, val2(Info.Text3.Text) + 1 + formato(5, pc)
    cadenahecha = ""
    For contador2 = 0 To Graphread.Picture2.Height - 1
        For contador = 0 To Graphread.Picture2.Width - 1
            Get fh3, , byte1
            If DebugVersion = 1 And Graphread.Filedebug.Checked Then cadenahecha = cadenahecha + String(2 - Len(Hex(byte1)), "0") & Hex(byte1)
            color2 = palettes(Int(byte1 / 16))
            Graphread.Picture2.PSet (contador, contador2), color2
            contador = contador + 1: If contador > Graphread.Picture2.Width - 1 Then contador = 0: contador2 = contador2 + 1
            color2 = palettes(byte1 Mod 16)
            Graphread.Picture2.PSet (contador, contador2), color2
        Next
        Graphread.Picture2.Refresh
    Next
Case 5  'LZW
    Dim auxi
fh2 = FreeFile(1)
Open "LZW.txt" For Output As fh2
    
    Seek fh3, val2(Info.Text3.Text) + 1 + formato(5, pc)
    Do While contador2 < val2(Info.Text4.Text) And bucleflag
        code = getnextcode(fh3) 'first code
        Print #fh2, code
    Loop
    Close fh2
    
    
    
    
    
    
    Seek fh3, val2(Info.Text3.Text) + 1 + formato(5, pc)
    code = getnextcode(fh3) 'first code
    
    cadenahecha = tablacodigos(code)
    old = code
    maxcode = 256
    Do While contador2 < val2(Info.Text4.Text) And bucleflag
    code = getnextcode(fh3)
    ReDim Preserve tablacodigos(maxcode)
    If code < maxcode Then  'codigo conocido
        cadenahecha = cadenahecha + " " + tablacodigos(code)
        auxi = Left(tablacodigos(code), 2)
        tablacodigos(maxcode) = tablacodigos(old) + " " + auxi
    Else    'nuevo codigo
        auxi = Left(tablacodigos(old), 2)
        cadenahecha = cadenahecha + " " + tablacodigos(old) + " " + auxi
        tablacodigos(maxcode) = tablacodigos(old) + " " + auxi
    End If
    maxcode = maxcode + 1
    old = code
    Loop
    'Stop
End Select
If DebugVersion = 1 And Graphread.Filedebug.Checked Then Close fh4
End Sub
Function getnextcode(filehandler)
Dim longueur As Byte, letra3 As String, contador As Integer
'   determino si se debe leer 9 o 12 bits
longueur = IIf(maxcode < 512, 9, 12)
Do While Len(letra) < longueur
    getmorecode filehandler
Loop

'    Extraigo el codigo
letra3 = Right(letra, longueur)
letra = Left(letra, Len(letra) - longueur)
getnextcode = 0

For contador = 1 To longueur
    If Mid$(letra3, contador, 1) = "1" Then getnextcode = getnextcode + 2 ^ (longueur - contador)
Next
End Function
Sub getmorecode(filehandler)
Dim letra2 As Long, letra3 As String, contador As Integer, auxi As Long
letra2 = getbyte(filehandler, 2)
contador2 = contador2 + 2
letra3 = ""
For contador = 15 To 0 Step -1
    auxi = 2 ^ contador
    If Int(letra2 / auxi) = 1 Then
        letra2 = letra2 - auxi
        letra3 = letra3 + "1"
    Else
        letra3 = letra3 + "0"
    End If
Next
letra = letra3 + letra
End Sub
Sub prepararcadena2()
cadenahecha = ""
For contador = 1 To val2(Info.Text4.Text) - 4 - formato(5, pc) - _
IIf(dimensions(Graphread.List2.ListIndex, 2) > 32700 Or dimensions(Graphread.List2.ListIndex, 1) > 32700, 3, 0)
    Get fh3, , byte1
    letra = String(2 - Len(Hex(byte1)), "0") & Hex(byte1)
    cadena2 = cadena2 + letra
Next
contador = 0
End Sub
Sub grabarinicio(archivotmp)
Dim fh As Integer
'modifico los lengths y dimensiones
fh = FreeFile(1)
Open dirgraphic + ".tmp" For Binary Access Read As fh
    fh5 = FreeFile(1)
    Open archivotmp For Binary Access Write As fh5
        Seek fh5, 1 + Graphread.List2.ListIndex * 2 + formato(6, pc)
        Put fh5, , CInt(swapcint(val2(Info.Label11.Caption))) 'length
        Select Case pc
        Case 1  'PC DM
            Seek fh5, 1 + objetos(0, 0, pc) * 2 + Graphread.List2.ListIndex * 2 + formato(6, pc)
            Put fh5, , CInt(swapcint(val2(Info.Label11.Caption)))  'length
            
            Seek fh5, 1 + objetos(0, 0, pc) * 4 + Graphread.List2.ListIndex * 4 + formato(6, pc)
            Put fh5, , CInt(swapcint(val2(Info.Text1(0).Text)))  'width
            Put fh5, , CInt(swapcint(val2(Info.Text1(1).Text)))  'height
        Case 2, 3   'PC DM2
        Case 4  'Amiga CSB
            Seek fh5, 1 + objetos(0, 0, pc) * 2 + Graphread.List2.ListIndex * 2 + formato(6, pc)
            Put fh5, , CInt(swapcint(val2(Info.Label11.Caption)))  'length
            
            Seek fh5, 1 + objetos(0, 0, pc) * 4 + Graphread.List2.ListIndex * 4 + formato(6, pc)
            Put fh5, , CInt(swapcint(val2(Info.Text1(0).Text)))  'width
            Put fh5, , CInt(swapcint(val2(Info.Text1(1).Text)))  'height
        Case 5  'ST CSB
            Seek fh5, 1 + objetos(0, 0, pc) * 2 + Graphread.List2.ListIndex * 2 + formato(6, pc)
        Put fh5, , CInt(swapcint(val2(Info.Label11.Caption))) 'length
        Case 7  'Amiga HINT
            Seek fh5, 2 + objetos(0, 0, pc) * 2 + Graphread.List2.ListIndex * 4 + formato(6, pc)
        Put fh5, , CInt(swapcint(val2(Info.Label11.Caption))) 'length
        Case 8  'ST HINT
            Seek fh5, 1 + objetos(0, 0, pc) * 2 + Graphread.List2.ListIndex * 2 + formato(6, pc)
        Put fh5, , CInt(swapcint(val2(Info.Label11.Caption))) 'length
        Case 9  'Song
        Case Else
        End Select
    Close fh5
Close fh
End Sub
Sub defaults()
Dim contador, contador2, contador3
inipath = CurDir()
dirgraphic = CurDir() + "\Graphics.dat"
inifile = CurDir() + "\graphics.dat"
inibmp = CurDir() + "\dmout1000.dat"
inisphenx = CurDir() + "\Sphenx.exe"
contador3 = pc
pc = 0
contador = 0
ReDim formatos(6, contador)
If Len(Dir(pathdefault + "\data", 16)) = 0 Then
    MkDir (pathdefault + "\data")
End If

If Len(Dir(pathdefault + "\data\graphread.ini")) > 0 Then
    fh5 = FreeFile(1)
    Open pathdefault + "\data\graphread.ini" For Input As fh5
        Line Input #fh5, inipath
        Line Input #fh5, dirgraphic
        Line Input #fh5, inifile
        Line Input #fh5, inibmp
        Line Input #fh5, inisphenx
        If Len(Dir(inipath, 16)) = 0 Then inipath = CurDir()
        If Len(Dir(dirgraphic, 16)) = 0 Then dirgraphic = CurDir() + "\Graphics.dat"
        If Len(Dir(inifile)) = 0 Then inifile = CurDir() + "\graphics.dat"
        If Len(Dir(inibmp)) = 0 Then inibmp = CurDir() + "\dmout1000.dat"
        If Len(Dir(inisphenx)) = 0 Then inisphenx = CurDir() + "\Sphenx.exe"
        Do While Not EOF(fh5)
            Line Input #fh5, cadena
            cadena = Trim(cadena)
            If cadena = "FILE:" Then 'no lee los comentarios
                contador = contador + 1
                ReDim Preserve formatos(6, contador)
                For contador2 = 0 To 6
                    If Not EOF(fh5) Then Input #fh5, cadena
                    formatos(contador2, contador) = cadena
                Next
            End If
        Loop
    Close fh5
End If
If contador = 0 Then initformatos  'En caso de faltar las definiciones de formato
knownformats = ""
For pc = 1 To UBound(formatos, 2)
    knownformats = knownformats + dm("dm", 0) + Chr(13)
Next
pc = contador3
putcaption
End Sub
Sub putcaption()
Dim contador6, cadena, conatdor7
contador6 = (Graphread.ScaleWidth / 8 - 40) / 2
cadena = dirgraphic
contador7 = 0
Do While Len(cadena) > contador6 And contador7 <> 1
    contador7 = InStr(1, cadena, "\") + 1
    cadena = Mid$(cadena, contador7)
Loop
If Len(cadena) < Len(dirgraphic) Then cadena = "...\" + cadena
Graphread.Caption = version & IIf(DebugVersion = 1, " (Debug) ", "") _
& App.Major & "." & App.Minor & "." & App.Revision & "    " _
& dm("dm", 0) + " -  (   " + cadena + "   )"

End Sub

Sub r(nom As String)
Select Case Left(nom, 1)
Case Is = "U"
    nombres(contador) = "Unknown" & contador
Case "F"
    nombres(contador) = "Free" & contador
Case Else
nombres(contador) = nom
End Select
contador = contador + 1
End Sub

Sub readtext(nom As String)
Textos.List1(0).AddItem (nom)
End Sub

Sub swap()
Dim contador10
If formato(1, pc) <> "PC" Then 'si hay que convertir a ST
    contador10 = byte1
    byte1 = byte2
    byte2 = contador10
    contador10 = byte3
    byte3 = byte4
    byte4 = contador10
End If
End Sub
 Function swapcint(ByVal a As Integer)
Dim contador10
swapcint = CInt(a)
If formato(1, pc) <> "PC" Then 'si hay que convertir a ST
    contador10 = a Mod 256
    a = (a - contador10) / 256
    swapcint = CSng(contador10 * 256 + a)
    If swapcint > 32767 Then swapcint = swapcint - 65536
End If
End Function
Sub formathexs(flag)
If Not Graphread.Filedebug.Checked Then Exit Sub
If flag Then Hexa.Text6.Text = Trim(Hexa.Text6.Text)
Graphread.Label8.Caption = "Checking..."
Graphread.Label8.Visible = True
cadena = ""
cadenahecha = ""
For contador = 1 To Len(Hexa.Text6.Text)
    letra = Mid$(Hexa.Text6.Text, contador, 1)
    If (contador - 1) Mod 3 = 2 Then  'espacio
        If letra <> " " Then letra = " "
    Else '1era y 2nda letra
        If val2("&H" + letra) = 0 And letra <> "0" Then letra = "."
    End If
    cadena = cadena + Trim(letra)
    cadenahecha = cadenahecha + letra
Next
cadena = Trim(cadena)
Info.Label11.Caption = Len(cadena) / 2
If flag Then Hexa.Text6.Text = cadenahecha
Info.Text2.Text = "&H" + Mid$(cadena, 9, 6) 'header
Info.Text1(0).Text = val2("&H" + Mid$(cadena, 3, 2) + Mid$(cadena, 1, 2)) 'width
Info.Text1(1).Text = val2("&H" + Mid$(cadena, 7, 2) + Mid$(cadena, 5, 2)) 'height
Graphread.Label8.Visible = False
End Sub
Sub rehacercolores()
Dim contador2, contador, contador3, ultimocolor, cadena2
For contador2 = 0 To Graphread.Picture2.Height - 1
    For contador = 0 To Graphread.Picture2.Width - 1
        ultimocolor = Graphread.Picture2.Point(contador, contador2)
        For contador3 = 0 To 15 'couleur prioritaire, palette relative
            If palettes(contador3) = ultimocolor Then Exit For
        Next
        If contador3 = 16 Then
            cadena2 = "Unknown color:" & ultimocolor & Chr(13)
            Graphread.Picture2.PSet (contador, contador2), redefinecolor(cadena2, ultimocolor, True)
        End If
    Next
    Graphread.Picture2.Refresh
    Zoom.Image1.Refresh
Next
End Sub
Sub init3()
Dim fh2, contador, contador2, contador3, cadena, pcontador, byte1, byte2, byte3
palettesDM2(0, 0, 15) = 236
palettesDM2(0, 1, 15) = 180
palettesDM2(0, 2, 15) = 72

palettesDM2(1, 0, 15) = 216
palettesDM2(1, 1, 15) = 84
palettesDM2(1, 2, 15) = 252

palettesDM2(2, 0, 15) = 0
palettesDM2(2, 1, 15) = 0
palettesDM2(2, 2, 15) = 252

palettesDM2(3, 0, 15) = 0
palettesDM2(3, 1, 15) = 252
palettesDM2(3, 2, 15) = 252

palettesDM2(4, 0, 15) = 252
palettesDM2(4, 1, 15) = 240
palettesDM2(4, 2, 15) = 196

palettesDM2(5, 0, 15) = 172
palettesDM2(5, 1, 15) = 252
palettesDM2(5, 2, 15) = 172

palettesDM2(6, 0, 15) = 100
palettesDM2(6, 1, 15) = 220
palettesDM2(6, 2, 15) = 152

palettesDM2(7, 0, 15) = 0
palettesDM2(7, 1, 15) = 252
palettesDM2(7, 2, 15) = 0

palettesDM2(8, 0, 15) = 252
palettesDM2(8, 1, 15) = 252
palettesDM2(8, 2, 15) = 0

palettesDM2(9, 0, 15) = 252
palettesDM2(9, 1, 15) = 184
palettesDM2(9, 2, 15) = 0

palettesDM2(10, 0, 15) = 252
palettesDM2(10, 1, 15) = 136
palettesDM2(10, 2, 15) = 0

palettesDM2(11, 0, 15) = 252
palettesDM2(11, 1, 15) = 0
palettesDM2(11, 2, 15) = 0

palettesDM2(12, 0, 15) = 144
palettesDM2(12, 1, 15) = 84
palettesDM2(12, 2, 15) = 40

palettesDM2(13, 0, 15) = 252
palettesDM2(13, 1, 15) = 204
palettesDM2(13, 2, 15) = 152

palettesDM2(14, 0, 15) = 208
palettesDM2(14, 1, 15) = 208
palettesDM2(14, 2, 15) = 192

palettesDM2(15, 0, 15) = 252
palettesDM2(15, 1, 15) = 252
palettesDM2(15, 2, 15) = 252
For contador3 = 0 To 15
    For contador = 0 To 14
        For contador2 = 0 To 2
            palettesDM2(contador3, contador2, contador) = palettesDM2(contador3, contador2, 15) * contador / 15
        Next
    Next
Next

End Sub
Sub fill(x As Integer, Y As Integer, color1 As Long, color2 As Long, first As Boolean)
If first Then ReDim pile(0)
contador = x
Do While Graphread.Picture2.Point(contador, Y) = color1
    Graphread.Picture2.PSet (contador, Y), color2
    If Graphread.Picture2.Point(contador, Y - 1) = color1 _
    And (Graphread.Picture2.Point(contador + 1, Y - 1) <> color1 _
    Or Graphread.Picture2.Point(contador + 1, Y) <> color1) Then addpile CInt(contador), Y - 1
    If Graphread.Picture2.Point(contador, Y + 1) = color1 _
    And (Graphread.Picture2.Point(contador + 1, Y + 1) <> color1 _
    Or Graphread.Picture2.Point(contador + 1, Y) <> color1) Then addpile CInt(contador), Y + 1
    contador = contador + 1
Loop
contador = x - 1
Do While Graphread.Picture2.Point(contador, Y) = color1
    Graphread.Picture2.PSet (contador, Y), color2
    If Graphread.Picture2.Point(contador, Y - 1) = color1 _
    And (Graphread.Picture2.Point(contador - 1, Y - 1) <> color1 _
    Or Graphread.Picture2.Point(contador - 1, Y) <> color1) Then addpile CInt(contador), Y - 1
    If Graphread.Picture2.Point(contador, Y + 1) = color1 _
    And (Graphread.Picture2.Point(contador - 1, Y + 1) <> color1 _
    Or Graphread.Picture2.Point(contador - 1, Y) <> color1) Then addpile CInt(contador), Y + 1
    contador = contador - 1
Loop
If first Then
    contador2 = 0
    Do
        contador2 = contador2 + 2
        If contador2 > UBound(pile) Then Exit Do
        contador3 = pile(contador2 - 1)
        contador4 = pile(contador2)
        fill CInt(contador3), CInt(contador4), color1, color2, False
        Graphread.Picture2.Refresh
    Loop
End If
End Sub
Sub addpile(x As Integer, Y As Integer)
ReDim Preserve pile(UBound(pile) + 2)
pile(UBound(pile) - 1) = x
pile(UBound(pile)) = Y
End Sub
Sub undo(flag As Boolean)
If flag Then
    If Graphread.Picture4.Picture = 0 Then
        Zoom.Image1.Picture = LoadPicture()
        Graphread.Picture2.Picture = LoadPicture()
    Else
        SavePicture Graphread.Picture4.Picture, "tmpimage"
        Zoom.Image1.Picture = LoadPicture("tmpimage")
        Graphread.Picture2.Picture = LoadPicture("tmpimage")
        If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
    End If
Else
    If Zoom.Image1.Picture = 0 Then
        Graphread.Picture4.Picture = LoadPicture()
    Else
        SavePicture Zoom.Image1.Picture, "tmpimage"
        Graphread.Picture4.Picture = LoadPicture("tmpimage")
        If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
    End If
End If
End Sub

Sub buildgraphics_object()
'hace lo mismo que savegraphics pero en una optica masiva
archivo2 = inipath + "\" + dm("dm", 0) + "_Extracted\write.txt"
cadena = Right(Trim(Info.Text2.Text), Len(Trim(Info.Text2.Text)) - 2)
If Len(cadena) <> 6 Then MsgBox ("Header Error!"): Exit Sub
Graphread.Label8.Visible = True
Graphread.Label8.Caption = "Saving..."
DoEvents
'pongo las dimensiones          ocupan 2 bytes cada una
Put fh4, , CInt(swapcint(val2(Info.Text1(0).Text)))
Put fh4, , CInt(swapcint(val2(Info.Text1(1).Text)))
'pongo el header
If pc < 4 Or pc = 6 Then
    For contador = 1 To 3
        byte1 = val2("&H" + Left(cadena, 2))
        Put fh4, , byte1
        cadena = Right(cadena, Len(cadena) - 2)
    Next
End If
'Pongo la parte distinta
fh2 = FreeFile(1)
Open archivo2 For Binary Access Read As fh2
    Do While Not EOF(fh2)
        Get fh2, , byte1
        If EOF(fh2) Then Exit Do
        Put fh4, , byte1
    Loop
Close fh2

grabarinicio (dirgraphic + ".tmp")
Graphread.Label8.Visible = False
End Sub

Sub init()
If DebugVersion = 1 Then
    Graphread.MenuTools.Visible = flag
    Graphread.Picture2.Visible = flag
    Graphread.Command16.Visible = flag
    Graphread.viewhex.Visible = flag
    Graphread.viewgraphics.Visible = flag
    Graphread.Viewnotbig.Visible = flag
    Graphread.Filedebug.Visible = flag
    Graphread.Menuconvert.Visible = flag
    Graphread.Menuundo.Visible = flag
    Graphread.Extractlist.Visible = flag
    Graphread.Menuadvanced.Visible = flag
    Graphread.ChooseGraphics.Visible = flag
    Graphread.Analyse.Visible = flag
    Graphread.buildgraphics.Visible = flag
    Graphread.Savegraphics.Visible = flag
    Graphread.Loadbmp.Visible = flag
    For contador = 0 To 6
        Graphread.Command2(contador).Visible = flag
    Next
End If
'nombres
palettes(0) = 1 'noir
palettes(1) = 7171437 'grisfoncé
palettes(2) = 9539985 'gris
palettes(3) = 9325 'marrontrèsfoncé
palettes(4) = 14605824 '14342656'bleuclair
palettes(5) = 19092 '18577'marronfoncé
palettes(6) = 37120 'vertfoncé
palettes(7) = 55808 'vertclair
palettes(8) = 255 'rouge
palettes(9) = 46847 'orangedoré
palettes(10) = 7180762 'rose
palettes(11) = 65535 'jaune
palettes(12) = 2438490 '4737096'gristrèsfoncé
palettes(13) = 11974326 'grisclair
palettes(14) = 16711680 'bleu
palettes(15) = 16777215 'blanc

init3
For contador = 0 To 15
    rgbpalettes(contador, 0) = palettes(contador) Mod 256
    rgbpalettes(contador, 1) = ((palettes(contador) - rgbpalettes(contador, 0)) / 256) Mod 256
    rgbpalettes(contador, 2) = ((palettes(contador) - rgbpalettes(contador, 0)) / 256 - rgbpalettes(contador, 1)) / 256
Next
nompalettes(0) = "black"
nompalettes(1) = "dark gray"
nompalettes(2) = "grey"
nompalettes(3) = "dark brown"
nompalettes(4) = "light blue"
nompalettes(5) = "brown"
nompalettes(6) = "dark green"
nompalettes(7) = "light green"
nompalettes(8) = "red"
nompalettes(9) = "golden orange"
nompalettes(10) = "pink flesh"
nompalettes(11) = "yellow"
nompalettes(12) = "very light gray"
nompalettes(13) = "light gray"
nompalettes(14) = "blue"
nompalettes(15) = "white"

End Sub

Function cumulate()
Dim contador5, contador2, contador3, contador4
For contador4 = 0 To 25
    If LCase(Left(maxobjetos(contador4, 6, pc), 9)) = "datalevel" Then Exit For
Next
If contador4 = 26 Then
    ReDim columnas(8, 0)
    Exit Function
Else
    ReDim columnas(8, objetos(contador4, 0, pc))
End If
'0: dimensión x
'1: dimensión y
'2: number of walls graphics
'3: number of pads graphics
'4: number of ornate graphics
'5: number of monsters
'6: depth
'7: length  of map data
'8: relative offset (starting from 0))
contador2 = 0
For contador5 = 0 To objetos(contador4, 0, pc)
    contador3 = dm("offset", 0, contador4)
    contador3 = Int(getbyte(fh, 2, 8 + contador5 * 16 + contador3) / 64)
    byte3 = contador3 Mod 32
    contador3 = (contador3 - byte3) / 32
    contador2 = contador2 + byte3 + 1
    columnas(0, contador5) = byte3 + 1
    columnas(1, contador5) = contador3 + 1
    contador3 = getbyte(fh, 1, 10 + contador5 * 16 + formato(6, pc)) Mod 16
    columnas(2, contador5) = contador3
    contador3 = getbyte(fh, 1, 11 + contador5 * 16 + formato(6, pc)) Mod 16
    columnas(3, contador5) = contador3
    contador3 = getbyte(fh, 1, 12 + contador5 * 16 + formato(6, pc))
    byte3 = contador3 Mod 16
    contador3 = (contador3 - byte3) / 16
    columnas(4, contador5) = contador3
    columnas(5, contador5) = byte3
    contador3 = getbyte(fh, 1, 13 + contador5 * 16 + formato(6, pc))
    columnas(6, contador5) = contador3
    'lenght:
    contador3 = columnas(0, contador5) * columnas(1, contador5) + columnas(2, contador5) _
    + columnas(3, contador5) + columnas(4, contador5) + columnas(5, contador5)
    columnas(7, contador5) = contador3
    'Offset
    If contador5 = 0 Then
        columnas(8, contador5) = 0
    Else
        columnas(8, contador5) = columnas(8, contador5 - 1) + columnas(7, contador5 - 1)
    End If
Next
cumulate = contador2
End Function
 Function number(numberfrase As String, numberposicion As Integer, numberoperacion As String) As String
Dim letra1 As String, letra2 As String, contador As Integer, contador2 As Integer
Dim frase As String, posicion As Integer, operacion As String
frase = numberfrase
posicion = numberposicion
operacion = numberoperacion
number = ""
For contador = posicion + 1 To Len(frase)
    letra2 = Trim(Mid$(frase, contador, 1))
    If letra2 = "*" Or letra2 = "/" Or letra2 = "+" Or letra2 = "-" Then Exit For
    number = number + letra2
Next
contador = contador - 1
If Left(number, 1) = "#" Then number = Hex(getbyte(fh, 2, val2("&H" + Right(number, Len(number) - 1))))
If LCase(number) = "cumulate" Then number = Hex(cumulate())
If LCase(number) = "lof" Then number = Hex(LOF(fh))
If operacion > "" Then  'Si hay un segundo operando
    letra1 = ""
    For contador2 = posicion - 1 To 1 Step -1
        letra2 = Trim(Mid$(frase, contador2, 1))
        If letra2 = "*" Or letra2 = "/" Or letra2 = "+" Or letra2 = "-" Then Exit For
        letra1 = letra2 + letra1
    Next
    contador2 = contador2 + 1
    If Left(letra1, 1) = "#" Then letra1 = Hex(getbyte(fh, 2, val2("&H" + Right(letra1, Len(letra1) - 1))))
    If LCase(letra1) = "cumulate" Then letra1 = Hex(cumulate())
    If LCase(letra1) = "lof" Then letra1 = Hex(LOF(fh))
Else
    contador2 = posicion + 1 'Si no hay operador se empieza por el numero directamente
End If

Select Case operacion
Case "*"
    number = Hex(val2("&H" + letra1) * val2("&H" + number))
Case "/"
    number = Hex(val2("&H" + letra1) / val2("&H" + number))
Case "+"
    number = Hex(val2("&H" + letra1) + val2("&H" + number))
Case "-"
    number = Hex(val2("&H" + letra1) - val2("&H" + number))
End Select
number = mid2(frase, contador2, contador - contador2 + 1, number) 'lo remplazo
End Function
 Function mid2(mid2frase As String, mid2principio As Integer, mid2longitud As Integer, mid2frase2 As String) As String
Dim letra1 As String, letra2 As String
Dim frase As String, principio As Integer, longitud As Integer, frase2 As String
frase = mid2frase
principio = mid2principio
longitud = mid2longitud
frase2 = mid2frase2
letra1 = Left(frase, principio - 1)
letra2 = Right(frase, Len(frase) - principio - longitud + 1)
mid2 = letra1 + frase2 + letra2
End Function
 Function parser(parserfrase As String) As String
Dim pcontador As Integer, pcontador2 As Integer, pcontador3 As Integer, letra1 As String, letra2 As String
Dim frase As String
frase = Trim(parserfrase)
If frase = "" Or frase = "0" Then parser = "0": Exit Function
letra1 = ""
For pcontador = 1 To Len(frase)
    letra1 = letra1 + Trim(Mid$(frase, pcontador, 1))
Next
frase = letra1
pcontador = InStr(frase, ")")
Do While pcontador > 0   'Primero los parentesis
    pcontador2 = InStr(frase, "(")
    pcontador3 = 1
    Do While pcontador3 < pcontador And pcontador3 > 0 'Recorro hasta encontrar el ( que corresponde
        pcontador2 = pcontador3
        pcontador3 = InStr(pcontador2, frase, "(")
        If pcontador3 = pcontador2 Then Exit Do
    Loop
    letra1 = parser(Mid$(frase, pcontador2 + 1, pcontador - pcontador2 - 1))   'analiso el trozo
    frase = mid2(frase, pcontador2, pcontador - pcontador2 + 1, letra1) 'lo remplazo
    pcontador = InStr(frase, ")")    'Continuo el bucle
Loop
frase = parser_operaciones(frase, "*")
frase = parser_operaciones(frase, "/")
frase = parser_operaciones(frase, "+")
frase = parser_operaciones(frase, "-")
frase = number(frase, 0, "")
parser = frase
End Function
 Function parser_operaciones(parser_operacionesfrase As String, parser_operacionesoperacion As String) As String
Dim contadorpo As Integer
Dim frase As String, operacion As String
frase = parser_operacionesfrase
operacion = parser_operacionesoperacion
contadorpo = InStr(frase, operacion)
Do While contadorpo > 0
    frase = number(frase, contadorpo, operacion)
    contadorpo = InStr(frase, operacion)
Loop
parser_operaciones = frase
End Function
 Function objetos(objetosnumero, objetosatributo, objetosplataforma)
Dim contador
Dim numero, atributo, plataforma
numero = objetosnumero
atributo = objetosatributo
plataforma = objetosplataforma
contador = pc
pc = plataforma
objetos = val2("&H" + parser(maxobjetos(numero, atributo, plataforma)))
pc = contador
End Function
 Function formato(formatoatributo, formatoplataforma)
Dim contador, atributo, plataforma
atributo = formatoatributo
plataforma = formatoplataforma
contador = pc
pc = plataforma
formato = formatos(atributo, plataforma)
If atributo > 3 Then
    formato = val2("&H" + formato)
End If
pc = contador
End Function
 Function val2(a)
val2 = Val(a)
If Left(a, 1) = "&" Then
    val2 = val2 + IIf(val2 < 0, 65536, 0)
End If
End Function

 Function dm(choix, choix2, Optional choix3 = 26)
Dim contador8 As Single, contador9 As Integer
Select Case LCase(choix)
Case "suma" 'cuantos objetos hay antes
    contador9 = 0
    If choix2 > 0 Then
        For contador8 = 0 To choix2 - 1
            If objetos(contador8, 0, pc) > 0 Then contador9 = contador9 + objetos(contador8, 0, pc)
        Next
    End If
    dm = contador9
Case "objects"  'determina cuantos items hay que leer
    contador9 = 0
    For contador8 = 0 To choix3 - 1
        If objetos(contador8, choix2, pc) > 0 Then contador9 = contador9 + objetos(contador8, 0, pc)
    Next
    dm = contador9
Case "dm"   'nombre del formato
    If pc > UBound(formatos, 2) Or pc = 0 Then dm = "Load a File!": Exit Function
    dm = formatos(1, pc) + "_" + formatos(0, pc) + IIf(formatos(2, pc) > "", "_" + formatos(2, pc), "")
Case "offset"   'calcula el offset
    contador8 = formato(6, pc)
    For contador9 = 0 To choix3 - 1
        Select Case choix2
        Case 0  'definitions ou predefinis
            If objetos(contador9, 1, pc) = 0 Then 'si no hay definiciones se usa el predefinido
                contador8 = contador8 + objetos(contador9, 0, pc) * objetos(contador9, 2, pc)
            Else
                contador8 = contador8 + objetos(contador9, 0, pc) * objetos(contador9, 1, pc)
            End If
        Case 1  'definitions seulement
                contador8 = contador8 + objetos(contador9, 0, pc) * objetos(contador9, 1, pc)
        Case 2  'predefinis seulement
                contador8 = contador8 + objetos(contador9, 0, pc) * objetos(contador9, 2, pc)
        End Select
    Next
    dm = contador8
End Select
End Function





Function Compressing()
archivo = inipath + "\" + dm("dm", 0) + "_Extracted\written.txt"
Bmp.Picture1.Width = Graphread.Picture2.Width
Bmp.Picture1.Height = Graphread.Picture2.Height
Graphread.Label8.Visible = True
Graphread.Label8.Caption = "Analysing..."
DoEvents
rehacercolores
'dimensiones
xx = Graphread.Picture2.ScaleWidth
yy = Graphread.Picture2.ScaleHeight
cadena = ""
ultimox = 0 ' ultima grabacion
xactual = 0 'posición cursor
ultimocolor = Graphread.Picture2.Point(0, 0)
Bmp.Picture1.Picture = LoadPicture()
Bmp.Picture1.BackColor = RGB(255, 0, 255)
registro = 0
totalbits = 0
Graphread.Label8.Visible = True
Graphread.Label8.Caption = "Compressing..."
DoEvents

If DebugVersion = 1 And Graphread.Filedebug.Checked Then
    fh5 = FreeFile(1)
    Open archivo For Output As fh5
End If
fh3 = FreeFile(1)
Open dirgraphic For Binary Shared As fh3
    Seek fh3, val2(Info.Text3.Text) + 5 + formato(5, pc)
    writeloop
    If (totalbits / 4) Mod 2 = 1 Then
        If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, "Filling hex: 0"
        cadena = cadena + "0"
        totalbits = totalbits + 4
    End If
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then
        Print #fh5, "Summary:"
        Print #fh5, "Bits: " & totalbits & " Bytes: " & totalbits / 8
        Print #fh5, "Entries: " & registro
        Print #fh5, "Colors: " & couleur
        For contador = 0 To 15
            Print #fh5, contador & " : " & IIf(colors(contador) = 1, 0, colors(contador)) & " " & nomcolors(contador)
        Next
        Close fh5
    End If
Close fh3
archivo2 = inipath + "\" + dm("dm", 0) + "_Extracted\write.txt"
fh2 = FreeFile(1)
Open archivo2 For Output As fh2
    For contador = 1 To Len(cadena) Step 2
        Print #fh2, Chr(val2("&H" + Mid$(cadena, contador, 2)));
        If contador Mod 100 = 0 Then Print #fh2,
    Next
Close fh2
Compressing = totalbits / 8 + 4 + formato(5, pc) 'totalbits/8+dimensions(4)+header(3)
Graphread.Label8.Visible = False
Info.Label11.Caption = Compressing
Compressing = val2(Info.Text4.Text) - Compressing
SavePicture Bmp.Picture1.Image, "tmpimage"
Bmp.Picture1.Picture = LoadPicture("tmpimage")
If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"

End Function

Sub writeloop()
For contador2 = 0 To yy - 1
    For contador = 0 To xx - 1
        colorprevio = coloractual
        coloractual = Graphread.Picture2.Point(contador, contador2)
        If coloractual = 0 Then coloractual = 1
        colordibujado = Bmp.Picture1.Point(contador, contador2)
        If colordibujado = 0 Then colordibujado = 1
        xactual = contador + xx * contador2
        distancia = xactual - ultimox
        flag = False
        pintar
        
        If ultimocolor < 0 And colorprevio <> coloractual And flag = False Then multi = True 'anoto si hubo varios colores salteados
        If ultimocolor > 0 And coloractual <> colordibujado And flag = False Then primersalteo = xactual + 1
        If flag Then
            definircolumna
            primersalteo = xactual
        End If
        If ultimocolor > 0 Then Bmp.Picture1.Line (contador, contador2)-(contador, yy), ultimocolor
    Next 'lignes suivantes
Next

End Sub
Sub definircolumna()
'grabo color y distancia
registro = registro + 1 'numero de instrucción
If formatos(1, pc) = "PC" Then
    writecolor
    writedistancia
Else
    writedistancianopc
End If
writefile
'memorizo la siguiente columna
ultimox = xactual
multi = False
If coloractual = colordibujado Then
    'Si hay que dejar el color anterior
    ultimocolor = -coloractual
Else
    'Si hay que poner un nuevo color
    ultimocolor = coloractual
End If
End Sub
Sub writefile()
If bits = 0 Then Exit Sub
totalbits = totalbits + bits
cadena = cadena + hexs
If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, hexs & "     ";
'Para comparar con el original
total = bits / 8
If byteplus > "" Then   'si queda un byte de antes del graphics.dat
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, byteplus;
    total = total - 0.5
End If
cadena2 = ""
For contador3 = 1 To Int(total)
    Get #fh3, , byte1
    letra = String(2 - Len(Hex(byte1)), "0") + Hex(byte1)
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, letra;
    cadena2 = cadena2 + letra
Next
byteplus = ""
If total * 2 Mod 2 = 1 Then
    Get #fh3, , byte1
    letra = Left(String(2 - Len(Hex(byte1)), "0") + Hex(byte1), 1)
    If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, letra;
    byteplus = Right(Hex(byte1), 1)
    cadena2 = cadena2 + letra
End If
If DebugVersion = 1 And Graphread.Filedebug.Checked Then Print #fh5, "        " & hexcolor & "-" & Hex(distancia) + IIf(cadena2 <> hexs, " ***", "")
End Sub
Sub pintar()

'Condiciones posibles de grabacion y cambio de color:
If contador2 = yy - 1 And contador = xx - 1 Then       'fin del dibujo
    flag = True
    distancia = distancia + 1
End If

If coloractual <> ultimocolor And coloractual <> colordibujado And flag = False Then   'cambio de color
    'dos pixeles= pero se empezo pintando en transparente: se pasa a color
    If distancia = 1 And coloractual = Abs(ultimocolor) Then
        ultimocolor = coloractual
        flag = False
    Else
    flag = True
    End If
End If

If coloractual <> ultimocolor And coloractual = colordibujado And ultimocolor > 0 Then
    flag = True    'nuevo color, ya dibujado: salteo
End If

If coloractual = -ultimocolor And coloractual <> colordibujado Then
    flag = True 'dejar de saltear y pintar
End If
End Sub
Sub activar(pkeycode As Integer, pshift As Integer, pme As Object)
Dim contador As Integer, cadena As String
contador = pkeycode - 111
cadena = UCase(pme.Name)
letra = Chr(pkeycode)
bucleextract = False
bucleflag = False
Select Case pkeycode
Case 17 'si es CTRL solo
Case 27
    If LCase(pme.Name) = "graphread" Then End
    pme.Visible = False
    'AppActivate Graphread.Caption
    Graphread.Show
    Wav.MMControl1.Command = "Close"
    pkeycode = 0
Case 33
    If Graphread.List2.ListIndex > 0 Then
        If graficomodificado Then Graphread.Savegraphics_Click
        flag2 = True
        Graphread.List2.ListIndex = Graphread.List2.ListIndex - 1
        Graphread.Command16_Click
        Graphread.Readgraphics_Click
        flag2 = False
        pkeycode = 0
    End If
Case 34
    If Graphread.List2.ListIndex < Graphread.List2.ListCount - 1 Then
        If graficomodificado Then Graphread.Savegraphics_Click
        flag2 = True
        Graphread.List2.ListIndex = Graphread.List2.ListIndex + 1
        Graphread.Command16_Click
        Graphread.Readgraphics_Click
        flag2 = False
        pkeycode = 0
End If
Case 38
    If LCase(pme.Name) = "mapas" And Mapas.Combo1.ListIndex > 0 Then Mapas.Combo1.ListIndex = Mapas.Combo1.ListIndex - 1:    pkeycode = 0
Case 40
    If LCase(pme.Name) = "mapas" And Mapas.Combo1.ListIndex < Mapas.Combo1.ListCount - 1 Then Mapas.Combo1.ListIndex = Mapas.Combo1.ListIndex + 1:    pkeycode = 0
Case 67  'CTRL+C
    If pshift = 2 Then
        If Len(Dir("tmpimage")) > 0 Then Kill "tmpimage"
        If Zoom.Image1.Picture = 0 Then
            If Bmp.Picture1.Picture = 0 Then
                If Graphread.Picture2.Picture = 0 Then
                    Storage1.Picture3.Picture = LoadPicture("")
                Else
                    SavePicture Graphread.Picture2.Picture, "tmpimage"
                End If
            Else
                SavePicture Bmp.Picture1.Picture, "tmpimage"
            End If
        Else
            SavePicture Zoom.Image1.Picture, "tmpimage"
        End If
        Storage1.Show 0, pme
        If Len(Dir("tmpimage")) > 0 Then Storage1.Picture3.Picture = LoadPicture("tmpimage"):    Kill "tmpimage"
        Storage1.Label15.Caption = Storage1.Picture3.Width & " x " & Storage1.Picture3.Height
        pkeycode = 0
    End If
Case 85 'CTRL+U
    If pshift = 2 Then undo True:    pkeycode = 0
Case 112 To 117 'Tecla de funcion
    If Right(cadena, 1) = Trim(Str(contador - 1)) Then
            pme.Visible = False
            AppActivate Graphread.Caption
            pkeycode = 0
            Exit Sub
    End If
    AppActivate Graphread.Caption
    SendKeys "{F" + Trim(Str(contador)) + "}", True
Case Else
    If pshift = 2 Then  'si se apretaba CTRL
        If Left(cadena, 1) = letra Then
            pme.Visible = False
            AppActivate Graphread.Caption
            pkeycode = 0
            Exit Sub
        End If
        Select Case letra
        Case "B", "H", "I", "P", "T", "W", "Z"
            If LCase(pme.Name) <> "graphread" Then
                AppActivate Graphread.Caption
                SendKeys Chr(pkeycode - 64), True
            End If
            pkeycode = 0
        Case Else
            pkeycode = 0
        End Select
    End If
End Select
End Sub

Sub readmapa()
Dim contador
Mapas.Combo1.Clear
For contador = 0 To UBound(columnas, 2) - 1
    Mapas.Combo1.AddItem ("Level " & contador & _
    " (" & columnas(0, contador) & "x " & columnas(1, contador) & " )")
Next
If Mapas.Combo1.ListCount > 0 Then Mapas.Combo1.ListIndex = 0
Mapas.Caption = "Maps - " + Trim(Graphread.List2.Text)
Mapas.Show 0, Graphread
End Sub

Sub initformatos()
Dim contador, contador2
Erase formatos
ReDim formatos(6, maxformatos)
contador2 = pc

formatos(0, 0) = "Unknown format"
formatos(1, 0) = "Unknown platform"
formatos(2, 0) = ""
formatos(3, 0) = ""
formatos(4, 0) = ""
formatos(5, 0) = "0"
formatos(6, 0) = "0"

formatos(0, 1) = "DM Graphics"
formatos(1, 1) = "PC"
formatos(2, 1) = "English"
formatos(3, 1) = "#0=0180"
formatos(4, 1) = "#2=C902"
formatos(5, 1) = "3"
formatos(6, 1) = "4"

formatos(0, 2) = "DM2 Graphics"
formatos(1, 2) = "PC"
formatos(2, 2) = "Small"
formatos(3, 2) = "#0=0580"
formatos(4, 2) = "#2=530B"
formatos(5, 2) = "3"
formatos(6, 2) = "8"

formatos(0, 3) = "DM2 Graphics"
formatos(1, 3) = "PC"
formatos(2, 3) = "Big"
formatos(3, 3) = "#0=0580"
formatos(4, 3) = "#2=F815"
formatos(5, 3) = "3"
formatos(6, 3) = "8"

formatos(0, 4) = "CSB Graphics"
formatos(1, 4) = "AMIGA"
formatos(2, 4) = ""
formatos(3, 4) = "#0=8001"
formatos(4, 4) = "#2=02D8"
formatos(5, 4) = "0"
formatos(6, 4) = "4"

formatos(0, 5) = "CSB and DM Graphics"
formatos(1, 5) = "ST"
formatos(2, 5) = ""
formatos(3, 5) = "#0=0233"
formatos(4, 5) = ""
formatos(5, 5) = "0"
formatos(6, 5) = "2"

formatos(0, 6) = "DM Graphics"
formatos(1, 6) = "PC"
formatos(2, 6) = "Multilingual"
formatos(3, 6) = "#0=0180"
formatos(4, 6) = "#2=EC02"
formatos(5, 6) = "3"
formatos(6, 6) = "4"

formatos(0, 7) = "HINTS"
formatos(1, 7) = "AMIGA"
formatos(2, 7) = ""
formatos(3, 7) = "#0=4C53"
formatos(4, 7) = "#6=7849"
formatos(5, 7) = "0"
formatos(6, 7) = "0A"

formatos(0, 8) = "HINTS"
formatos(1, 8) = "ST"
formatos(2, 8) = ""
formatos(3, 8) = "#0=0004"
formatos(4, 8) = "#2=0064"
formatos(5, 8) = "0"
formatos(6, 8) = "2"

formatos(0, 9) = "DM Song"
formatos(1, 9) = "PC"
formatos(2, 9) = ""
formatos(3, 9) = "#0=0180"
formatos(3, 9) = "#2=0A00"
formatos(5, 9) = "0"
formatos(6, 9) = "4"

formatos(0, 10) = "HINTS"
formatos(1, 10) = "ST"
formatos(2, 10) = "Texts"
formatos(3, 10) = "#0=0002"
formatos(4, 10) = "#2=000D"
formatos(5, 10) = "0"
formatos(6, 10) = "8"

formatos(0, 11) = "DM Dungeon"
formatos(1, 11) = "PC"
formatos(2, 11) = ""
formatos(3, 11) = "#0=6300"
formatos(4, 11) = ""
formatos(5, 11) = "0"
formatos(6, 11) = "2C"

formatos(0, 12) = "DM Dungeon"
formatos(1, 12) = "PC"
formatos(2, 12) = "Save"
formatos(3, 12) = "#2C00=6300"
formatos(4, 12) = ""
formatos(5, 12) = "0"
formatos(6, 12) = "2C2C"

formatos(0, 13) = "CSB Dungeon"
formatos(1, 13) = "ST"
formatos(2, 13) = ""
formatos(3, 13) = "#27B0=0063"
formatos(4, 13) = ""
formatos(5, 13) = "0"
formatos(6, 13) = "27DC"

formatos(0, 14) = "DM Dungeon"
formatos(1, 14) = "ST"
formatos(2, 14) = ""
formatos(3, 14) = "#0=0063"
formatos(4, 14) = ""
formatos(5, 14) = "0"
formatos(6, 14) = "2C"

formatos(0, 15) = "DM Dungeon"
formatos(1, 15) = "ST"
formatos(2, 15) = "Save"
formatos(3, 15) = "#28F4=0063"
formatos(4, 15) = ""
formatos(5, 15) = "0"
formatos(6, 15) = "2920"

formatos(0, 16) = "DM2 Dungeon"
formatos(1, 16) = "PC"
formatos(2, 16) = "Small"
formatos(3, 16) = "#0=0000"
formatos(4, 16) = "#2=FB02"
formatos(5, 16) = "0"
formatos(6, 16) = "2C"

formatos(0, 17) = "DM2 Dungeon"
formatos(1, 17) = "PC"
formatos(2, 17) = "Small_Save"
formatos(3, 17) = "#2A=0000"
formatos(4, 17) = "#2C=FB02"
formatos(5, 17) = "0"
formatos(6, 17) = "56"

formatos(0, 18) = "DM2 Dungeon"
formatos(1, 18) = "PC"
formatos(2, 18) = "Big"
formatos(3, 18) = "#0=0000"
formatos(4, 18) = "#2=4731"
formatos(5, 18) = "0"
formatos(6, 18) = "2C"

formatos(0, 19) = "DM2 Dungeon"
formatos(1, 19) = "PC"
formatos(2, 19) = "Big_Save"
formatos(3, 19) = "#2A=0000"
formatos(4, 19) = "#2C=4731"
formatos(5, 19) = "0"
formatos(6, 19) = "56"

formatos(0, 20) = "DM Fires"
formatos(1, 20) = "PC"
formatos(2, 20) = ""
formatos(3, 20) = "#0=4D5A"
formatos(4, 20) = "#2=3b00"
formatos(5, 20) = "0"
formatos(6, 20) = "0"

pc = contador2
End Sub
Sub initcategorias()
Dim contador, contador2
Erase maxobjetos
ReDim maxobjetos(25, 6, maxformatos)
'0: cantidad
'1: bytes of definition
'2: fixed length
'3: lenght1
'4: lenght2
'5: dimensions

contador2 = pc

'Categorias:
'Unknown
maxobjetos(0, 0, 0) = "1"
maxobjetos(0, 1, 0) = "0"
maxobjetos(0, 2, 0) = "LOF"
maxobjetos(0, 3, 0) = "0"
maxobjetos(0, 4, 0) = "0"
maxobjetos(0, 5, 0) = "0"

'PC DM Graphics
maxobjetos(0, 0, 1) = "#2"
maxobjetos(0, 1, 1) = "8"
maxobjetos(0, 2, 1) = "0"
maxobjetos(0, 3, 1) = "2"
maxobjetos(0, 4, 1) = "2"
maxobjetos(0, 5, 1) = "4"

'PC DM Graphics Multilingual
maxobjetos(0, 0, 6) = " #2"
maxobjetos(0, 1, 6) = " 8"
maxobjetos(0, 2, 6) = " 0"
maxobjetos(0, 3, 6) = " 2"
maxobjetos(0, 4, 6) = " 2"
maxobjetos(0, 5, 6) = " 4"

'DM2
For contador = 2 To 3
    maxobjetos(0, 0, contador) = " 1"
    maxobjetos(0, 1, contador) = " 0"
    maxobjetos(0, 2, contador) = "#4+10000*#6-2"
    maxobjetos(0, 3, contador) = " 0"
    maxobjetos(0, 4, contador) = " 0"
    maxobjetos(0, 5, contador) = " 0"
    maxobjetos(0, 6, contador) = "UNKNOWNDATA"
    
    maxobjetos(1, 0, contador) = " #2"
    maxobjetos(1, 1, contador) = " 2"
    maxobjetos(1, 2, contador) = " 0"
    maxobjetos(1, 3, contador) = " 2"
    maxobjetos(1, 4, contador) = " 0"
    maxobjetos(1, 5, contador) = " 0"
Next

'AMIGA CSB
maxobjetos(0, 0, 4) = " #2"
maxobjetos(0, 1, 4) = " 8"
maxobjetos(0, 2, 4) = " 0"
maxobjetos(0, 3, 4) = " 2"
maxobjetos(0, 4, 4) = " 2"
maxobjetos(0, 5, 4) = " 4"

'ST CSB or DM
maxobjetos(0, 0, 5) = " #0"
maxobjetos(0, 1, 5) = " 4"
maxobjetos(0, 2, 5) = " 0"
maxobjetos(0, 3, 5) = " 2"
maxobjetos(0, 4, 5) = " 0"
maxobjetos(0, 5, 5) = " 2"

'Amiga Hint
maxobjetos(0, 0, 7) = " 1"
maxobjetos(0, 1, 7) = " 0"
maxobjetos(0, 2, 7) = " 3F"
maxobjetos(0, 3, 7) = " 0"
maxobjetos(0, 4, 7) = " 0"
maxobjetos(0, 5, 7) = " 0"
maxobjetos(0, 6, 7) = "UNKNOWNDATA_"

maxobjetos(1, 0, 7) = " 1"
maxobjetos(1, 1, 7) = " 2"
maxobjetos(1, 2, 7) = " 0"
maxobjetos(1, 3, 7) = " 2"
maxobjetos(1, 4, 7) = " 0"
maxobjetos(1, 5, 7) = " 0"

'ST Hint
maxobjetos(0, 0, 8) = " #0"
maxobjetos(0, 1, 8) = " 4"
maxobjetos(0, 2, 8) = " 0"
maxobjetos(0, 3, 8) = " 2"
maxobjetos(0, 4, 8) = " 2"
maxobjetos(0, 5, 8) = " 0"

'DM Song
maxobjetos(0, 0, 9) = " #2"
maxobjetos(0, 1, 9) = " 2"
maxobjetos(0, 2, 9) = " 0"
maxobjetos(0, 3, 9) = " 2"
maxobjetos(0, 4, 9) = " 0"
maxobjetos(0, 5, 9) = " 0"
maxobjetos(0, 6, 9) = "Sound_"

'Hint texts
maxobjetos(0, 0, 10) = " #6"
maxobjetos(0, 1, 10) = " 0"
maxobjetos(0, 2, 10) = " #8"
maxobjetos(0, 3, 10) = " 0"
maxobjetos(0, 4, 10) = " 0"
maxobjetos(0, 5, 10) = " 0"

maxobjetos(1, 0, 10) = " #(A+#6*#8)"
maxobjetos(1, 1, 10) = " 0"
maxobjetos(1, 2, 10) = " #(C+#6*#8)"
maxobjetos(1, 3, 10) = " 0"
maxobjetos(1, 4, 10) = " 0"
maxobjetos(1, 5, 10) = " 0"
maxobjetos(1, 6, 10) = "Text_"

maxobjetos(2, 0, 10) = "#(E+#6*#8+#(A+#6*#8)*#(C+#6*#8))"
maxobjetos(2, 1, 10) = " 0"
maxobjetos(2, 2, 10) = "#(10+#6*#8+#(A+#6*#8)*#(C+#6*#8))"
maxobjetos(2, 3, 10) = " 0"
maxobjetos(2, 4, 10) = " 0"
maxobjetos(2, 5, 10) = " 0"

'Saves
'0: cantidad
'1: bytes of definition
'2: fixed length
'3: lenght1
'4: lenght2
'5: dimensions
For pc = 11 To 19
    contador = -1
    offset = formato(6, pc) - &H2C
    If LCase(formato(2, pc)) = "save" Then
        formatos(6, pc) = "0"
        contador = contador + 1
        maxobjetos(contador, 0, pc) = "1"
        maxobjetos(contador, 1, pc) = " 0"
        maxobjetos(contador, 2, pc) = Hex(offset - 4 * 32 * 29 / 2)
        maxobjetos(contador, 3, pc) = " 0"
        maxobjetos(contador, 4, pc) = " 0"
        maxobjetos(contador, 5, pc) = " 0"
        maxobjetos(contador, 6, pc) = "DataPrevious_"
    
        contador = contador + 1
        maxobjetos(contador, 0, pc) = "4"
        maxobjetos(contador, 1, pc) = " 0"
        maxobjetos(contador, 2, pc) = Hex(32 * 29 / 2)
        maxobjetos(contador, 3, pc) = " 0"
        maxobjetos(contador, 4, pc) = " 0"
        maxobjetos(contador, 5, pc) = " 0"
        maxobjetos(contador, 6, pc) = "RawPortraits_"
        
        contador = contador + 1
        maxobjetos(contador, 0, pc) = "1"
        maxobjetos(contador, 1, pc) = " 0"
        maxobjetos(contador, 2, pc) = "2C"
        maxobjetos(contador, 3, pc) = " 0"
        maxobjetos(contador, 4, pc) = " 0"
        maxobjetos(contador, 5, pc) = " 0"
        maxobjetos(contador, 6, pc) = "DataDefinitions_"
    End If
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(4 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 10"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "DataLevel_"
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = " 1   "
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " cumulate * 2 - 2"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Cumulate_"
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = " 1   "
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = "2*#" + Hex(10 + offset)
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_IDs_"
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = " 1   "
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = "2*#" + Hex(6 + offset)
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Encrypted_Text_"
    

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(12 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Door_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(14 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 6"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Teleporter_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(16 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Wall_text_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(18 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 8"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Pad_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(20 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 10"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Monster_"
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(22 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Weapon_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(24 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Clothes_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(26 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Scroll_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(28 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Potion_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(30 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 8"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Chest_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(32 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Misc_Item_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(34 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(36 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(38 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(40 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 8"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Missile_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = "#" + Hex(42 + offset)
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 4"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Data_Cloud_"

    contador = contador + 1
    maxobjetos(contador, 0, pc) = " 1"
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = "#" + Hex(2 + offset)
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "Map_Data_"

   If LCase(formatos(0, pc)) = "dm2 dungeon" Then 'DM2
        contador = contador + 1
        maxobjetos(contador, 0, pc) = "1"
        maxobjetos(contador, 1, pc) = " 0"
        maxobjetos(contador, 2, pc) = "1B25"
        maxobjetos(contador, 3, pc) = " 0"
        maxobjetos(contador, 4, pc) = " 0"
        maxobjetos(contador, 5, pc) = " 0"
        maxobjetos(contador, 6, pc) = "DataNext_"
    End If
    
    contador = contador + 1
    maxobjetos(contador, 0, pc) = " 1"
    maxobjetos(contador, 1, pc) = " 0"
    maxobjetos(contador, 2, pc) = " 2"
    maxobjetos(contador, 3, pc) = " 0"
    maxobjetos(contador, 4, pc) = " 0"
    maxobjetos(contador, 5, pc) = " 0"
    maxobjetos(contador, 6, pc) = "DataChecksum_"
Next

    'DM Fires
    contador = 0
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "14D7C"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "Unknown_"
    
    'monster 1
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1E"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 2 & 3
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "2"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1C"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 4
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1B"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 5
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1C"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 6
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "19"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 7
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1B"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 8
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1A"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 9
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1B"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 10
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1A"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"

    'monster 11
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1B"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 12
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1A"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 13
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "18"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    'monster 14
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "10"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "1A"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "DataMonsters_"
    
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "8C"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "Unknown_"
    
    contador = contador + 1
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "322"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "Texts_"
    
    For contador = contador To contador + 6
        maxobjetos(contador + 2, 0, 20) = "28"
        maxobjetos(contador + 2, 1, 20) = "0"
        maxobjetos(contador + 2, 2, 20) = "1"
        maxobjetos(contador + 2, 3, 20) = "0"
        maxobjetos(contador + 2, 4, 20) = "0"
        maxobjetos(contador + 2, 5, 20) = "0"
        maxobjetos(contador + 2, 6, 20) = "DataAttacks" & contador
    Next
    
    maxobjetos(contador, 0, 20) = "1"
    maxobjetos(contador, 1, 20) = "0"
    maxobjetos(contador, 2, 20) = "5D0"
    maxobjetos(contador, 3, 20) = "0"
    maxobjetos(contador, 4, 20) = "0"
    maxobjetos(contador, 5, 20) = "0"
    maxobjetos(contador, 6, 20) = "Texts_"

pc = contador2
End Sub

Sub bloodpaint(Hexa)
Dim x, Y, color, contador2, contador, bloodcolors(2)
contador = Hexa
For contador2 = 7 To 0 Step -1   'dibujo
    contador = contador Mod 2 ^ (contador2 + 1)
    If Int(contador / 2 ^ contador2) = 1 Then
        x = (distancia + 7 - contador2) Mod Graphread.Picture2.Width
        Y = Int((distancia + 7 - contador2) / Graphread.Picture2.Width)
        color = Graphread.Picture2.Point(x, Y)
        bloodcolors(0) = color Mod 256
        bloodcolors(1) = ((color - bloodcolors(0)) / 256) Mod 256
        bloodcolors(2) = (((color - bloodcolors(0)) / 256) - bloodcolors(1)) / 256
        
        Select Case contador9
        Case 0 'noir
            color = RGB(32 + bloodcolors(0), 32 + bloodcolors(1), 32 + bloodcolors(2))
            Storage1.Picture3.PSet (x, Y), RGB(255, 255, 255)
        Case 1  'gray
            color = RGB(96 + bloodcolors(0), 96 + bloodcolors(1), 96 + bloodcolors(2))
            Storage2.Picture3.PSet (x, Y), RGB(255, 255, 255)
        Case 2  'red
            color = RGB(96 + bloodcolors(0), 0 + bloodcolors(1), 0 + bloodcolors(2))
            Storage3.Picture3.PSet (x, Y), RGB(255, 255, 255)
        Case 3 'green
            color = RGB(0 + bloodcolors(0), 96 + bloodcolors(1), 0 + bloodcolors(2))
            Storage4.Picture3.PSet (x, Y), RGB(255, 255, 255)
        Case 4  'blue
            color = RGB(0 + bloodcolors(0), 0 + bloodcolors(1), 96 + bloodcolors(2))
            Storage5.Picture3.PSet (x, Y), RGB(255, 255, 255)
        Case Else   'se pasó
           ' Stop
        End Select
        Graphread.Picture2.PSet (x, Y), color
    End If
Next
distancia = distancia + 8
If distancia >= Graphread.Picture2.Width * Graphread.Picture2.Height Then incrementar
End Sub
Sub bloodread(Hexa2)
Dim contador, contador2, contador3
contador = Hexa2
Print #fh4, Hex(contador);
For contador2 = 1 To UBound(codigos, 2) 'Código especial ?
    If codigos(0, contador2) = contador Then Exit For
Next
If contador2 > UBound(codigos, 2) Then  'code simple
    bloodpaint contador
Else    'code spécial
    Print #fh4, "=(";
    For contador3 = 1 To 2
        If codigos(contador3, contador2) = codigos(0, contador2) Then   'se refiere a si mismo?
            MsgBox ("Self reference!")
            Stop
            bloodpaint 0
        Else    'se refiere a otro
            bloodread codigos(contador3, contador2)
        End If
        If contador3 = 1 Then Print #fh4, "+";
    Next
    Print #fh4, ")";
End If

End Sub
Function getdictionnary(offset3)
Dim numero, contador, contador2
numero = getbyte(fh2, 2, offset3)
If numero = 0 Then Exit Function
ReDim codigos(2, 1 To numero) As Byte
For contador2 = 0 To 2
    For contador = 1 To numero
        codigos(contador2, contador) = getbyte(fh2, 1)
    Next
Next
offset3 = offset3 + UBound(codigos, 2) * 3 + 2
getdictionnary = getbyte(fh2, 2, offset3)   'hex à lire
offset3 = getdictionnary + offset3 + 3
End Function
Sub incrementar()
Dim contador
distancia = distancia - Graphread.Picture2.Width * Graphread.Picture2.Height
contador = Timer + 0
Graphread.Label8.Visible = True
Do While contador - Timer > 0
    Graphread.Label8.Caption = "Waiting..." & Int(1 + contador - Timer)
    DoEvents
Loop
Graphread.Label8.Visible = False
contador9 = contador9 + 1
End Sub
