VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmRecursos 
   Caption         =   "Recursos"
   ClientHeight    =   4905
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4575
   Icon            =   "Recursos.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4905
   ScaleWidth      =   4575
   Begin VB.CommandButton cmdBlorb 
      Caption         =   "&Blorb"
      Height          =   375
      Left            =   2160
      TabIndex        =   4
      Top             =   4440
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.CommandButton cmdCompilar 
      Caption         =   "&Compilar"
      Height          =   375
      Left            =   1080
      TabIndex        =   3
      Top             =   4440
      Width           =   975
   End
   Begin VB.CommandButton cmdAceptar 
      Caption         =   "&Aceptar"
      Height          =   375
      Left            =   3240
      TabIndex        =   5
      Top             =   4440
      Width           =   1215
   End
   Begin VB.CommandButton cmdBorrar 
      Height          =   375
      Left            =   600
      Picture         =   "Recursos.frx":014A
      Style           =   1  'Graphical
      TabIndex        =   2
      ToolTipText     =   "Borrar recurso"
      Top             =   4440
      Width           =   375
   End
   Begin VB.CommandButton cmdNuevo 
      Height          =   375
      Left            =   120
      Picture         =   "Recursos.frx":0294
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "Nuevo recurso"
      Top             =   4440
      Width           =   375
   End
   Begin MSComctlLib.ListView lstRes 
      Height          =   4335
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4575
      _ExtentX        =   8070
      _ExtentY        =   7646
      SortKey         =   1
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   3
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "ID"
         Object.Width           =   1235
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Tipo"
         Object.Width           =   1235
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "Recurso"
         Object.Width           =   5292
      EndProperty
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   300
      Left            =   0
      TabIndex        =   6
      Top             =   4560
      Visible         =   0   'False
      Width           =   4575
      _ExtentX        =   8070
      _ExtentY        =   529
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Label lblCompilar 
      Caption         =   "Compilando recursos..."
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   4320
      Visible         =   0   'False
      Width           =   3735
   End
