Differenze tra le versioni di "Conoscere la durata di un file Midi con le sole risorse di Gambas"

Da Gambas-it.org - Wikipedia.
Riga 1: Riga 1:
 
Per conoscere la durata di un <SPAN Style="text-decoration:underline">file</span> Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente, nel quale si otterranno anche le durate delle singole tracce ''MTrk'' presenti nel file ed alcune generiche informazioni:  
 
Per conoscere la durata di un <SPAN Style="text-decoration:underline">file</span> Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente, nel quale si otterranno anche le durate delle singole tracce ''MTrk'' presenti nel file ed alcune generiche informazioni:  
  
Private fl As File
 
Private file_offset As Integer
 
Private bpm$ As String = "07A120"
 
 
 
 
  '''Public''' Sub Main()
 
  '''Public''' Sub Main()
 
    
 
    
 +
  Dim fl As File
 
   Dim fileMidi, s As String
 
   Dim fileMidi, s As String
   Dim durata_Midi As Float
+
   Dim hbpm, tot, mx, tratto1 As Integer
 +
  Dim td, bpm, c As Short
 +
  Dim tr, b, n, av As Byte
 +
  Dim cmd, tipocmd, ultimo As Byte
 +
  Dim f, durata As Float
 
    
 
    
   fileMidi = "<FONT Color=gray>''/percorso/del/file.mid''</font>"
+
   fileMidi = "<FONT Color=gray>' ''/percorso/del/file.mid''</font>"
   Print "Percorso del File Midi: "; fileMidi
+
   Print "File Midi:         "; fileMidi
 
    
 
    
 
   fl = Open fileMidi For Read
 
   fl = Open fileMidi For Read
 
   If IsNull(fl) Then Error.Raise("Impossibile aprire il file !")
 
   If IsNull(fl) Then Error.Raise("Impossibile aprire il file !")
   
+
 
 
   Read #fl, s, 4
 
   Read #fl, s, 4
 
   If s <> "MThd" Then Error.Raise("Il file non è uno standard Midi !")
 
   If s <> "MThd" Then Error.Raise("Il file non è uno standard Midi !")
 +
  Print "Dimensione:    "; Lof(fl); " byte"
 +
  Seek #fl, 9
 +
  Read #fl, b
 +
  If b <> 1 Then Error.Raise("Il tipo " & b & " non è supportato dal programma !")
 +
  Seek #fl, 11
 +
  Read #fl, tr
 +
  Print "Numero tracce:  "; Format(tr, "###")
 +
  Read #fl, td
 +
  td = Rol(td, 8)
 +
  Print "Risoluzione TΔ:  "; Format(td, "###")
 +
  Avanza(fl, 8)
 
    
 
    
   Print "Dimensione:              "; Lof(fl); " byte"
+
   bpm = 120
  durata_Midi = legge_smf()
 
  Print "Durata del file Midi:    \e[31m"; Date(0, 0, 0, 0, 0, 0, durata_Midi * 1000); "\e[0m"
 
 
    
 
    
   fl.Close()
+
   Repeat
   
+
    tot = 0
'''End'''
+
    Do
+
      tot += legge_var(fl)
+
      Read #fl, b
'''Private''' Function legge_smf() As Float   <FONT Color=gray>' ''Legge l'intero file Midi''</font>
+
      If b And 128 Then   <FONT Color=gray>''Status running''</font>"
 
+
        cmd = b
  Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer
+
        ultimo = cmd
  Dim num_tracce As Short
+
        av = 2
  Dim err, traccia As Byte
+
      Else
  Dim s As String
+
        cmd = ultimo
  Dim dur, superior As Float
+
        av = 1
+
      Endif
<FONT Color=gray>' ''La corrente posizione all'interno del file è immediatamente dopo "Mthd":''</font>
+
      tipocmd = Shr(cmd, 4)
  lung_MThd = legge_dal_file(4)
+
      Select Case tipocmd
  If lung_MThd <> 6 Then Error.Raise("Formato di file non valido !")
+
        Case 8 To 11
 
+
          Avanza(fl, av)
  tipo = legge_dal_file(2)
+
        Case 12 To 13
  Print "Tipo file Midi:          "; tipo
+
          Avanza(fl, 1)
  If tipo <> 1 Then Error.Raise("Il tipo " & tipo & " non è supportato dal programma !")
+
        Case 14
 +
          Avanza(fl, av)
 +
        Case &F0          <FONT Color=gray>''Evento SysSex''</font>"
 +
        Repeat
 +
          b = Read #fl As Byte
 +
        Until b = &7F
 +
          Avanza(fl, 1)
 +
        Case 15
 +
          Read #fl, b
 +
          Select Case b
 +
            Case &51
 +
              durata += DurataParziale(bpm, td, tot)  
 +
              tratto1 += tot
 +
              tot = 0
 +
              Avanza(fl, 1)
 +
              hbpm = 0
 +
              For c = 2 To 0 Step -1
 +
                Read #fl, n
 +
                hbpm += Shl(CInt(n), 8 * c)
 +
              Next
 +
              bpm = 60000000 / hbpm
 +
            Case &2F
 +
              mx = Max(mx, tot)
 +
              Exit
 +
            Case Else
 +
              Read #fl, b
 +
              Avanza(fl, b)
 +
          End Select
 +
      End Select
 +
    Loop
 +
    Dec tr
 +
    If tr > 0 Then Avanza(fl, 9)
 +
  Until tr = 0
 
    
 
    
   num_tracce = legge_dal_file(2)
+
   fl.Close
  If (num_tracce = 0) Or (num_tracce > 1000) Then Error.Raise(num_tracce & ": è un numero di tracce non valido !")
 
  Print "Numero totale Tracce:    "; num_tracce
 
 
    
 
    
   risoluzione_TD = legge_dal_file(2)
+
   f = DurataParziale(bpm, td, Max(mx, tratto1) - tratto1)
  If risoluzione_TD < 8 Then Error.Raise("Formato di file non valido !")
 
  Print "Risoluzione Tempo Delta: "; risoluzione_TD
 
 
  Print "\n\n=== DURATA delle "; num_tracce; " TRACCE ===\n"
 
 
    
 
    
<FONT Color=gray>' ''Legge le tracce MTrk del file Midi:''</font>
+
   Print "\n\e[31m"; CStr(Date(0, 0, 0, 0, 0, 0, (f + durata) * 1000)); "\e[0m"
   For traccia = 1 To num_tracce
 
<FONT Color=gray>' ''Cerca il blocco "Mtrk" della traccia corrente:''</font>
 
    For err = 0 To 1
 
      Read #fl, s, 4
 
      lenI = legge_dal_file(4)
 
      If Eof(fl) Then Error.Raise("Inattesa fine del file !")
 
      If (lenI < 0) Or (lenI >= 268435456) Then Error.Raise(CStr(lenI) & ": lunghezza del blocco traccia non valido !")
 
      If s = "MTrk" Then Exit
 
    Next
 
   
 
    file_offset = Seek(fl)
 
     
 
    dur = legge_traccia(CStr(traccia), file_offset + lenI, risoluzione_TD)
 
   
 
<FONT Color=gray>' ''Individua la traccia che dura di più rispetto alle altre:''</font>
 
    superior = Max(dur, superior)
 
     
 
  Next
 
   
 
  Return superior
 
 
    
 
    
 
  '''End'''
 
  '''End'''
 
 
'''Private''' Function legge_traccia(nmt As String, fine_traccia As Integer, rTD As Integer) As Float  <FONT Color=gray>' ''Legge una intera singola traccia Mtrk''</font>
 
 
    
 
    
   Dim tick, delta_ticks, lenI, totale_tick_traccia As Integer
+
    
  Dim c, ultimo_cmd, cmd, tipo_cmd As Byte
+
  '''Private''' Procedure Avanza(mf As File, av As Byte)
  Dim f As Float
+
 
  Dim tempus, t1 As String
+
   Dim b, n As Byte
 
  <FONT Color=gray>' ''L'attuale posizione del puntatore nel file Midi è dopo i byte di identificazione e di lunghezza della traccia:''</font>
 
  While file_offset < fine_traccia
 
    delta_ticks = legge_var()
 
   
 
    If delta_ticks < 0 Then Break
 
   
 
    tick += delta_ticks
 
   
 
    Read #fl, c
 
    file_offset += 1
 
   
 
    If c < 0 Then Break
 
   
 
    If c And 128 Then
 
      cmd = c
 
      If cmd < 240 Then ultimo_cmd = cmd
 
 
    Else
 