End
Attribute VB_Name = "frmRecursos"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const DELIMCMP_RES = """"
Const SEPCMP_RES = ","

Public bCompilado As Boolean    ' indica si se compilaron correctamente los recursos

Private Sub cmdAceptar_Click()

    Unload Me

End Sub

Private Sub cmdBlorb_Click()
    Dim R() As RecursoBlorb
    Dim sFichRes As String, sTipo As String, sFich As String, sRuta As String
    Dim i As Long, lNumRes As Long, lID As Long, lTipoRes As Long
    
    lNumRes = lstRes.ListItems.Count
    If lNumRes < 1 Then
        Exit Sub
    End If
    
    ' ruta de los ficheros de la aventura
    sRuta = RutaFich(sFichAventura)
    
    ReDim R(lNumRes - 1)
    For i = 1 To lNumRes
        ProgressBar1.value = i
        
        lID = CLng(lstRes.ListItems(i).Text)
        sTipo = lstRes.ListItems(i).SubItems(1)
        sFich = lstRes.ListItems(i).SubItems(2)
    
        ' convertimos el tipo
        Select Case sTipo
            Case RES_IMG
                lTipoRes = VS_IMAGEN
            Case RES_SND
                lTipoRes = VS_SONIDO
            Case RES_FNT
                lTipoRes = VS_FUENTE
        End Select
    
        ' si el nombre del fichero empieza por (.) o (\) suponemos que es
        ' relativo al directorio de los ficheros de la aventura
        If Left(sFich, 1) = "." Then
            sFich = sRuta & "\" & sFich
        ElseIf Left(sFich, 1) = "\" Then
            sFich = sRuta & sFich
        End If
    
        R(i - 1).id = lID
        R(i - 1).Tipo = lTipoRes
        R(i - 1).Fich = sFich
    Next
    
    sFichRes = sFichAventura & EXT_DLL
    ' borramos el fichero de recursos
    On Error Resume Next
    Kill sFichRes

    If Not CompilaRecursosBlorb(sFichRes, R) Then
        MsgBox "Error al compilar los recursos en formato BLORB", vbOKOnly + vbExclamation, "Compilar BLORB"
    End If

End Sub

Private Sub cmdBorrar_Click()
    Dim iOpc As Integer
    
    iOpc = MsgBox("¿Quieres borrar el recurso seleccionado?", vbYesNo + vbQuestion, "Borrar recurso")
    If iOpc <> vbYes Then
        Exit Sub
    End If

    If Not lstRes.SelectedItem Is Nothing Then
        lstRes.ListItems.Remove lstRes.SelectedItem.index
    End If

End Sub

Public Sub cmdCompilar_Click()
    Dim i As Long, lNumRes As Long, lID As Long, lTipoRes As Long
    Dim sTipo As String, sFich As String, sFichRes As String, sRuta As String
    
    lNumRes = lstRes.ListItems.Count
    If lNumRes < 1 Then
        bCompilado = True
        Exit Sub
    End If
 
    sFichRes = sFichAventura & EXT_DLL
    ' borramos el fichero de recursos
    On Error Resume Next
    Kill sFichRes
       
    cmdNuevo.Visible = False
    cmdBorrar.Visible = False
    cmdCompilar.Visible = False
    cmdAceptar.Visible = False
    ProgressBar1.Min = 1
    ProgressBar1.Max = lNumRes
    ProgressBar1.value = 1
    lblCompilar.Visible = True
    ProgressBar1.Visible = True
    Me.Refresh

    On Error GoTo Error_Compilar
    Screen.MousePointer = vbHourglass
    
    ' ruta de los ficheros de aventura
    sRuta = RutaFich(sFichAventura)
    
    For i = 1 To lNumRes
        ProgressBar1.value = i
        
        lID = CLng(lstRes.ListItems(i).Text)
        sTipo = lstRes.ListItems(i).SubItems(1)
        sFich = lstRes.ListItems(i).SubItems(2)
        
        ' si el nombre del fichero empieza por (.) o (\) suponemos que es
        ' relativo al directorio de los ficheros de la aventura
        If Left(sFich, 1) = "." Then
            sFich = sRuta & "\" & sFich
        ElseIf Left(sFich, 1) = "\" Then
            sFich = sRuta & sFich
        End If
        
        ' convertimos el tipo
        Select Case sTipo
            Case RES_IMG
                lTipoRes = VS_IMAGEN
            Case RES_SND
                lTipoRes = VS_SONIDO
            Case RES_FNT
                lTipoRes = VS_FUENTE
        End Select
        
        If Not NuevoRecurso(sFichRes, lID, lTipoRes, sFich) Then
            MsgBox "Imposible compilar el recurso " & CStr(lID) & " " & sTipo & _
              ": " & sFich & vbCrLf & "Comprueba que exista el fichero.", _
              vbOKOnly + vbExclamation, "Compilar recursos"
        End If
    Next

Error_Compilar:
    Screen.MousePointer = vbDefault
    If Err.Number = 0 Then
        '''MsgBox "Recursos compilados correctamente", vbOKOnly + vbInformation, "Compilar recursos"
        bCompilado = True
    Else
        MsgBox "Error al compilar recursos: " & Err.Description, vbOKOnly + vbCritical, _
          "Compilar recursos"
        bCompilado = False
    End If

    lblCompilar.Visible = False
    ProgressBar1.Visible = False
    cmdNuevo.Visible = True
    cmdBorrar.Visible = True
    cmdCompilar.Visible = True
    cmdAceptar.Visible = True
End Sub

Private Sub cmdNuevo_Click()
    Dim Lst As ListItem
    Dim bRepetido As Boolean
    Dim sID As String, sRes As String, sTipo As String
    Dim i As Long

    Load frmNuevoRecurso
    frmNuevoRecurso.bModificar = False
    frmNuevoRecurso.Show vbModal
    
    If Not frmNuevoRecurso.bCancelar Then
        sID = frmNuevoRecurso.txtID.Text
        sRes = frmNuevoRecurso.txtFich.Text
        sTipo = frmNuevoRecurso.lstTipo.Text
        
        ' comprobamos si el ID está repetido
        bRepetido = False
        For i = 1 To lstRes.ListItems.Count
            If lstRes.ListItems(i).Text = sID And lstRes.ListItems(i).SubItems(1) = sTipo Then
                bRepetido = True
                Exit For
            End If
        Next
        
        If bRepetido Then
            MsgBox "El recurso está repetido", vbOKOnly + vbExclamation, "Error"
        Else
            Set Lst = lstRes.ListItems.Add(, , sID)
            Lst.SubItems(1) = sTipo
            Lst.SubItems(2) = sRes
            Lst.EnsureVisible
        End If
    End If
    
    Unload frmNuevoRecurso

End Sub

Private Sub Form_Load()

    Me.Width = 4695
    Me.Height = 5310
    CargarRecursos

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If Not GuardarRecursos Then
        Cancel = 1
    End If

End Sub

Private Sub Form_Resize()

    On Error Resume Next
    lstRes.Width = Me.ScaleWidth
    lstRes.Height = Me.ScaleHeight - 570
    lstRes.ColumnHeaders(3).Width = lstRes.Width - lstRes.ColumnHeaders(1).Width - _
      lstRes.ColumnHeaders(2).Width - 100
    cmdNuevo.Top = lstRes.Height + 105
    cmdBorrar.Top = cmdNuevo.Top
    cmdCompilar.Top = cmdNuevo.Top
    cmdAceptar.Top = cmdNuevo.Top
    lblCompilar.Top = lstRes.Height
    ProgressBar1.Top = lblCompilar.Top + lblCompilar.Height
    ProgressBar1.Width = Me.ScaleWidth

End Sub

' cargamos el fichero de recursos
Private Sub CargarRecursos()
    Dim Lst As ListItem
    Dim s As String, sFich As String, sID As String, sRes As String, sTipo As String
    Dim i As Long
    Dim iFich As Integer
    
    On Error GoTo Error_Cargar2
    
    sFich = sFichAventura & EXT_RES
    iFich = FreeFile
    Open sFich For Input As #iFich
    On Error GoTo Error_Cargar1

    lstRes.ListItems.Clear
    Do While Not EOF(iFich)
        Line Input #iFich, s
        sID = SeparaCampo(s, 1, DELIMCMP_RES, SEPCMP_RES)
        sRes = SeparaCampo(s, 2, DELIMCMP_RES, SEPCMP_RES)
        sTipo = SeparaCampo(s, 3, DELIMCMP_RES, SEPCMP_RES)
        
        Set Lst = lstRes.ListItems.Add(, , sID)
        Lst.SubItems(1) = sTipo
        Lst.SubItems(2) = sRes
    Loop

    Close #iFich
    Exit Sub

Error_Cargar1:
    Close #iFich
Error_Cargar2:
End Sub

' guarda los recursos
Public Function GuardarRecursos() As Boolean
    Dim sFich As String, sID As String, sRes As String, sTipo As String
    Dim i As Long
    Dim iFich As Integer
    
    On Error GoTo Error_Guardar2
    
    sFich = sFichAventura & EXT_RES
    iFich = FreeFile
    Open sFich For Output As #iFich
    On Error GoTo Error_Guardar1
    
    For i = 1 To lstRes.ListItems.Count
        sID = DELIMCMP_RES & lstRes.ListItems(i).Text & DELIMCMP_RES & SEPCMP_RES
        sTipo = DELIMCMP_RES & lstRes.ListItems(i).SubItems(1) & DELIMCMP_RES & SEPCMP_RES
        sRes = DELIMCMP_RES & lstRes.ListItems(i).SubItems(2) & DELIMCMP_RES & SEPCMP_RES
        Print #iFich, sID & sRes & sTipo
    Next

    Close #iFich
    GuardarRecursos = True
    Exit Function
    
Error_Guardar1:
    Close #iFich
Error_Guardar2:
    MsgBox "Error al guardar fichero de recursos: " & Err.Description, _
      vbOKOnly + vbCritical, "Guardar recursos"
    GuardarRecursos = False
End Function


Private Sub lstRes_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

    lstRes.SortOrder = lvwAscending
    lstRes.SortKey = ColumnHeader.index - 1
    lstRes.Sorted = True

End Sub

Private Sub lstRes_DblClick()
    Dim bRepetido As Boolean
    Dim sID As String, sRes As String, sTipo As String
    Dim i As Long

    If lstRes.SelectedItem Is Nothing Then
        Exit Sub
    End If
    
    Load frmNuevoRecurso
    frmNuevoRecurso.bModificar = True
    frmNuevoRecurso.txtID.Text = lstRes.SelectedItem.Text
    frmNuevoRecurso.lstTipo.Text = lstRes.SelectedItem.SubItems(1)
    frmNuevoRecurso.txtFich.Text = lstRes.SelectedItem.SubItems(2)
    
    frmNuevoRecurso.Show vbModal
    
    If Not frmNuevoRecurso.bCancelar Then
        sID = frmNuevoRecurso.txtID.Text
        sRes = frmNuevoRecurso.txtFich.Text
        sTipo = frmNuevoRecurso.lstTipo.Text
        
        ' comprobamos si el ID está repetido
        bRepetido = False
        For i = 1 To lstRes.ListItems.Count
            If lstRes.SelectedItem.index <> i And lstRes.ListItems(i).Text = sID And _
              lstRes.ListItems(i).SubItems(1) = sTipo Then
                bRepetido = True
                Exit For
            End If
        Next
        
        If bRepetido Then
            MsgBox "El recurso está repetido", vbOKOnly + vbExclamation, "Error"
        Else
            lstRes.SelectedItem.Text = sID
            lstRes.SelectedItem.SubItems(1) = sTipo
            lstRes.SelectedItem.SubItems(2) = sRes
        End If
    End If
    
    Unload frmNuevoRecurso

End Sub