<FONT Color=gray>' ''Status Running:''</font>
 
      Seek #fl, Seek(fl) - 2
 
      Read #fl, c
 
      Dec file_offset
 
      cmd = ultimo_cmd
 
      If Not cmd Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
   
 
    Endif
 
 
    tipo_cmd = Shr(cmd, 4)
 
 
    Select Case tipo_cmd
 
      Case 8 To 11
 
        legge_byte()
 
        legge_byte()
 
      Case 14
 
        legge_byte()
 
        legge_byte()
 
      Case 12 To 13
 
        legge_byte()
 
      Case 15
 
        Select Case cmd
 
          Case 240, 247
 
            lenI = legge_var()
 
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
            If cmd = 240 Then
 
              Inc lenI
 
              c = 1
 
            Else
 
              c = 1
 
            Endif
 
              For c = 0 To lenI - 1
 
                legge_byte()
 
              Next
 
              Break
 
 
 
          Case 255          <FONT Color=gray>' ''Meta-evento''</font>
 
            c = legge_byte()
 
            lenI = legge_byte()
 
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
            Select Case c
 
              Case 33
 
                If lenI < 1 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
                legge_byte()
 
                salto(lenI - 1)
 
              Case 47                    <FONT Color=gray>' ''Fine traccia''</font>
 
                totale_tick_traccia = tick
 
                If nmt = "1" Then t1 = "   (del Tempo)"
 
                f = (((60000000 / Fix(60000000 / Val("&" & bpm$))) / rTD) * totale_tick_traccia) / 1000000
 
                If f > 0 Then tempus = Str(Date(0, 0, 0, 0, 0, 0, f * 1000))
 
                If IsNull(tempus) Then tempus = "00:00:00"
 
                Print "Traccia "; Format(nmt, "###:    "); tempus; t1
 
                Print "------------------------------------"
 
                 
 
                Return f
 
 
 
              Case 81
 
                If lenI < 3 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
                bpm$ = Hex(legge_byte(), 2)
 
                bpm$ &= Hex(legge_byte(), 2)
 
                bpm$ &= Hex(legge_byte(), 2)
 
                salto(lenI - 3)
 
              Case Else        ' Ignora gli altri Meta-eventi
 
                salto(lenI)
 
 
            End Select
 
          Case Else    ' Comando Fx non valido
 
            Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
        End Select
 
      Case Else
 
        Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 
    End Select
 
   
 
  Wend
 
 
    
 
    
 +
  For b = 1 To av
 +
    Read #mf, n
 +
  Next
 +
 
 
  '''End'''
 
  '''End'''
 
 
'''Private''' Function legge_var() As Integer  <FONT Color=gray>' ''Legge un numero a lunghezza-variabile (tempo Delta)''</font>
 
 
    
 
    
  Dim valore As Integer
+
  '''Private''' Function legge_var(mf As File) As Integer  ' Legge un numero a lunghezza-variabile (tempo Delta)
  Dim c As Byte
 
 
 
  Repeat
 
    Read #fl, c
 
    valore = Shl(valore, 7) Or (c And 127)
 
  Until Not (c And 128)
 
 
 
  Return valore
 
 
 
  '''End'''
 
 
 
   
 
   
  '''Private''' Function legge_byte() As Byte
+
  Dim vl As Integer
 
+
Dim c As Byte
  Dim b As Byte
 
 
    
 
    
  Inc file_offset
+
  Repeat
 +
    Read #mf, c
 +
    vl = Shl(vl, 7) Or (c And 127)
 +
  Until Not (c And 128)
 
    
 
    
  Read #fl, b
+
  Return vl
   
 
  Return b
 
 
    
 
    
 
  '''End'''
 
  '''End'''
 
 
'''Private''' Procedure salto(b As Byte)
 
 
    
 
    
  While b > 0
+
  '''Private''' Function DurataParziale(bpm As Integer, del As Short, par As Integer) As Float
    legge_byte()
 
    Dec b
 
  Wend
 
  file_offset += b
 
   
 
'''End'''
 
 
 
  '''Private''' Function legge_dal_file(by As Short) As Integer
 
 
    
 
    
  Dim valore As Integer
+
   Return CFloat((((60000000 / bpm) / del) * par) / 1000000)
  Dim b As Byte
 
    
 
  Do
 
    Read #fl, b
 
    If b = -1 Then Return -1
 
    valore = (valore * CInt(2 ^ 8)) Or b
 
    Dec by
 
  Loop Until by = 0
 
   
 
  Return valore
 
 
    
 
    
 
  '''End'''
 
  '''End'''

Versione delle 15:56, 18 apr 2018

Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente, nel quale si otterranno anche le durate delle singole tracce MTrk presenti nel file ed alcune generiche informazioni:

Public Sub Main()
 
 Dim fl As File
 Dim fileMidi, s As String
 Dim hbpm, tot, mx, tratto1 As Integer
 Dim td, bpm, c As Short
 Dim tr, b, n, av As Byte
 Dim cmd, tipocmd, ultimo As Byte
 Dim f, durata As Float
  
  fileMidi = "' /percorso/del/file.mid"
  Print "File Midi:         "; fileMidi
  
  fl = Open fileMidi For Read
  If IsNull(fl) Then Error.Raise("Impossibile aprire il file !")
  
  Read #fl, s, 4
  If s <> "MThd" Then Error.Raise("Il file non è uno standard Midi !")
  Print "Dimensione:    "; Lof(fl); " byte"
  Seek #fl, 9
  Read #fl, b
  If b <> 1 Then Error.Raise("Il tipo " & b & " non è supportato dal programma !")
  Seek #fl, 11
  Read #fl, tr
  Print "Numero tracce:   "; Format(tr, "###")
  Read #fl, td
  td = Rol(td, 8)
  Print "Risoluzione TΔ:  "; Format(td, "###")
  Avanza(fl, 8)
  
  bpm = 120
  
  Repeat
    tot = 0
    Do
      tot += legge_var(fl)
      Read #fl, b
      If b And 128 Then   Status running"
        cmd = b
        ultimo = cmd
        av = 2
      Else
        cmd = ultimo
        av = 1
      Endif
      tipocmd = Shr(cmd, 4)
      Select Case tipocmd
        Case 8 To 11
          Avanza(fl, av)
        Case 12 To 13 
          Avanza(fl, 1)
        Case 14
          Avanza(fl, av)
        Case &F0          Evento SysSex"
        Repeat
          b = Read #fl As Byte
        Until b = &7F
          Avanza(fl, 1)
        Case 15
          Read #fl, b
          Select Case b
            Case &51
              durata += DurataParziale(bpm, td, tot) 
              tratto1 += tot
              tot = 0
              Avanza(fl, 1)
              hbpm = 0
              For c = 2 To 0 Step -1
                Read #fl, n
                hbpm += Shl(CInt(n), 8 * c)
              Next
              bpm = 60000000 / hbpm
            Case &2F
              mx = Max(mx, tot)
              Exit
            Case Else
              Read #fl, b
              Avanza(fl, b)
          End Select
      End Select
    Loop
    Dec tr
    If tr > 0 Then Avanza(fl, 9)
  Until tr = 0
  
  fl.Close
  
  f = DurataParziale(bpm, td, Max(mx, tratto1) - tratto1)
  
  Print "\n\e[31m"; CStr(Date(0, 0, 0, 0, 0, 0, (f + durata) * 1000)); "\e[0m"
  
End
 
 
Private Procedure Avanza(mf As File, av As Byte)
 
 Dim b, n As Byte
  
  For b = 1 To av
    Read #mf, n
  Next
 
End
 
Private Function legge_var(mf As File) As Integer   ' Legge un numero a lunghezza-variabile (tempo Delta)

Dim vl As Integer
Dim c As Byte
 
 Repeat
   Read #mf, c
   vl = Shl(vl, 7) Or (c And 127)
 Until Not (c And 128)
 
 Return vl
 
End
 
Private Function DurataParziale(bpm As Integer, del As Short, par As Integer) As Float
 
  Return CFloat((((60000000 / bpm) / del) * par) / 1000000)
 
End